[Arjen Markus] Whereas I do not use them myself that much, many people find them useful: file associations under Windows. Or better: file extension associations. The script below uses Tcl's [unknown] command and an auxiliary command "assoc" to play with them in a Tcl/Tk shell. 

(An alternative to the [[assoc register]] command is shown in [Register file types under Windows]; it also allows setting print and edit commands, MIME types, and the file type to be shown in the Explorer)

The idea: by typing the ''name'' of a file, the shell starts the default command associated with the file's extension. So, rather than typing:

   % notepad somefile.txt

you can type:

   % somefile.txt

Tcl's [auto_execok] does so (or does it?) with Windows' own associations, but they are global to the system. With this script you simply limit the assocations to your Tcl (current) environment.

----
Some notes: it is a quick and dirty implementation, for illustration only, in response to a question on the c.l.t. But it works (and it works on UNIX as well).
----
[Arjen Markus] I took the liberty of copying some text from the relevant discussion on c.l.t.:
[David Gravereaux] answered this:

    :   This is similar to `eval exec [auto_execok start] mymy.doc`. The pick and choose part could be done as a separate verb in the associations section of the type in the registry if you feel you want your selection to be different than the default system.

    :   winutils::shell -verb YourCustomVerb somefile.txt

(Available in the winutils extension [http://prdownloads.sourceforge.net/tomasoft/winutils-0.5.zip])

----

======
   # Setup the unknown package handler

   package unknown tclPkgUnknown

   # Conditionalize for presence of exec.

   if {[llength [info commands exec]] == 0} {

       # Some machines, such as the Macintosh, do not have exec. Also, on all
       # platforms, safe interpreters do not have exec.

       set auto_noexec 1
   }
   set errorCode ""
   set errorInfo ""

   # Define a log command (which can be overwitten to log errors
   # differently, specially when stderr is not available)

   if {[llength [info commands tclLog]] == 0} {
       proc tclLog {string} {
           catch {puts stderr $string}
       }
   }

   # assoc --
   # This procedure can be called to associate a command with a file
   # extension:
   #    assoc exists   $filename     - checks if a filename has some association
   #    assoc command  $filename     - return the associated command and file name
   #    assoc register $ext $command - register the command with the extension
   #                                   (%1 will be replaced by the file name)
   #
   # Arguments:
   # subcommand    A valid subcommand
   # filename      A file name or an extension (the latter for "register" only)
   # command       The associated command (only for register)
   #
   # Usage:
   #    assoc register .txt "vi %1"   (By the programmer/user)
   #    assoc command  file.txt       (By [unknown] - starts "vi file.txt")
   #

   namespace eval ::AssocCommands {
      variable assoc_data {}
      namespace export assoc
   }

   proc ::AssocCommands::assoc {subcommand filename {command {}}} {
      variable assoc_data

      switch -- $subcommand {
      "exists"    {
                    return [expr {[lsearch $assoc_data [file extension $filename]] != -1 }]
                  }
      "register"  {
                    set idx [lsearch $assoc_data $filename]
                    if { $idx == -1 } {
                       lappend assoc_data $filename $command
                    } else {
                       incr idx
                       set assoc_data [lreplace $assoc_data $idx $idx $command]
                    }
                    puts $assoc_data
                    return 1
                  }
      "command"   {
                    set  idx [lsearch $assoc_data [file extension $filename]]
                    incr idx
                    set  command [lindex $assoc_data $idx]
                    if { [string first "%1" $command] == -1 } {
                       append command " %1"
                    }
                    return "[string map [list %1 $filename] $command]"
                  }
      }
   }
   namespace import ::AssocCommands::*


   # unknown --
   # This procedure is called when a Tcl command is invoked that doesn't
   # exist in the interpreter.  It takes the following steps to make the
   # command available:
   #
   #       1. See if the command has the form "namespace inscope ns cmd" and
   #          if so, concatenate its arguments onto the end and evaluate it.
   #       2. See if the autoload facility can locate the command in a
   #          Tcl script file.  If so, load it and execute it.
   #       3. If the command has the form of "filename.ext", and an
   #           association exists, use the associated command.
   #       4. If the command was invoked interactively at top-level:
   #           (a) see if the command exists as an executable UNIX program.
   #               If so, "exec" the command.
   #           (b) see if the command requests csh-like history substitution
   #               in one of the common forms !!, !<number>, or ^old^new.  If
   #               so, emulate csh's history substitution.
   #           (c) see if the command is a unique abbreviation for another
   #               command.  If so, invoke the command.
   #
   # Arguments:
   # args -        A list whose elements are the words of the original
   #               command, including the command name.

   proc unknown args {
       global auto_noexec auto_noload env unknown_pending tcl_interactive
       global errorCode errorInfo

       # If the command word has the form "namespace inscope ns cmd"
       # then concatenate its arguments onto the end and evaluate it.

       set cmd [lindex $args 0]
       if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
           set arglist [lrange $args 1 end]
           set ret [catch {uplevel $cmd $arglist} result]
           if {$ret == 0} {
               return $result
           } else {
               return -code $ret -errorcode $errorCode $result
           }
       }

       # Save the values of errorCode and errorInfo variables, since they
       # may get modified if caught errors occur below.  The variables will
       # be restored just before re-executing the missing command.

       set savedErrorCode $errorCode
       set savedErrorInfo $errorInfo
       set name [lindex $args 0]
       if {![info exists auto_noload]} {
           #
           # Make sure we're not trying to load the same proc twice.
           #
           if {[info exists unknown_pending($name)]} {
               return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
           }
           set unknown_pending($name) pending;
           set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
           unset unknown_pending($name);
           if {$ret != 0} {
               append errorInfo "\n    (autoloading \"$name\")"
               return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
           }
           if {![array size unknown_pending]} {
               unset unknown_pending
           }
           if {$msg} {
               set errorCode $savedErrorCode
               set errorInfo $savedErrorInfo
               set code [catch {uplevel 1 $args} msg]
               if {$code ==  1} {
                   #
                   # Strip the last five lines off the error stack (they're
                   # from the "uplevel" command).
                   #

                   set new [split $errorInfo \n]
                   set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
                   return -code error -errorcode $errorCode \
                           -errorinfo $new $msg
               } else {
                   return -code $code $msg
               }
           }
       }

       if {([info level] == 1) && [assoc exists $args]} {
          return [uplevel exec [assoc command $args]]
       }

       if {([info level] == 1) && [string equal [info script] ""] \
               && [info exists tcl_interactive] && $tcl_interactive} {
           if {![info exists auto_noexec]} {
               set new [auto_execok $name]
               if {[string compare {} $new]} {
                   set errorCode $savedErrorCode
                   set errorInfo $savedErrorInfo
                   set redir ""
                   if {[string equal [info commands console] ""]} {
                       set redir ">&@stdout <@stdin"
                   }
                   return [uplevel exec $redir $new [lrange $args 1 end]]
               }
           }
           set errorCode $savedErrorCode
           set errorInfo $savedErrorInfo
           if {[string equal $name "!!"]} {
               set newcmd [history event]
           } elseif {[regexp {^!(.+)$} $name dummy event]} {
               set newcmd [history event $event]
           } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
               set newcmd [history event -1]
               catch {regsub -all -- $old $newcmd $new newcmd}
           }
           if {[info exists newcmd]} {
               tclLog $newcmd
               history change $newcmd 0
               return [uplevel $newcmd]
           }

           set ret [catch {set cmds [info commands $name*]} msg]
           if {[string equal $name "::"]} {
               set name ""
           }
           if {$ret != 0} {
               return -code $ret -errorcode $errorCode \
                   "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
           }
           if {[llength $cmds] == 1} {
               return [uplevel [lreplace $args 0 0 $cmds]]
           }
           if {[llength $cmds]} {
               if {[string equal $name ""]} {
                   return -code error "empty command name \"\""
               } else {
                   return -code error \
                           "ambiguous command name \"$name\": [lsort $cmds]"
               }
           }
       }
       return -code error "invalid command name \"$name\""
   }
======

<<categories>> Windows | File