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.
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
exitPlace 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:
@<Path to Wish> "<Path to your Tcl script>" %*
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
exitThe 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 {}]
updatewith 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 [L1 ] 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:
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#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 <Button-3> {::popup::show %W MainSave}
bind .f1.max <Button-3> {::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 <Shift-3> [list Move $item 3]
}
bind .f1.rsi <3> [list resizeall 2]
bind .f1.rsi <Shift-3> [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
}
}