Updated 2005-11-17 15:27:01 by escargo

Here is a small wrapper I wrote to do common things with the registry in windows with the registry extension.
 # ms_shell_setup
 # A simplified way to modify the way the Windows shell treats files based on file extensions.

 # This is a simple wrapper arround the registry commands provided by the standard Tcl
 # installation on Windows.  I wrote it reading that Tuba need something like this.

 # By using this library you advoid some details of the registry use, but not all.  Remember
 # to treat your registry with caution!

 #
 # Copyright (c) 1999
 # Earl Johhnson
 # [email protected]
 # http://www.erols.com/earl-johnson
 #
 # Permission to use, copy, modify, distribute and sell this software
 # and its documentation for any purpose is hereby granted without fee,
 # provided that the above copyright notice appear in all copies and
 # that both that copyright notice and this permission notice appear
 # in supporting documentation.  Earl Johnson makes no
 # representations about the suitability of this software for any
 # purpose.  It is provided "as is" without express or implied warranty.
 #

 package provide ms_shell_setup 0.1

 package require registry

 namespace eval ::ms_shell_setup:: {

 # add key for extension
 # Example: shell_assoc_exist .txt => 1
 # Example: shell_assoc_exist .NEVER => 0
 proc shell_assoc_exist {extension} {
   if {[catch {
        registry get "HKEY_CLASSES_ROOT\\[set extension]" ""
      } err_str]} {
     set ret 0
   } else {
     set ret 1
   }
   return $ret
 }

 # Show if a filetype exist
 # Example: shell_fileType_exist txtfile => 1
 # Example: shell_fileType_exist NEVER => 0
 proc shell_fileType_exist {fileType} {
   if {[catch {
        registry get "HKEY_CLASSES_ROOT\\[set fileType]" ""
      } err_str]} {
     set ret 0
   } else {
     set ret 1
   }
   return $ret
 }

 # Creates a file extension and associates it with fileType.
 # Example: shell_fileExtension_setup .txt txtfile
 proc shell_fileExtension_setup {extension fileType} {
  registry set "HKEY_CLASSES_ROOT\\[set extension]" "" "${fileType}"
 }

 # Remove connection between extension and fileType
 # shell_fileExtension_setup .txt ""

 # Creates a fileType
 # Example: shell_fileType_setup txtfile "Text Document"
 proc shell_fileType_setup {fileType title} {
  registry set "HKEY_CLASSES_ROOT\\[set fileType]" "" "${title}"
 }

 # Creates a open command on left click.
 # Allows sets action for double click.
 # Example: shell_fileType_open txtfile "C:\OS\WINDOWS\NOTEPAD.EXE %1"
 # Please note the %1 for passing in file name
 proc shell_fileType_open {fileType openCommand} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell\\open\\command" "" "${openCommand}"
 }

 # Creates a print command on left click.
 # Example: shell_fileType_print txtfile "C:\OS\WINDOWS\NOTEPAD.EXE /p %1"
 # Please note the %1 for passing in file name
 proc shell_fileType_print {fileType printCommand} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell\\print\\command" "" "${printCommand}"
 }

 # Sets an icon for a fileType
 # Example: shell_fileType_icon txtfile "C:\OS\WINDOWS\SYSTEM\shell32.dll,-152"
 # Please note the C:\OS\WINDOWS\SYSTEM\shell32.dll,-152
 # We can give a name.ico file or a dll or exe file here.
 # If a dll or exe file is used the index for resource
 # inside it that gives the icon must be given.
 proc shell_fileType_icon {fileType icon} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\DefaultIcon" "" "${icon}"
 }

 # Sets the quick view for a fileType
 proc shell_fileType_quickView {fileType quickViewCmd} {
   registry set HKEY_CLASSES_ROOT\\[set fileType]\\QuickView" "" "${quickViewCmd}"
 }

 # This adds any command you like to a fileType
 # Example: shell_fileType_addAny_cmd scrfile config "%1"
 proc shell_fileType_addAny_cmd {fileType cmdName cmd} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell\\[set cmdName]\\command" "" "${cmd}"
 }

 # Uses some string instead of actual command on right click.
 proc shell_fileType_setMenuName {fileType cmdName str} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell\\[set cmdName]" "" "${str}"
 }

 # Show or not show the extension on the fileType
 # Example: shell_fileType_showExt txtfile
 proc shell_fileType_showExt {fileType {yesOrNo t}} {
   if {$yesOrNo} {
      registry set "HKEY_CLASSES_ROOT\\[set fileType]" "AllwaysShowExt" ""
   } else {
      registry delete "HKEY_CLASSES_ROOT\\[set fileType]" "AllwaysShowExt"
   }
 }

 # Over-ride the windows ordering of commands on right click
 # Example: shell_fileType_setCmdOrder txtfile {print open}
 proc shell_fileType_setCmdOrder {fileType cmds} {
   set l [llength $cmds];
   set ll [expr $l -1]
   for {set i 0} {$i < $ll} {incr i} {
       set l [lindex $cmds $i]
       append str "$l, "
   }
   append str "[lindex $cmds end]"
   registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell" "" "${str}"
 }

 # Never show extension on fileType
 # Example: shell_fileType_neverShowExt txtfile
 proc shell_fileType_neverShowExt {fileType {yesOrNo t}} {
   registry set "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt" ""
   if {$yesOrNo} {
      registry set "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt" ""
   } else {
      registry delete "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt"
   }
 }

 # Example from the Tcl Debugger Tuba
 proc Tuba_setup {tubaDir} {
  shell_fileExtension_setup .ses Tuba_file
  shell_fileType_setup Tuba_file "Tuba the Tcl Debugger"
  shell_fileType_open Tuba_file "[info nameofexecutable] [set tubaDir]\\tuba.tk -- -s %1"
  shell_fileType_print Tuba_file "C:\\OS\\WINDOWS\\NOTEPAD.EXE /p %1"
  shell_fileType_icon Tuba_file "D:\\tuba-2.1.p1\\tubaicon.bmp"
  shell_fileType_addAny_cmd Tuba_file edit "C:\\OS\\WINDOWS\\NOTEPAD.EXE %1"
  shell_fileType_setCmdOrder Tuba_file {edit open print}
 }

 # Example of something Tuba might have to use.
 # Tuba_setup "D:\\tuba-2.1.p1"

 # Gets all the commands assocated with a extesion
 # Example: shell_getCmds file.txt => {open print}
 proc shell_getCmds {file} {
  set extension [file extension $file]
  if {[catch {
          set fileType [registry get "HKEY_CLASSES_ROOT\\[set extension]" ""]
  } err_str]} { puts $err_str; return; # No assocation or fileType }
  if {[catch {
          set cmds [registry keys "HKEY_CLASSES_ROOT\\${fileType}\\shell"]
  } err_str]} { puts $err_str return ; # No commands assocated with file Type }

  return $cmds
 }

 # Gets the implimentation of command given a file type
 # Example: shell_getCmd_imp test.txt open => C:\OS\WINDOWS\NOTEPAD.EXE $1
 proc shell_getCmd_imp {file cmd} {
  set extension [file extension $file]
  if {[catch {
          set fileType [registry get "HKEY_CLASSES_ROOT\\[set extension]" ""]
  } err_str]} { puts $err_str; return; # No assocation or fileType }
  if {[catch {
          set imp [registry get "HKEY_CLASSES_ROOT\\${fileType}\\shell\\$cmd\\command" ""]
  } err_str]} { puts $err_str return ; # No commands assocated with file Type }
  regsub -all {%([0-9]+)} $imp {$\1} ret
  return $ret
 }

 # DDEs
 # shell\open\ddeexec\appliation
 # shell\open\ddeexec\topic

 namespace export [info procs]

 }; # End namespace ms_shell_setup

Category Example