I thought it was time I tried to return something to this Wiki. I created this page for little Tcl/Tk utilities which make life under MS Windows easier. ---- * SendTo utility to add the UNC for several files Problem: You want to insert the network path (UNC) into an email message for file(s) rather than attaching the files. You can select those files in Windows Explorer and then right click and select SendTo. The full path of those files will be send on the command line to whatever application you place in the SendTo directory in your profile (depends on the version of Windows. EG: WinXP places it under "Documents and Settings\username\SendTo). I tried to create a simple Visual C++ utility to grab this command line and place it on the clipboard. I found out that Tcl/Tk makes it much easier: ====== clipboard clear clipboard append [join $argv { }] update exit ====== Place this script somewhere, not necessarily in the the SendTo directory. In the SendTo directory, create a new shortcut to your wish executable and add to the command line the path to this simple script. That is all you need! '''Now, a few years later...''' As needs progressed, I discovered a more robust way to implement this was to create a one line Windows script (.BAT) file to call wish. In this BAT file put the line: @ "" %* Where you substitute the expressions with the angle brackets with that which is appropriate for your installation. As LES discovered below in the discussion, pathnames that have spaces can lead to problems. The above seems more robust. Now, create a shortcut in your SendTo directory that points to the .BAT file you created above. Now, a more full-featured version of the above script. It handles selection of multiple files. It includes a line to modify the backslashes to make a Unix compatible-pathname (took me a long time to get it right, hence documenting it here). If you don't want unix names, remove it. ====== wm withdraw . package require twapi # map the drive letters to UNC set newpaths {} foreach path $argv { if { [regexp {^[A-Z]:} $path drive] } { if { ! [catch {twapi::get_mapped_share_info $drive -uncvolume} status]} { array set driveinfo [twapi::get_mapped_share_info $drive -uncvolume] set newpath [regsub ${drive} $path \\$driveinfo(-uncvolume)] } else { set newpath $path } } else { set newpath $path } lappend newpaths $newpath } # Make it unix-friendly - change back to forward slashes set newpaths [regsub -all \\\\ $newpaths /] twapi::open_clipboard twapi::empty_clipboard twapi::write_clipboard_text [join $newpaths { }] twapi::close_clipboard exit ====== The '''trick''' with the four backslahses above took a lot of time to nail down. Since I didn't see any documentation here, I thought this might be the pinnacle of my contribution. [buchs] ---- '''DISCUSSION''' [LES] on 2003 Dec 01: has anyone actually tried this? It doesn't work for me. The script is not even run. [JPT] 2003-12-02: I tried it under WinME and it worked ok... after I re-read the instructions and put a shortcut to the script in the SendTo directory instead of the script itself as I first did. [LES]: I am using the shortcut too, on Win98, and it doesn't work. ---- [LES] on 2005 Jan 06: This little trick still doesn't work for me. The script is not even run. I '''REALLY''' want to make it work this time, so let me try a very detailed step-by-step: 1. I write a script... ====== wm withdraw . tk_messageBox -message [ join $argv {} ] exit ====== ... and save it as '''C:\WINDOWS\Desktop\test.tcl''' 2. I browse to my SendTo folder and create a shortcut to my [wish] executable. I rename it to '''Show_path'''. 3. I open the properties of that shortcut and find this path: '''D:\Langs\Tcl\bin\wish.exe''' 4. I modify that path: '''D:\Langs\Tcl\bin\wish.exe C:\WINDOWS\Desktop\test.tcl''' 5. I write a new text file... hey mom howdy ... and save it as '''C:\WINDOWS\Desktop\hello.txt''' 6. I right-click '''hello.txt''' and select '''SendTo''' > '''Show_path'''. Result: an error message: invalid command name "hey" while executing "hey" (file "C:\WINDOWS\DESKTOP\HELLO.TXT" line 1) So it didn't capture the file's path and also gave me an error. Where did I go wrong? anonymous: You did not go wrong. Windows is launching wish and your script, then passing the file data as part of dde. The word Hey hits your shell and TCL raises an error. Your intent was to get the path of the file, which you did not pass to tcl. You passed the contents of the file. The "%1" flag in the shortcut would pass the path through the shortcut. [LES] How? I tried changing the path in the shortcut to '''D:\Langs\Tcl\bin\wish.exe C:\WINDOWS\Desktop\test.tcl "%1" ''', and it doesn't work either. anonymous: Interesting. It works fine for me, I even copy/pasted your code. I get the messagebox with the path. I am using XP Pro. Lets try a slightly different method and see if it works. Assuming that all .tcl files are associated with wish (not tclsh or nothing). Right click on an empty area in your SendTo folder and select New Shortcut. In the target area type exactly: start "C:\WINDOWS\Desktop\test.tcl" "%1" Just to see if perhaps that method works. In my experience it does. [LES] No. A DOS box opens and closes all too quickly. Suddenly, '''hello.txt''' is open in my text editor. Damn! >:-( anonymous: Very odd. Maybe someone else will have an idea we have overlooked. I am stumped. ====== wm withdraw . clipboard clear clipboard append [join $argv {}] update ====== with wish "sciptname.tcl" "%1" in the shortcut seems to work for me - exit seems to clear the clipboard ---- Working with Windows Drives I found it rather difficult, at least from my perspective, to deal with Windows disks, particularly removable media. Specifically when I want to know the file systems and availability of drives / etc. Windows makes it rather hard. The small script below builds a complete array of all disks on a system and the required information to work with them. ====== proc MyDisks {} { set ::myDisk(Listing) [file volumes] foreach disk $::myDisk(Listing) { set ::myDisk($disk,Name) [file nativename $disk] if {[catch {file type $disk} blah]} { set ::myDisk($disk,Available) 0 } else { set ::myDisk($disk,Available) 1 } set ::myDisk($disk,Writable) [file writable $disk] set ::myDisk($disk,FS) [lindex [file system $disk] 1] } } ====== To explain all of these checks and the resulting array: - myDisk(Listing) contains all found volumes (drives). It is the easiest way to continue with other drive operations. - myDisk($disk,Name) contains the native name of the disk. This is the name such as c:\ rather than c:/. It is how end-users expect to see the drive name. - myDisk($disk,Available) is 0 for no disk present or 1 if a disk is present. this lets you know whether the drive contains removable media or not. - myDisk($disk,Writable) is 0 if readonly on 1 if writable. This is useful for determining the type of removable media separate from the device FS formatting. - myDisk($disk,FS) returns the actual file system for that device. It will return "" if the disk is not present, or the true file system if present. (CDFS NTFS / etc) The reason I use a global array is to make it easy to integrate with GUI operations and associate variables as needed for user interaction. Hopefully this helps anyone looking to make a simple file explorer / etc. [APN] 2006/07/04 The '''Disks and Volumes''' [http://twapi.sf.net/disk.html] module of [TWAPI] provides commands to retrieve the above as well as other disk and volume related information. ---- [Integrating Tcl and Emacs on Windows] shows a secret way to integrate Tcl on Windows Emacs. ---- [windows icons] holds the secret of icon manipulation with Tcl ---- [ET] 2023/10/27 Windows file explorer utility Here's a little windows utility that uses twapi to rearange '''file explorer '''windows. I still use win 10, so no tabbed file explorer. It can do the following: * minimize all windows * restore all windows * close all visible windows (leaves minimized alone) * resize all visible windows (3 sizes) * move and stack on monitor 1,2, or 3 while closing duplicates * sort by window title up/down * Save up to 10 groups of windows for later restore with a label (easily increased or decreased) The script should be placed in a writable directory, best if dedicated, and then edit line 1 to point to that directory. Saved sets of directory names are saved in individual files in that directory. It assumes 3 1080p monitors going left (main) to right. But the Move proc could be easily modified to compute different coords. Stacking and resizing on monitor 1 should work regardless. I run it under the magicsplat distro which includes all the packages this requires (twapi, tooltip, tk_getstring, awdark theme) Demonstrates use of twapi package for several commands. Includes a range command which was a prototype for lseq (8.7/9.0), and also has a modified set command to accomodate expressions w/o explicit use of expr. <> code ======tcl #set ::thedir z:/path/to/direcotry ;# directory where to save sets of directories if { ![info exist ::thedir] } { tk_messageBox -message "Please uncomment and edit line 1\nwith a writable direcotry" -icon error -type ok exit } else { if [catch { set io [open [file join $::thedir saveset0.txt] w] } err_code] { tk_messageBox -message "cannot write to $::thedir : $err_code" -icon error -type ok exit } puts $io "program starting at [clock format [clock seconds]]" close $io set ::thescript [file join $::thedir me] } if [catch { package require getstring } err_code] { puts $err_code } proc range {args} { ;# prototype range command (will be called lseq in 8.7 / 9.0 ) lassign $args a op b by step if { $by eq "" } { set by by } if { $step eq "" } { set step 1 set nostep 1 } else { set nostep 0 } set l [llength $args] if { $l < 1 } { error "missing args for range" } elseif { $l == 1 } { ;#python compatible if { $a <= 0 } { return {} } set b $a set a 0 set op ..< } elseif { $l == 2 } {;#python compatible just 2 integers, from ..< to set b $op set op ..< } elseif { $l == 3 } { if { [string is integer $op] || ($op ne ".." && $op ne "..<" && $op ne "to" && $op ne "..=" && $op ne "-count")} {;#python compatible, all 3 must be integers (or expressions) set step $b set b $op set op ..< set by by } } set a [expr $a] set step [expr $step] set ender 0 if { [string range $b end-3 end] eq "+end"} { ;# allow for b operand to have +end at the end, to include b in range set b [string range $b 0 end-4] set ender 1 } set b [expr $b] if { $ender } { set dbl 0 foreach num [list $a $b $step] { if { [string is double $num] && ![string is integer $num] } { set dbl 1 break } else { } } if { $dbl } { if { $a <= $b } { set b [expr { $b + abs($step) / 1000. }] } else { set b [expr { $b - abs($step) / 1000. }] } } else { if { $a <= $b } { incr b } else { incr b -1 } } } set inc 1 if { $op eq "..<" } { set inc 0 set op ".." } # puts "a= |$a| b= |$b| step= |$step| nostep= |$nostep| " if { $op eq ".." || $op eq "to" || $op eq "..="} { if { $a > $b && $step > 0 && $nostep == 1} { set step [expr { 0 - $step }] } if { $step == 0 || ($step < 0 && $a <= $b) || ($step > 0 && $b < $a && $nostep)} { return {} } if { $by ne "by" } { error "range: unknown term for by : $by" } set ostep $step set step [expr { abs($step) }] set result {} if { $a <= $b } { set nitems [expr { int( ($b - $a + $step) / $step ) }] for {set m 0} {$m < $nitems } {incr m} { set e [expr { $a + $m * $step }] if {!$inc && $e >= $b } { break } lappend result $e } } else { set nitems [expr { int( ($a - $b - $ostep) / (-$ostep) ) }] for {set m 0} {$m < $nitems } {incr m} { set e [expr { $a - $m * $step }] if {!$inc && $e <= $b } { break } lappend result $e } } return $result } elseif { $op eq "-count" } { set a [expr { $a - $step }] lmap b [lrepeat [expr { int($b) }] 0] {set a [expr { $a + $step }]} } else { error "unknown range op $op" } } #proc gui stuff if [catch { package require tooltip tooltip::tooltip delay 2000 } err_code] { puts $err_code } ttk::labelframe .f1 -text "min/max" ttk::labelframe .f2 -text "move" ttk::frame .f3 ttk::button .f1.min -text "Min/Save" -command {Min} ;# -image $image ;# ttk::button .f1.max -text "Res/Open" -command {Max} ;# -image $image ;# ttk::button .f1.cls -text "Close all" -command {closeall} ;# -image $image ;# ttk::button .f1.rsi -text "Resize" -command {resizeall 1} ;# -image $image ;# ttk::button .f2.mov1 -text " 1 " -command {Move 1 1} ;# -image $image ;# ttk::button .f2.mov2 -text " 2 " -command {Move 2 1} ;# -image $image ;# ttk::button .f2.mov3 -text " 3 " -command {Move 3 1} ;# -image $image ;# ttk::button .f3.con -text "Console" -command {console show} ;# -image $image ;# ttk::button .f3.hom -text "home" -command {wm geom . +1921+1} ;# -image $image ;# ttk::checkbutton .f3.top -text "On Top" -variable ontop -command {OnTop} ;# -image $image ;# bind .f1.min {::popup::show %W MainSave} bind .f1.max {::popup::show %W MainRestore} if [catch { tooltip::tooltip .f1.min "left click: minimise all windows\nright click: menu of save slots" tooltip::tooltip .f1.max "left click: restore all windows\nright click: menu of restore slots" tooltip::tooltip .f1.cls "left click: close all windows" tooltip::tooltip .f1.rsi "left click: resize all windows\nright click: resize smaller\nshift-right click: smallest resize" tooltip::tooltip .f2.mov1 "left click: stack windows on monitor 1\nright click: reverse sort" tooltip::tooltip .f2.mov2 "left click: stack windows on monitor 2\nright click: reverse sort" tooltip::tooltip .f2.mov3 "left click: stack windows on monitor 3\nright click: reverse sort" tooltip::tooltip .f3.con "open console" tooltip::tooltip .f3.hom "move program window to second monitor\nmodify code of .f3.hom to customize" tooltip::tooltip .f3.top "keep window on top" } err_code] { puts $err_code } foreach item {1 2 3} { bind .f2.mov$item <3> [list Move $item 2] bind .f2.mov$item [list Move $item 3] } bind .f1.rsi <3> [list resizeall 2] bind .f1.rsi [list resizeall 3] pack .f1 .f2 .f3 -fill both -expand true pack .f1.min .f1.max .f1.cls .f1.rsi .f2.mov1 .f2.mov2 .f2.mov3 .f3.con -fill both -expand true -side left pack .f3.hom .f3.top -fill both -expand true -side left wm title . hexplorer package require twapi namespace eval popup { set VERSION 0.1 } proc ::popup::create {m {tear 1}} { #---------------- # create menu (m) with from list of supplied items (a) #--------------- set c $m set m ".[string tolower $m]" # destroy any pre-exising menu with the same name destroy $m # create new menus menu $m -tearoff $tear foreach i $::popup::menu($c) { # puts "popup create c= |$c| m= |$m| i= |$i| " if { [lindex $i 0] != "nop" } { eval $m add $i } } } proc ::popup::show {w m} { #--------------- # display the popup menu adjacent to the current pointer location #--------------- set m ".[string tolower $m]" foreach {x y} [winfo pointerxy $w] {} set ::active(tag) $m tk_popup $m $x $y return } proc menusetup {} { set ::menu_items 10 set ::menu_font_size 10 set ::popup::menu(mainSave) [lmap i [range 1 to $::menu_items] \ {list command -label "save $i" -command "SaveSet $i" -font [list "Lucida Sans" $::menu_font_size] -background lightgreen}] lappend ::popup::menu(mainSave) [list command -label "reset menus" -command {after 500 menusetup} -font [list "Lucida Sans" $::menu_font_size] -background yellow ] set ::popup::menu(mainRestore) "" foreach item [range 1 to $::menu_items] { set file [file join [file dirname $::thescript] saveset$item.txt] set txt "" if { [file exist $file ] } { set color lightgreen set io [open $file r] set data [read -nonewline $io] set lines [split $data \n] if { [llength $lines] > 1 } { set txt [lindex $lines 1] } close $io } else { set color pink } set foo "command -label \{restore $item $txt\} -command \{OpenSet $item \} -font \{{Lucida Sans} $::menu_font_size\} -background $color" append ::popup::menu(mainRestore) "\{" $foo "\} \n" } append ::popup::menu(mainRestore) "\{" "command -label cancel -font \{{Lucida Sans} $::menu_font_size\} -background yellow" "\} \n" ::popup::create mainSave 0 ::popup::create mainRestore ;# has tearoff puts "menus setup complete" } menusetup #proc proc wait { ms } { set uniq [incr ::__sleep__tmp__counter] set ::__sleep__tmp__$uniq 0 after $ms set ::__sleep__tmp__$uniq 1 vwait ::__sleep__tmp__$uniq unset ::__sleep__tmp__$uniq } rename ::set ::o_l_d_s_e_t ;# save existing set command proc ::set {var args} { ;# modified set command, with 3 or more args and expression assignment if { [llength $args] <= 1 } { uplevel 1 [list o_l_d_s_e_t $var {*}$args] } else { if { [lindex $args 0] ne "=" } { error "set: Invalid 3+ arg operator: \"[lindex $args 0]\" should be \"=\"" } uplevel 1 [list o_l_d_s_e_t $var [expr {*}[lrange $args 1 end]]] } } if [catch { package require awdark ::ttk::style theme use awdark } err_code] { puts $err_code } proc closeall {args} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize false] foreach w $windows { set zzz [twapi::get_window_text $w] puts "w= |$w| zzz= |$zzz| " update twapi::close_window $w } puts "length = [llength $windows]" } proc resizeall {size} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize false] foreach w $windows { set zzz [twapi::get_window_text $w] puts "w= |$w| zzz= |$zzz| " update if { $size == 1 } { twapi::resize_window $w 1650 700 } elseif { $size == 2 } { twapi::resize_window $w 1450 500 } else { twapi::resize_window $w 1350 400 } } puts "length = [llength $windows]" } proc SaveSet {n} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize false] unset -nocomplain ::set($n) foreach w $windows { set zzz [twapi::get_window_text $w] puts "w= |$w| zzz= |$zzz| " update lappend ::set($n) $zzz } puts "length = [llength $windows]" if { [llength $windows] <= 0 } { tk_messageBox -message "No Explorer Windows found" -icon warning -type ok return } set comment "" set file [file join [file dirname $::thescript] saveset$n.txt] puts "file= |$file| " if { [file exists $file] } { set io [open $file r] set data [read -nonewline $io] set data [split $data \n] if { [llength $data] > 1} { set comment [lindex $data 1] } close $io } if [catch { regexp {^([0-9]+)x([0-9]+)([+-])([+-]?[0-9]+)([+-])([+-]?[0-9]+)} [wm geom .] -> dx dy xs xpos ys ypos set geom +$xpos+$ypos if {[getstring::tk_getString .g text "click and enter optional label:" -geometry $geom -allowempty 1]} { puts "user entered: $text" if { $text eq "" } { set text $comment ;# if user enters a null string, use existing comment if available } } else { ;# if cancelled return -code error "Cancelled" ;# don't do the operation, does the error path and err_coce with be the text Cancelled } } err_code] { puts $err_code return } set io [open $file w] puts $io $::set($n) puts $io $text close $io menusetup ;# repopulate menu } proc OpenSet {n} { set file [file join [file dirname $::thescript] saveset$n.txt] set io [open $file r] set data [read -nonewline $io] set lines [split $data \n] set theset [lindex $lines 0] close $io if { [llength $lines] > 1 } { puts stderr "restoring [lindex $lines 1]" } foreach item $theset { puts " item= |$item| " exec cmd /c start "" $item } } proc Min {args} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize false] foreach w $windows { set zzz [twapi::get_window_text $w] puts "w= |$w| zzz= |$zzz| " update twapi::minimize_window $w } puts "length = [llength $windows]" } proc Max {args} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize true] foreach w $windows { set zzz [twapi::get_window_text $w] puts "w= |$w| zzz= |$zzz| " update twapi::restore_window $w } puts "length = [llength $windows]" } proc Move {N mode} { set pids [twapi::get_process_ids -glob -path {*Explorer.exe*}] ;# find all pids for Explorer set windows [twapi::find_windows -pids $pids -toplevel true -visible true -popup false -minimizebox true -minimize false] set Y -40 set X 100 set extra [expr { (($N-1) * 1920)+$mode }] incr X $extra set pair {} set uniq(xyz) {} foreach w $windows { set zzz [twapi::get_window_text $w] if { [info exist uniq($zzz)] } { puts "exists $zzz - $uniq($zzz) $w" twapi::close_window $w incr uniq($zzz) continue } incr uniq($zzz) lappend pair [list $w $zzz] } puts $pair if { $mode == 1 } { set pair [lsort -index 1 $pair] } elseif { $mode == 2 } { set pair [lsort -decreasing -index 1 $pair] } elseif { $mode == 3 } { set pair [lsort -command cmp -index 0 $pair] } else { } puts $pair foreach p $pair { lassign $p w text incr Y 38 incr X 20 puts "w= |$w| X= |$X| Y= |$Y| text= |$text| " update twapi::restore_window $w -activate -sync twapi::move_window $w $X $Y -sync # wait 50 twapi::set_foreground_window $w update } puts "length = [llength $windows]" } proc cmp {a b} { set axl [twapi::get_window_coordinates $a] lassign $axl left top right bottom set ax = abs($right - $left) * abs($bottom - $top) set bxl [twapi::get_window_coordinates $b] lassign $bxl left top right bottom set bx = abs($right - $left) * abs($bottom - $top) if { $ax == $bx } { return 0 } elseif { $ax < $bx } { return 1 } elseif { $ax > $bx } { return -1 } else { } } proc OnTop {args} { set me [::twapi::find_windows -match glob -text *hexplorer* -pids [pid] -single] if { $::ontop } { twapi::set_window_zorder $me toplayer } else { twapi::set_window_zorder $me bottomlayer } } ====== <> <> Windows | WindowsTricks