home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha.6.0.sit / Tcl / SystemCode / shell.tcl / shell.tcl
Encoding:
Text File  |  1995-06-22  |  13.0 KB  |  522 lines  |  [TEXT/ALFA]
  1.  
  2. ################################################################################
  3. # Shell routines.
  4. ################################################################################
  5.  
  6.  
  7. proc setShellMode {} {
  8.     setTclMode
  9.     changeMode "Shel"
  10.     insertMenu "Tcl"
  11. }
  12.  
  13. proc initShell {} {
  14.     insertText "Welcome to Alpha's Tcl shell."
  15.     insertText -w [lindex [winNames] 0] [shellPrompt]
  16. }
  17.  
  18. # Return the prompt. We want the window name because some of the commands
  19. # we evaluate (such as 'edit') open a new window, and we want the insertion
  20. # to be done in the shell window.
  21. proc shellPrompt {} {
  22.     return "\r╟[file tail [string trimright [pwd] {:}]]╚ "
  23. }
  24.  
  25.  
  26. # Called at all carriage returns.
  27. proc carriageReturn {} {
  28.     global mode
  29.     global indentOnCR
  30.     set indentString ""
  31.     deleteText [getPos] [selEnd]
  32.     if {$indentOnCR} {
  33.         set pos [getPos]
  34.         set text [getText [lineStart $pos] $pos]
  35.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  36.             set c [string index $text $i]
  37.             if {($c != "\t") && ($c != "\ ")} {
  38.                 set indentString [string range $text 0 [expr $i-1]]
  39.                 break
  40.             }
  41.         }
  42.     }
  43.     insertText "\r" $indentString
  44. }
  45.  
  46.  
  47. proc shellCarriageReturn {} {
  48.     global mode histnum
  49.     global _text
  50.     global _returnText
  51.     set pos [getPos]
  52.  
  53.     if {![catch {regexp {░} [getText $pos [nextLineStart $pos]]} res] && $res} {
  54.         gotoMatch; return;
  55.     }
  56.     set ind [string first "╚" [getText [lineStart $pos] $pos]]
  57.     if {$ind < 0} {
  58.         carriageReturn
  59.         return
  60.     }
  61.     set lStart [expr [lineStart $pos]+$ind+2]
  62.     endOfLine
  63.     set _text [getText $lStart [getPos]]
  64.     set fileName [lindex [winNames] 0]
  65.     if {[getPos] != [maxPos]} {
  66.         goto [maxPos]
  67.         insertText -w $fileName $_text
  68.     }
  69.     if {[string first "Toolserver" $fileName] != -1} {
  70.         if {![catch {dosc -n ToolServer -s $_text} _returnText]} {
  71.             insertText "\r" $_returnText
  72.         } else {
  73.             insertText "\r"
  74.         }
  75.         mpwPrompt
  76.     } else {
  77.         uplevel #0 {catch $_text _returnText}
  78.         history add $_text
  79.         if {[string length $_returnText]} {
  80.             insertText -w $fileName "\r" $_returnText [shellPrompt]
  81.         } else {
  82.             insertText -w $fileName [shellPrompt]
  83.         }
  84.         set histnum [history nextid]
  85.     }
  86.     unset _text
  87.     unset _returnText
  88. }
  89. bind '\r' carriageReturn
  90. bind '\r' shellCarriageReturn "Shel"
  91. bind '\r' shellCarriageReturn "MPW"
  92.  
  93.  
  94. bind up <z> prevHist Shel
  95. bind down <z> nextHist Shel
  96.  
  97. proc prevHist {} {
  98.     global histnum
  99.     
  100.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  101.     if {[set ind [string first "╚ " $text]] > 0} {
  102.         goto [expr [lineStart [getPos]] + $ind + 2]
  103.     } else return
  104.  
  105.     incr histnum -1
  106.     if {[catch {history event $histnum} text]} {
  107.         incr histnum
  108.         endOfLine
  109.         return
  110.     }
  111.     set to [nextLineStart [getPos]]
  112.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  113.     replaceText [getPos] $to $text
  114. }
  115.  
  116.  
  117. proc nextHist {} {
  118.     global histnum
  119.     
  120.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  121.     if {[set ind [string first "╚ " $text]] > 0} {
  122.         goto [expr [lineStart [getPos]] + $ind + 2]
  123.     } else return
  124.  
  125.     incr histnum
  126.     if {[catch {history event $histnum} text]} {
  127.         incr histnum -1
  128.         endOfLine
  129.         return
  130.     }
  131.     set to [nextLineStart [getPos]]
  132.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  133.     replaceText [getPos] $to $text
  134. }
  135.  
  136.     
  137. proc startMPW {} {
  138.     global toolserverPath
  139.  
  140.     if {![string length [checkRunning ToolServer MPSX toolserverPath]]} return
  141.  
  142.     insertText "Welcome to Alpha's MPW shell (using ToolServer via AppleEvents)."
  143.     bind '\r' shellCarriageReturn "MPW"
  144.     carriageReturn
  145.     mpwPrompt
  146. }
  147. proc mpwPrompt {} {
  148.     insertText "╟mpw╚ "
  149. }
  150.  
  151. proc setMPWMode {} {
  152.     changeMode "MPW"
  153. }
  154.  
  155. #    shellCarriageReturn
  156.  
  157.  
  158.  
  159. #=============================================================================
  160. #    Shell Aliases
  161. #=============================================================================
  162.  
  163.  
  164. proc l {args} {
  165.     eval [concat "ls -CF" $args]}
  166.  
  167. proc ll {args} {
  168.     eval [concat "ls -l" $args]}
  169.  
  170.  
  171. proc wc {args} {
  172.     set res {}
  173.     set totChars 0
  174.     set totLines 0
  175.     set totWords 0
  176.     set args [glob -nocomplain $args]
  177.     foreach file $args {
  178.         set id [open $file]
  179.         set chars [string length [set text [read $id]]]
  180.         set lines [llength [split $text "\n"]]
  181.         set words [llength [split $text]]
  182.         append res [format "\r%8d%8d%8d    $file" $lines $words $chars]
  183.         set totChars [expr $totChars+$chars]
  184.         set totWords [expr $totWords+$words]
  185.         set totLines [expr $totLines+$lines]
  186.         close $id
  187.     }
  188.     if {[llength $args] > 1} {
  189.         append res [format "\r%8d%8d%8d    total" $totLines $totWords $totChars]
  190.     }
  191.     return [string range $res 1 end]
  192. }
  193.  
  194. ###########################################################################
  195. #  better-cp-mv.tcl  -- modification of your routines, by Mark Nagata
  196. #  for Alpha 5.72,  1/04/94
  197. ###########################################################################
  198. proc cp args {
  199.     if {[set len [llength $args]] < 2} {
  200.         error "usage: cp <file1> <file2>\r       cp <file1> .... <dir>"
  201.     }
  202.     set len [expr $len-1]
  203.     set dir [lindex $args $len]
  204.     if {![regexp {:} $dir] && $dir != ""} {
  205.         set dir ":$dir"
  206.     }
  207.     if {[regexp {:$} $dir]} {
  208.         set dir [string trimright $dir {:}]
  209.     }
  210.     set args [lreplace $args $len $len]
  211.     set files {}
  212.     foreach arg $args {
  213.         append files " " [glob $arg]
  214.     }
  215.     set report ""
  216.     if {[llength $files] == 1} {
  217.         set f [lindex $files 0]
  218.         if {[file exists $dir]} {
  219.             set targ $dir:[file tail $f]
  220.             append report $f\ ->\ $targ \r 
  221.             copyFile $f $targ
  222.         } else {
  223.             append report $f\ ->\ $dir \r
  224.             copyFile $f $dir
  225.         }
  226.     } else {
  227.         foreach f $files {
  228.             message [file tail $f]
  229.             set targ $dir:[file tail $f]
  230.             if {[catch {copyFile $f $targ} that]} {
  231.                 append report "Error copying '$f': $that\r"
  232.             } else {
  233.                 append report $f\ ->\ $targ \r
  234.             }
  235.         }
  236.     }
  237.     echo [string trimright $report]
  238. }
  239.  
  240. proc mv args {
  241.     if {[set len [llength $args]] < 2} {
  242.         error "usage: mv <file1> <file2>\r       mv <file1> .... <dir>"
  243.     }
  244.     set len [expr $len-1]
  245.     if {![regexp {.*[^:]} [lindex $args $len] dir]} {
  246.         set dir [string range [lindex $args $len] 1 end]
  247.     }
  248.     if {![regexp {:} $dir] && $dir != ""} {
  249.         set dir [concat :$dir]}
  250.     set args [lreplace $args $len $len]
  251.     set files {}
  252.     foreach arg $args {
  253.         append files " " [glob $arg]
  254.     }
  255.     set report ""
  256.     if {[llength $files] == 1} {
  257.         set f [lindex $files 0]
  258.         if {[file exists $dir]} {
  259.             set targ $dir:[file tail $f]
  260.             append report $f\ >->\ $targ \r
  261.             moveFile $f $targ
  262.         } else {
  263.             append report $f\ >->\ $dir \r
  264.             moveFile $f $dir
  265.         }
  266.     } else {
  267.         foreach f $files {
  268.             message [file tail $f]
  269.             set targ $dir:[file tail $f]
  270.             if {[catch {moveFile $f $targ} that]} {
  271.                 append report "Error moving '$f': $that\r"
  272.             } else {
  273.                 append report $f\ >->\ $targ \r
  274.             }
  275.         }
  276.     }
  277.     echo [string trimright $report]
  278. }
  279.  
  280.  
  281. proc rm args {
  282.     set files {}
  283.     foreach arg $args {
  284.         append files " " [glob $arg]
  285.     }
  286.     foreach f $files {
  287.         message [file tail $f]
  288.         removeFile $f
  289.     }
  290. }
  291.  
  292.  
  293.  
  294.  
  295. #================================================================================
  296.  
  297.  
  298. proc tclFileCompletion {} {
  299.     set silly "*"
  300.     set pos [getPos]
  301.     set res [search -f 0 -i 0 -m 0 -r 1 -n {["\{ \t\r]} [expr $pos - 1]]
  302.     if {[string length $res]} {
  303.         set from [lindex $res 1]
  304.         if {$from < $pos} {
  305.             set pd [pwd]
  306.             set text [getText $from $pos]
  307.             if {[string index $text 0] == ":"} {
  308.                 set pd [string trimright $pd ":"]
  309.             }
  310.             if {[catch {glob $pd$text$silly} globbed]} {
  311.                 set globbed [glob $text$silly]
  312.                 set pd ""
  313.             }
  314.             if {[llength $globbed] == 1} {
  315.                 set len [string length $pd$text]
  316.                 insertText [string range [lindex $globbed 0] $len end]
  317.             } elseif {[llength $globbed] != 0} {
  318.                 set globbed [lsort $globbed]
  319.                 set one [lindex $globbed 0]
  320.                 set two [lindex $globbed end]
  321.                 
  322.                 set len [string length $pd$text]
  323.                 set one [string range $one $len end]
  324.                 set two [string range $two $len end]
  325.                 
  326.                 set elen [string length $one]
  327.                 if {[string length $two] < $elen} {
  328.                     set elen [string length $two]
  329.                 }
  330.                 set len 0
  331.                 set str ""
  332.                 while {($len < $elen) && ([string match $str[string index $one $len]$silly $two])} {
  333.                     append str [string index $one $len]
  334.                     incr len
  335.                 }
  336.  
  337.                 if {!$len} {
  338.                     set elen [string length $pd]
  339.                     foreach g $globbed {
  340.                         lappend short [string range $g $elen end]
  341.                     }
  342.                     set blah [getText [lineStart [getPos]] [getPos]]
  343.                     insertText "\r" $short "\r" $blah
  344.                 } else {
  345.                     insertText $str
  346.                 }
  347.             }
  348.         }
  349.     }
  350. }
  351.  
  352.  
  353.  
  354. #================================================================================
  355. # To prevent ambiguity, 'from' is assumed to be a complete pathname, ending
  356. # in a directory name. If it doesn't end w/ a colon, one is added. 'to' is
  357. # assumed to be the parent directory of the top directory we are creating.
  358. #================================================================================
  359. proc cpdir {from to} {
  360.     set cwd [pwd]
  361.     if {[string match ":*" $from] || [string match ":*" $to] ||
  362.         ![file exists $from] || ![file exists $to]} {
  363.         error "'cpdir' args must be complete pathnames of existing folders."
  364.     }
  365.     if {![string match "*:" $from]} {append from ":"}
  366.     if {![string match "*:" $to]} {append to ":"}
  367.     
  368.     if {![file isdir $from] || ![file isdir $to]} {
  369.         exit 1
  370.     }
  371.         
  372.     set res [catch {cphier $from $to} val]
  373.     cd $cwd
  374.     if {$res} {error $val}
  375. }
  376.  
  377. proc cphier {from to} {
  378.     set savedir [pwd]
  379.     if {[string index $from [expr [string len $from] - 1]] != ":"} {append from ":"}
  380.     set dir [file tail [string trimright $from ":"]]
  381.     cd $to
  382.     mkdir "$dir"
  383.     foreach f [glob "$from*"] {
  384.         if {[file isdir $f]} {
  385.             cphier "$f:" "$to$dir:"
  386.         } else {
  387.             cp $f $to$dir:
  388.         }
  389.     }
  390.     cd $savedir
  391. }
  392.  
  393.  
  394. proc mkdir {dir} {
  395.     oldMkdir [list $dir]
  396. }
  397.  
  398. proc rmdir {dir} {
  399.     oldRmdir [list $dir]
  400. }
  401.  
  402. proc shellBol {} {
  403.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  404.     if {[set ind [string first "╚ " $text]] > 0} {
  405.         goto [expr [lineStart [getPos]] + $ind + 2]
  406.     } else {
  407.         goto [lineStart [getPos]]
  408.     }
  409. }
  410. bind 'a' <z> shellBol Shel
  411.  
  412.  
  413. proc dummyShel {} {dummyTcl}
  414.  
  415. #================================================================================
  416.  
  417. proc shellup {} {
  418.     set pos [expr [lineStart [getPos]] - 1]
  419.     if {[catch {regexp {░} [getText [lineStart $pos] [nextLineStart $pos]]} res] || !$res} {
  420.         previousLine; return
  421.     }
  422.     select [lineStart $pos] [nextLineStart $pos]
  423. }
  424. bind up shellup Shel
  425.  
  426.  
  427. proc shelldown {} {
  428.     set pos [nextLineStart [getPos]]
  429.     if {[catch {regexp {░} [getText $pos [nextLineStart $pos]]} res] || !$res} {
  430.         nextLine; return
  431.     }
  432.     select $pos [nextLineStart $pos]
  433. }
  434. bind down shelldown Shel
  435.  
  436.         
  437. #================================================================================
  438. proc sortdt {dt} {
  439.     scan $dt "%d/%d/%d {%d:%d:%d %1sM}" mon day yea hou min sec z
  440.     if {$z == "P"} {incr hou 12}
  441.     return [format "%02d%02d%02d%02d%02d" $yea $mon $day $hou $min]
  442. }
  443.  
  444.  
  445. proc lt args {
  446.     set val "*"
  447.     set sort 1
  448.     scan [lindex [mtime [now]] 0] "%d/%d/%d" one two three
  449.     set year 19$three
  450.     
  451.     foreach arg $args {
  452.         switch -- $arg {
  453.             "-t"     {set sort 0}
  454.             default    {set val $arg}
  455.         }
  456.     }
  457.     set mod ""
  458.     foreach f [eval glob $val] {
  459.         if {[catch {getFileInfo $f info}]} {
  460.             if {$sort} {set mod "0000000000 "}
  461.             lappend text [format "%s%s %8d%8d %6s %5s %4s %s %s\n" $mod "D" "0" "0" "" "" "" "DIR " [file tail $f]]
  462.             continue
  463.         }
  464.         if {$sort} {set mod "[sortdt [mtime $info(modified) s]] "}
  465.         set m [mtime $info(modified) a]
  466.         set zer [lindex $m 0]
  467.         set dat [format "%s %2s" [lindex $zer 1] [string trimright [lindex $zer 2] {,}]]
  468.         if {[lindex $zer 3] == $year} {
  469.             if {[scan [lindex $m 1] "%d:%d:%d %s" one two three am] != 4} {
  470.                 error "Didn't get four from scan"
  471.             }
  472.             if {[string length $two] == 1} {set two "0$two"}
  473.             set tm [expr {$am == "AM"} ? $one : [expr $one + 12]]:$two
  474.         } else {
  475.             set tm " [lindex $zer 3]"
  476.         }
  477.         lappend text [format "%sF %8d%8d %s %5s %s %s %s\n" $mod $info(datalen) $info(resourcelen) $dat $tm $info(creator) $info(type) [file tail $f]]
  478.     }
  479.     if {$sort} {
  480.         foreach ln [lsort -de $text] {
  481.             append txt [string range $ln 11 end]
  482.         }
  483.         return [string trimright $txt]
  484.     } else {
  485.         return [string trimright [join $text {}]]
  486.     }
  487. }
  488.  
  489. #================================================================================
  490. proc ps {} {
  491.     foreach p [processes] {
  492.         append text [format "%-25s %4s %10d %10d\r" [lindex $p 0] [lindex $p 1] [lindex $p 2] [lindex $p 3]]
  493.     }
  494.     return [string trimright $text]
  495. }
  496.  
  497.  
  498. #================================================================================
  499. # Recursively make creator of all text files 'ALFA'. Optionally takes a starting
  500. # dir argument, otherwise starts in current directory. Auto-Doubled are no 
  501. # longer recognized by auto-doubler! Why? Some sort of conflict w/ 'PBSetFInfo'.
  502. proc creator {{dir ":"}}  {
  503.     if {![catch {glob -t TEXT $dir*} files]} {
  504.         foreach f $files {
  505.             message $f
  506.             setFileInfo $f creator ALFA
  507.         }
  508.     }
  509.  
  510.     if {![catch {glob $dir*} dirs]} {
  511.         foreach d $dirs {
  512.             if {[file isdir $d]} {creator $d:}
  513.         }
  514.     }
  515. }
  516.  
  517.  
  518.  
  519. #===============================================================================
  520.  
  521. proc ShelDblClick {from to} { TclDblClick $from $to }
  522.