Today - add a subfolder like yy_mmdd

Today - Adds a subfolder like yy_mmdd

       The Zipguy 01/25/2005          zipguypub @ bellsouth dot net  {"dot" = "."}

How'd you like this right-click menu choice of

http://www.nonags.org/members/zipguy/tcl/today/menuchoice.jpg

where if you did click this choice you'd see

http://www.nonags.org/members/zipguy/tcl/today/today_v0_71.jpg

where you could type in any subfolder name you'd like to. If you click on ok then it would go ahead and try to add it.

The Zipguy likes to do this under his photo folder and collect all the camera files by date.

Here's the necessary code and you'd need to add it to your right click menu by doing a regedit.

  First back it up. 
  Then go to the "Directory" key under "HKEY_CLASSES_ROOT".
  Add a subkey under the "shell" subkey of "Today" with a subkey of that called "command" and add the "default" key of:

   "D:\@umark\TCL\Starkit\tclkit-win32.upx.exe" "D:\@umark\TCL\Starkit\today.kit" "%1"

This should look like this:

http://www.nonags.org/members/zipguy/tcl/today/regedit.jpg

Hope you enjoy this. Here's the code and this is a downloadable [L1 ] file!

  proc makeSub {} {
    global sub
    file mkdir "$sub"
  }

  package require Tk
  #  console show

  if {$argc>0} {
      # replace back slashes with slashes
      set dir  [file join [lindex $argv 0] ]
  } else {
      set dir "[pwd]"
  }
  puts "dir     $dir"

  set now [clock scan now]
  set sub  "[clock format $now -format "%y_%m%d"]"
  puts "Directory is $sub"

  set t .input
  wm title . "Today v0.71"
  set f1 [frame .f1]
  set f2 [frame .f2]
  pack $f1 -side top -expand 1 -fill both
  pack $f2 -side top -expand 1 -fill both

  set f [frame $f1.f1]
  pack $f -side top -expand 1 -fill both

  label $f.l1 -text "Directory"
  label $f.e1 -textvariable dir
  pack $f.l1 -side left 
  pack $f.e1 -side right -expand 1 -fill both

  set f [frame $f1.f2]
  label $f.l2 -text "Subfolder"
  entry $f.e2 -textvariable sub
  pack $f -side top -expand 1 -fill both
  pack $f.l2 $f.e2 -side left -expand 1 -fill both

  button $f2.bOk -text "OK" -command "makeSub;exit"
  button $f2.bCancel -text "Cancel" -command "exit"
  pack $f2.bOk     -side left
  pack $f2.bCancel -side right