home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / CorePackages / unix.tcl < prev    next >
Encoding:
Text File  |  1998-11-21  |  2.8 KB  |  110 lines  |  [TEXT/ALFA]
  1. # Note that if Alpha upgrades to Tcl 8.0, these procs should be replaced
  2. # with simple wrappers around the Tcl procs 'file mkdir' 'file copy' etc.
  3. # (the built in Tcl 8.0 ones are more robust and cope better with the
  4. # Mac filesystem than Alpha's procedures)
  5. #================================================================================
  6.  
  7. # improvements, first version by Mark Nagata, then Vince and recently 
  8. # Johan improved them further (and fixed bugs)
  9. proc cp args {
  10.     eval movecopy cp copy $args
  11. }
  12.  
  13. proc mv args {
  14.     eval movecopy mv move $args
  15. }
  16.  
  17. proc movecopy {cmd0 cmd args} {
  18.     global file::separator
  19.     if {[llength $args] < 2} {
  20.     error "usage: $cmd0 <file1> <file2>\r       $cmd0 <file1> .... <dir>"
  21.     }
  22.     set dir [lindex $args end]
  23.     if {![regexp "${file::separator}" $dir] && $dir != ""} {
  24.     set dir "${file::separator}$dir"
  25.     }
  26.     if {[regexp "${file::separator}\$" $dir]} {
  27.     set dir [string trimright $dir ${file::separator}]
  28.     }
  29.     set args [lreplace $args end end]
  30.     set files {}
  31.     foreach arg $args {
  32.     eval lappend files [glob -nocomplain $arg]
  33.     }
  34.     set report ""
  35.     if {[llength $files] == 1} {
  36.     set f [lindex $files 0]
  37.     if {[file exists $dir]} {
  38.         set targ [file join $dir [file tail $f]]
  39.         append report "$f >-> $targ \r"
  40.         ${cmd}File $f $targ
  41.     } else {
  42.         append report "$f >-> $dir \r"
  43.         ${cmd}File $f $dir
  44.     }
  45.     } else {
  46.     if {$dir != ""} {
  47.         if {[regexp "^${file::separator}" $dir]} {
  48.         file::ensureDirExists "[pwd][string range $dir 1 end]"
  49.         } else {
  50.         regexp "^\[^${file::separator}\]+${file::separator}" $dir disk
  51.         if {![file exists $disk]} {error "No disk '$disk'"}
  52.         file::ensureDirExists $dir
  53.         }
  54.     }
  55.     foreach f $files {
  56.         message [file tail $f]
  57.         set targ [file join $dir [file tail $f]]
  58.         if {[catch {${cmd}File $f $targ} that]} {
  59.         append report "Error trying to $cmd '$f': $that\r"
  60.         } else {
  61.         append report "$f >-> $targ \r"
  62.         }
  63.     }
  64.     }
  65.     echo [string trimright $report]
  66. }
  67.  
  68. proc rm args {
  69.     set opts(-r) 0
  70.     getOpts
  71.     set files {}
  72.     foreach arg $args {
  73.         eval lappend files [glob -nocomplain $arg]
  74.     }
  75.     __rm $opts(-r) $files
  76. }
  77.  
  78. proc __rm {recurse names} {
  79.     foreach f $names {
  80.     if {[file isdir $f]} {
  81.         if {$recurse} {
  82.         __rm $recurse [glob -nocomplain [file join ${f} *]]
  83.         } 
  84.         file delete $f
  85.     } else {            
  86.         message [file tail $f]        
  87.         file delete $f                
  88.     }            
  89.     }
  90. }
  91.  
  92. proc textToAlpha {{dir ""}} {
  93.     set num 0
  94.     if {![string length $dir]} {
  95.         set dir [get_directory -p "Creators to 'ALFA':"]
  96.     }
  97.  
  98.     foreach f [glob -nocomplain [file join $dir *]] {
  99.         if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  100.             message $f
  101.             setFileInfo $f creator ALFA
  102.             incr num
  103.         } elseif {[file isdir $f]} {
  104.             incr num [textToAlpha $f]
  105.         }
  106.     }
  107.     message "Converted $num files"
  108.     return $num
  109. }
  110.