home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha60.hqx / Tcl / SystemCode / procs.tcl < prev    next >
Encoding:
Text File  |  1995-07-14  |  23.0 KB  |  929 lines
  1.  
  2. #==============================================================================
  3. # Load electric alias, rebind tcl file completion for precedence.
  4. proc loadElectricAlias {} {
  5.     global HOME
  6.     uplevel #0 {
  7.         source "$HOME:Tcl:ElectricAlias:electricAlias.tcl"
  8.     }
  9.     message "ElectricAlias loaded."
  10.     bind '\t' tclFileCompletion "Shel"
  11.     enableMenuItem -m install "Electric Alias" off
  12. }
  13.  
  14. proc debug {} {
  15.     uplevel #0 {
  16.         set debugging 1
  17.     }
  18. }
  19.  
  20.  
  21. proc normalLeftBracket {} {
  22.     insertText "\{"
  23. }
  24. proc normalRightBracket {} {
  25.     insertText "\}"
  26. }
  27. bind '\[' <zs>  normalLeftBracket
  28. bind '\]' <zs>  normalRightBracket
  29.             
  30. # Select the next or current word. If word already selected, will go to next.
  31. proc hiliteWord {} {
  32.     if {[getPos]!=[selEnd]}    forwardChar
  33.     forwardWord
  34.     set start [getPos]
  35.     backwardWord
  36.     select $start [getPos]
  37. }
  38.  
  39. bind 'h' <z> hiliteWord
  40.  
  41. #================================================================================
  42. # Mode variables
  43. #================================================================================
  44. # For mark stack.
  45. set markName 0
  46. set markStack ""
  47.  
  48. # mapping of windows to current modes.
  49. set winModes("") ""
  50.  
  51. # making vars local to windows
  52. # 'incomingVars' used to hold old var values that have been overwritten in current window
  53.  
  54. #================================================================================
  55. # Handle 'flag' and 'var' menu selections.
  56. #================================================================================
  57. proc editFlag {menu item} {
  58.     global $item incomingVars localVars modifiedVars
  59.  
  60.     if {[regexp {\? (.*)} $item dummy var]} {
  61.         alphaHelp
  62.         eval select [search -f 1 -r 1 "^$var"]
  63.         return
  64.     }
  65.     lappend modifiedVars $item
  66.     set val [expr ([set $item]-1)*-1]
  67.     markMenuItem $menu $item [expr ($val)?"on":"off"]
  68.     set $item $val
  69.  
  70. }
  71.  
  72. proc editVar {menu item} {
  73.     global $item incomingVars localVars modifiedVars
  74.  
  75.     if {[regexp {\? (.*)} $item dummy var]} {
  76.         alphaHelp
  77.         eval select [search -f 1 -r 1 "^$var"]
  78.         return
  79.     }
  80.     lappend modifiedVars $item
  81.     append prmpt "New Value of " $item ": "
  82.     if ![catch {prompt $prmpt [set $item]} res] {
  83.         set $item $res
  84.     }
  85. }
  86.  
  87.  
  88.  
  89.  
  90. #================================================================================
  91.  
  92. # Instantiate a global variable to the path of a file (usually an app). As a
  93. # side-effect, make the instantiation permanent.
  94. proc addAppPath {name var} {
  95.     global $var modifiedVars
  96.     
  97.     set $var [getfile "Find '$name' app:"]
  98.     lappend modifiedVars $var
  99. }
  100.  
  101.  
  102. proc getFileSig {f} {
  103.     getFileInfo $f arr
  104.     return $arr(creator)
  105. }
  106.  
  107. proc getFileType {f} {
  108.     getFileInfo $f arr
  109.     return $arr(type)
  110. }
  111.  
  112.  
  113. # Look for given app sig in active processes. If not there, try to 
  114. # launch with 'path' prompting for 'path' if necessary.
  115. # Return the real name of the app. Don't switch.
  116.  
  117. # Slightly modified version of 'checkRunning' that looks for any of a
  118. # list of running apps.  The name of the app is returned. 
  119. # 
  120. proc checkRunning {prompt sigs path {in_front 1}} {
  121.     global $path
  122.  
  123.     # See if a process w/ any of the acceptable sigs already running.
  124.     # If so, use it, whether it's the one specified by $path or not.
  125.     #
  126.     foreach proc [processes] {
  127.         # if a running app has the correct sig, ...
  128.         if {[lsearch -exact $sigs [lindex $proc 1]] >= 0} {
  129.             # ...then return its name.
  130.             return [lindex $proc 0]
  131.         }
  132.     }
  133.  
  134.     # If the path variable or the file it references don't exist,
  135.     # or if its sig isn't one that we expect, then prompt the user 
  136.     # to locate the app.
  137.     #
  138.     if {![info exists $path] || ![file exists [set $path]] 
  139.              || [lsearch -exact $sigs [getFileSig [set $path]]] < 0} {
  140.         if {[catch {addAppPath $prompt $path}]} return
  141.     }
  142.  
  143.     # Check that the user's choice has an acceptable sig
  144.     if {[lsearch -exact $sigs [getFileSig [set $path]]] < 0} {
  145.         unset $path
  146.         message "Inappropriate file chosen"
  147.         return {} 
  148.     }
  149.     
  150.     # Launch the app
  151.     if {$in_front} {
  152.         if {[catch {launch -f [set $path]}]} {
  153.             error "Problem with launching file (out of memory?)"
  154.         }
  155.     } else {
  156.         if {[catch {launch [set $path]}]} {
  157.             error "Problem with launching file (out of memory?)"
  158.         }
  159.     }        
  160.     
  161.     # Return the name of the chosen application
  162.     return [file tail [set $path]]
  163. }
  164.  
  165.  
  166. #================================================================================
  167. # Excalibur is the only Mac spell-checker that I know of which will handle LaTeX as
  168. # well as ordinary text.
  169.  
  170.  
  171. proc spellcheckWindow {} {
  172.     global excaliburPath resumeRevert
  173.  
  174.     catch {checkRunning Excalibur XCLB excaliburPath} name
  175.  
  176.     if {[winDirty]} {
  177.         if {[askyesno "Save '[lindex [winNames] 0]'?"] == "yes"} {
  178.             save
  179.         }
  180.     }
  181.     sendOpenEvent noReply $name [lindex [winNames -f] 0]
  182.     switchTo $name
  183.     set resumeRevert 1
  184. }
  185.  
  186. proc spellcheckSelection {} {
  187.     global excaliburPath 
  188.  
  189.     catch {checkRunning Excalibur XCLB excaliburPath} name
  190.  
  191.     if {[getPos] == [selEnd]} {
  192.         beep
  193.         message "No selection"
  194.         return;
  195.     }
  196.     copy
  197.     switchTo $name
  198. }
  199.  
  200. #================================================================================
  201.  
  202.  
  203. proc alphaHelp {} {
  204.     global HOME
  205.     edit -r "$HOME:Help:Manual"
  206. }
  207.  
  208.  
  209. proc tclHelp {} {
  210.     global HOME
  211.     edit -r "$HOME:Help:Tcl Commands"
  212. }
  213.  
  214.  
  215. proc dividingLine {} {
  216.     insertText "===============================================================================\r"
  217. }
  218. bind 'l' <C> dividingLine
  219.  
  220. proc texDividingLine {} {
  221.     insertText "%===============================================================================\r"
  222. }
  223. bind 'l' <C> texDividingLine TeX
  224.  
  225. proc cDividingLine {} {
  226.     insertText "//===============================================================================\r"
  227. }
  228. bind 'l' <C> cDividingLine C
  229. bind 'l' <C> cDividingLine C++
  230.  
  231. proc tclDividingLine {} {
  232.     insertText "#===============================================================================\r"
  233. }
  234. bind 'l' <C> tclDividingLine Tcl
  235.  
  236.  
  237. #================================================================================
  238.  
  239. if {![string length [info commands oldCd]]} {
  240.     rename cd oldCd
  241. }
  242.  
  243. proc cd args {
  244.     global HOME
  245.     if {[llength $args]} {
  246.         oldCd [string trim [eval list $args] "        \{\}"]
  247.     } else {
  248.         oldCd $HOME
  249.     }
  250. }
  251.  
  252.  
  253.  
  254. #############################################################################
  255. #  List the name and value of each element of the array $arrName.
  256. #  (Convenient to use as a shell command.)
  257. #
  258. #  Note: it's slower to insert the lines one-by-one like this, but 
  259. #  assembling everything in $lines before inserting can seriously crash Alpha
  260. #  if the result is too big.  (Trying to list the contents of $auto_index()
  261. #  will do it.)  This method seems to be more robust.
  262. #
  263. proc listArray {arrName} {
  264.     global $arrName
  265.     set lines {}
  266.     if {![catch {info vars $arrName}]} {
  267.         foreach nm [array names $arrName] {
  268.             set val [expr \$$arrName\($nm\)]
  269.             append lines "\r\"$nm\"\t\{$val\}"
  270.         }
  271.         insertText $lines
  272.     } else {
  273.         alertnote "\"$arrName\" doesn't exist in this context"
  274.     }
  275. }
  276.  
  277.  
  278.  
  279. #================================================================================
  280.     
  281. proc selectParagraph {} {
  282.     set pos [getPos]
  283.     set start [paraStart $pos] 
  284.     set finish [paraFinish $pos]
  285.     goto $start
  286.     select $start $finish
  287. }
  288.  
  289. # wrapText ==  getText ; breakIntoLines ; replaceText
  290. # Remove text from window, transform (join, del-ws), insert back into window.
  291. proc fillTextByPar {from to} {
  292.     set text [getText $from $to]
  293.     regsub -all "\r(\[ \t\]*\r)+" $text "\r\r\r" text
  294.     regsub -all "(\[^\r\])\r" $text "\\1 " text
  295.     regsub -all "\[ \t\]+" $text " " text
  296.     return [breakIntoLines $text]
  297. }
  298.  
  299. proc fillRegionByPar {{start -1} {finish -1}} {
  300. #    # if {[getPos] == [selEnd]} { return}
  301.     if {($start < 0) || ($finish < 0)} {
  302.         set start [lineStart [getPos]]
  303.         set finish [selEnd] }
  304.     if {$start >= $finish} return
  305.     goto $start
  306.     set text [fillTextByPar $start $finish]
  307.     replaceText $start $finish $text "\r"
  308. }
  309.     
  310. #
  311. # join Lines in region -- if no optional args, use selection
  312. #
  313. proc joinRegion {{from -1} {to -1}} {
  314.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  315.     if {$from >= $to} return
  316.     set text [getText $from $to]
  317.     regsub -all "\r(\[ \t\]*\r)+" $text "\r\r\r" text
  318.     regsub -all "(\[^\r\])\r" $text "\\1 " text
  319.     replaceText $from $to $text "\r"
  320. }
  321. # WARNING:    regsub ^$ refers to string endpts (not lines)
  322. # FUTURE:    filterLines like perl:
  323. #    replaceText[apply_to_all(cmd,split [getText [getPos] [selEnd]] "\r")]
  324. # OR:    replaceInRegion: dup_\r, $=>\r ??
  325. #
  326.  
  327.  
  328. #
  329. # Remove text from window, transform (delete dup ws), insert back into window.
  330. #
  331. # inputs: message, alertnote, askyesno, listpick, prompt KILLS SELECTION.
  332. # search: bnds = search -forward -regExpr -ignoreCase -matchWords -noabort 
  333. #        -l limit pat pos
  334. # 
  335. proc regsubInRegion {from to srch repl} {
  336.     if {![string length $srch]} return
  337.     if {$from >= $to} return
  338.     set text [getText $from $to]
  339.     regsub -all "$srch" $text "$repl" text
  340.     replaceText $from $to $text
  341. }
  342. #    while {($pos < $to) &&
  343. #          ![catch {search -s -f 1 -r 1 -i 1 -m 0 "$srch" $pos} mtch]} {
  344. #        set mbeg [lindex $mtch 0]
  345. #        set pos [lindex $mtch 1]
  346. #        replaceText $mbeg $pos $repl }
  347.  
  348. #proc backSlashSub {arg} { eval [concat return "\"$arg\""] }
  349.  
  350. proc backSlashSub {arg} {
  351.     regsub -all {\\} $arg {\\\\} arg
  352.     regsub -all {\[} $arg {\\[} arg
  353.     regsub -all {\]} $arg {\\]} arg
  354.     eval [concat return "\"$arg\""]
  355. }
  356.  
  357. proc replaceInRegion {} {
  358.     if [catch {prompt "Search RegExpr:" ""} srch] return
  359.     if [catch {prompt "Replace String:" ""} repl] return
  360.     if {![string length $srch]} return
  361.     regsubInRegion [getPos] [selEnd] \
  362.         [backSlashSub "$srch"] [backSlashSub "$repl"]
  363. }
  364.  
  365. #
  366. # Apply command to each line (or paragraph) in selection ;
  367. #    if no cmd arg then prompts for it
  368. #
  369. proc filterLines {{cmd 0} {parunit 0}} {
  370.     if {$cmd == 0} {
  371.       if {[catch { prompt "Line-filter command: " "" } cmd]} { return } }
  372.     if {![string length $cmd]} return
  373.     set unitStart lineStart
  374.     set unitEnd nextLineStart
  375.     if {$parunit} {
  376.         set unitStart paraStart
  377.         set unitEnd paraFinish }
  378.     set pos [$unitStart [getPos]]
  379.     set finish [selEnd]
  380.     if {$pos >= $finish} return
  381.     goto $pos
  382.     createTMark "filterLend" $finish
  383.     set next [$unitEnd $pos]
  384.     while {(($next > $pos) && ($pos < $finish))} {
  385.         goto [expr $next-1]
  386.         createTMark "filterLnext" $next
  387.         setMark
  388.         goto $pos
  389.         markHilite
  390.         if {[catch [list uplevel #0 "$cmd"] retval]} {
  391.             select $pos $finish
  392.             alertnote $retval
  393.             return
  394.         }
  395.         if {$next==$finish} break
  396.         set ind [lsearch -regexp [lindex [getTMarks] 0] "filterLend.*"]
  397.         set finish [lindex [lindex [lindex [getTMarks] 0] $ind] 2]
  398.         gotoTMark "filterLnext"
  399.         set pos [$unitStart [getPos]]
  400.         set next [$unitEnd $pos]
  401.     }
  402.     removeTMark "filterLend"
  403.     removeTMark "filterLnext"
  404. }
  405.  
  406.  
  407. proc filterParagraphs {{cmd 0}} { filterLines $cmd 1 }
  408.  
  409. # WARNING: deselecting sets the mark to selEnd
  410. proc sortParagraphs {{from -1} {to -1}} {
  411.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  412.     if {$from >= $to} return
  413.     joinRegion {$from $to}
  414.     select [getPos] [nextLineStart [getMark]]
  415.     sortLines
  416.     select [getPos] [getPos]
  417.     regsubInRegion [getPos] [getMark] "\r" "\r\r" 
  418.     wrapRegion
  419. }
  420.  
  421. #
  422. # Sample
  423. #
  424. proc filterRegion {{from -1} {to -1} {cmd 0} {newwin 0}} {
  425.     if {$cmd == 0} {
  426.       if {[catch { prompt "Eval command: " "" } cmd]} { return }
  427.     }
  428.     if {![string length $cmd]} return
  429.     if {($from < 0) || ($to < 0)} {    set from [getPos] ; set to [selEnd] }
  430.     if {$from >= $to} return
  431.     set pos [getPos]
  432.     set text [getText $from $to]
  433.     set text [$cmd $text]
  434.     replaceText $from $to $text "\r"
  435.     goto $pos
  436. }
  437.  
  438.  
  439. #
  440. set lastEvaled ""
  441. proc evaluate {} {
  442.     global lastEvaled
  443.     if {[string length $lastEvaled]} {
  444.         set p "M-x ($lastEvaled): "
  445.     } else {
  446.         set p "M-x: "
  447.     }
  448.     if {[catch {statusPrompt $p} text]} {return}
  449.     if {![string length $text]} {set text $lastEvaled}
  450.     $text
  451.     set lastEvaled $text
  452. }
  453.  
  454.  
  455. # First, define macros to bypass the electric braces.
  456. proc ordLeftBrace {} {
  457.     insertText "        \{"
  458. }
  459. bind {'['} <cs> ordLeftBrace
  460.  
  461. proc ordRightBrace {} {
  462.     insertText "\}"
  463.     blink [matchIt "\}" [expr [getPos]-1]]
  464. }
  465. bind {']'} <cs> ordRightBrace
  466.     
  467. proc quoteWord {} {
  468.     backwardWord
  469.     insertText "'"
  470.     forwardWord
  471.     insertText "'"
  472. }
  473. bind ''' <z> quoteWord
  474.  
  475. #================================================================================
  476.  
  477. proc tomac {fname} {
  478.     set fd [open $fname "r"]
  479.     set text [read $fd]
  480.     close $fd
  481.     set fd [open $fname "w"]
  482.     regsub "\n" $text "\r" text
  483.     puts -nonewline $fd $text
  484.     close $fd
  485. }
  486.  
  487. proc tounix {fname} {
  488.     set fd [open $fname "r"]
  489.     set text [read $fd]
  490.     close $fd
  491.     set fd [open $fname "w"]
  492.     regsub "\r" $text "\n" text
  493.     puts -nonewline $fd $text
  494.     close $fd
  495. }
  496.  
  497.  
  498. proc cat args {
  499.     set files ""
  500.     foreach a $args {
  501.         foreach f [glob $a] {
  502.             lappend files $f
  503.         }
  504.     }
  505.     foreach f $files {
  506.         append text "==============<$f>==============\r"
  507.         set fd [open $f "r"]
  508.         append text "[read $fd]\r\r"
  509.         close $fd
  510.     }
  511.     return $text
  512. }
  513.  
  514. proc catto args {
  515.     set len [llength $args]
  516.     set to [lindex $args [expr $len -1]]
  517.     set args [lrange $args 0 [expr $len -2]]
  518.  
  519.     set files ""
  520.     foreach a $args {
  521.         foreach f [glob $a] {
  522.             lappend files $f
  523.         }
  524.     }
  525.     foreach f $files {
  526.         append text "==============<$f>==============\r"
  527.         set fd [open $f "r"]
  528.         append text "[read $fd]\r\r"
  529.         close $fd
  530.     }
  531.  
  532.     set dfile $to
  533.     if {[file exists $dfile]} {
  534.         set fid [open $dfile "a"]
  535.     } else {
  536.         set fid [open $dfile "w"]
  537.     }
  538.     puts $fid $text
  539.     close $fid
  540. }
  541.  
  542.  
  543. ##############################################################################
  544. #  To be used in the windows created by "matchingLines" or by batch searches.
  545. #
  546. #  With the cursor positioned in a line corrsponding to a match, 
  547. #  go back and select the line in the original file that 
  548. #  generated this match.  (Like emacs 'Occur' functionality)
  549. #
  550. proc gotoMatch {} {
  551.     global tileHeight tileWidth tileTop tileLeft errorHeight errorDisp
  552.     set text [getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]
  553.     set ind1 [string first "░" $text]
  554.     set ind2 [string last "░" $text]
  555.     if {$ind1 == $ind2} {
  556.         set fname [string trim [string range $text $ind1 end] {░}]
  557.         set msg ""
  558.     } else {
  559.         set fname [string trim [string range $text $ind1 $ind2] {░}]
  560.         set msg [string trim [string range $text $ind2 end] {░}]
  561.     }
  562.     
  563.     set top $tileTop
  564.     set geo [getGeometry]
  565.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorHeight) } {
  566.         moveWin $tileLeft $top
  567.         sizeWin $tileWidth $errorHeight
  568.     }
  569.     set mar 22
  570.     incr top [expr $errorHeight + $mar]
  571.     if {[expr {[lsearch [winNames -f] "*$fname"] >= 0}]} {
  572.         if {[string match ":*" $fname]} {
  573.             set fname [file tail $fname]
  574.         }
  575.         bringToFront $fname
  576.         set geo [getGeometry]
  577.         if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  578.             sizeWin $tileWidth $errorDisp
  579.             moveWin $tileLeft $top
  580.         }
  581.     } elseif {[file exists $fname]} {
  582.         edit -g $tileLeft $top $tileWidth $errorDisp $fname
  583.     } else {
  584.         if {![string match "*Link*" [getText 0 [nextLineStart 0]]]} {
  585.             alertnote "File \" $fname \" not found." 
  586.         }
  587.         return
  588.     }
  589.     if {![regexp {Line ([0-9]+):} $text dummy line]} { error "Garbage" }
  590.     set pos [rowColToPos $line 0]
  591.     select $pos [nextLineStart $pos]
  592.     message $msg
  593. }
  594. bind 'c' <Cz>        gotoMatch
  595.  
  596.  
  597. #================================================================================
  598.  
  599. proc prevIntro {} {
  600.     set res [search -s -f 0 -r 0 {== } [getPos]]
  601.     display [lineStart [expr [lineStart [lindex $res 0]] - 1]]
  602. }
  603.  
  604. proc nextIntro {} {
  605.     set res [search -s -f 1 -r 0 {== } [getPos]]
  606.     set res [lindex $res 1]
  607.     set res [search -s -f 1 -r 0 {== } $res]
  608.     display [lineStart [expr [lineStart [lindex $res 0]] - 1]]
  609. }
  610.  
  611. #================================================================================
  612.  
  613. proc searchStart {} {
  614.     global search_start
  615.     select [getPos]
  616.     setMark
  617.     if {[catch {goto $search_start}]} {message "No previous search"}
  618. }
  619.  
  620. #================================================================================
  621.  
  622.  
  623. proc listBindings {} {
  624.     new -n {* Key Bindings *}
  625.     insertText [bindingList]
  626.  
  627.     global infoWindowsDirty
  628.     if {!$infoWindowsDirty} {setWinInfo dirty 0}
  629. }
  630.  
  631.  
  632. proc listFunctions {} {
  633.     global winModes
  634.     new -n {* Functions *}
  635.     insertText "===\r\tCommand-double-click on a function to see its definition\r===\r\r" [join [lsort -ignore [info commands]] "\r"] "\r"
  636.     goto 0
  637.     setWinInfo dirty 0
  638.     changeMode [set winModes([lindex [winNames] 0]) Tcl]
  639. }
  640.  
  641.  
  642. #================================================================================
  643.  
  644. proc printArray {arr} {
  645.     global $arr
  646.         foreach n [array names $arr] {
  647.         append text "$n '[set ${arr}($n)]'\r"
  648.     }
  649.     return [string trim $text "\r"]
  650. }
  651.  
  652. #================================================================================
  653.  
  654.  
  655. proc doATab {} {
  656.     global mode
  657.     global ${mode}modeVars
  658.     if {[info exists ${mode}modeVars] && ![set ${mode}modeVars(electricTab)] || [regexp {[^ \t]} [getText [lineStart [getPos]] [getPos]]]} {
  659.         if {[getPos] != [selEnd]} {
  660.             replaceText [getPos] [selEnd] "\t"
  661.         } else {
  662.             insertText "\t"
  663.         }
  664.     } else {
  665.         indentLine
  666.     }
  667. }
  668.  
  669. #     set ptext [getText [lindex $lst 0] [nextLineStart [lindex $lst 0]]]
  670. #     regsub -all {[^(]} $ptext {} one
  671. #     regsub -all {[^)]} $ptext {} two
  672. #     if {[string length $one] > [string length $two]} {
  673. #         regexp {[^(]*\(} $ptext blah
  674. #         regsub -all {[^    ]} $blah { } lwhite
  675. #     } elseif {($nextC == "\{")} {
  676. #         append lwhite "\t"
  677. #     }
  678.  
  679. proc indentLine {} {
  680.     global mode
  681.     
  682.     set beg [lineStart [getPos]]
  683.  
  684.     set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $beg-1]]
  685.     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  686.     set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  687.  
  688.     if {($nextC == "\{")} {
  689.         append lwhite "\t"
  690.     } elseif {$nextC == ":"} {
  691.         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
  692.     }
  693.         
  694.     set text [getText $beg [nextLineStart $beg]]
  695.     regexp {^[ \t]*} $text white
  696.     set len [string length $white]
  697.     set nextC [lookAt [expr $beg + $len]]
  698.     if {$nextC == "\}"} {
  699.         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  700.     }
  701.     
  702.     global ${mode}modeVars
  703.     if {[string match "*:\r" $text] && [info exists ${mode}modeVars(elecColon)] && [set ${mode}modeVars(elecColon)]} {
  704.         if {[string index $lwhite 0] == "\t"} {
  705.             set lwhite "[string range $lwhite 1 [expr [string length $lwhite] - 1]]  "
  706.         }
  707.     }
  708.  
  709.     if {$white != $lwhite} {
  710.         replaceText $beg [expr $beg + $len] $lwhite
  711.     }
  712.     goto [expr $beg + [string length $lwhite]]
  713. }
  714.  
  715.  
  716. proc indentRegion {} {
  717.     set from [lindex [posToRowCol [getPos]] 0]
  718.     set to [lindex [posToRowCol [selEnd]] 0]
  719.     select [getPos]
  720.     while {$from <= $to} {
  721.         goto [rowColToPos $from 0]
  722.         indentLine
  723.         incr from
  724.     }
  725. }
  726.  
  727. #================================================================================
  728.  
  729. proc sPrompt {msg def} {
  730.     global useStatusBar
  731.     if {!$useStatusBar} {return [prompt $msg $def]}
  732.     if {[catch {statusPrompt "$msg ($def): "} ans]} {
  733.         error "cancel"
  734.     }
  735.     if {![string length $ans]} {return $def}
  736.     return $ans
  737. }
  738.  
  739. #================================================================================
  740. proc quoteChar {} {
  741.     message "Literal keystroke to be inserted:"
  742.     insertText [getChar]
  743. }
  744. #===============================================================================
  745.  
  746. proc saveACopyAs {} {
  747.     if {[file exists [set nm [lindex [winNames -f] 0]]]} {
  748.         set nm2 [putfile "Save a copy as:" [file tail $nm]]
  749.         cp $nm $nm2
  750.     }
  751. }
  752. #===============================================================================
  753. proc removeDups {l} {
  754.     foreach f $l {
  755.         set silly($f) 1
  756.     }
  757.     if {[info exists silly]} {
  758.         return [array names silly]
  759.     }
  760. }
  761.             
  762.  
  763. #===============================================================================
  764.  
  765. proc printHeaderProc {} {
  766.     global printHeader printHeaderTime printHeaderFullPath
  767.     
  768.     if {!$printHeader} return ""
  769.     
  770.     if {$printHeaderFullPath} {
  771.         set text [lindex [winNames -f] 0]
  772.     } else {
  773.         set text [lindex [winNames] 0]
  774.     }
  775.     
  776.     if {$printHeaderTime} {
  777.         append text "      [join [mtime [now] short]]"
  778.     }
  779. }
  780.  
  781. #===============================================================================
  782.  
  783. proc toggleNumLock {} {
  784.     global numLock modifiedVars
  785.     
  786.     set numLock [expr -1 * ($numLock - 1)]
  787.     lappend modifiedVars numLock
  788. }
  789.  
  790. #===============================================================================
  791.  
  792. proc register {} {
  793.     global HOME
  794. #    edit -r "$HOME:Help:Registering"
  795.     launch -f "$HOME:Register 1.1.5 Keleher"
  796. }
  797.  
  798. #===============================================================================
  799. # Useful for -command flag of 'lsort'.
  800. proc sortByTail {one two} {
  801.     string compare [file tail $one] [file tail $two]
  802. }
  803.  
  804.  
  805. #===============================================================================
  806.  
  807. proc cmdDoubleClick {{from -1} {to -1}} {
  808.     global  mode
  809.     
  810.     if {$from < 0} {
  811.         set from [getPos]
  812.         set to [selEnd]
  813.         if {$from == $to} {
  814.             message "No selection"
  815.             return
  816.         }
  817.     }
  818.     
  819.     if {[catch {${mode}DblClick $from $to}]} {
  820.         message "No docs"
  821.     }
  822.     
  823. }
  824.  
  825. #===============================================================================
  826.  
  827.  
  828. proc editMark {fname mname args} {
  829.     if {[set pos [lsearch [winNames -f] "*$fname*"]] >= 0}  {
  830.         bringToFront [lindex [winNames -f] $pos]
  831.     } else {
  832.         if {[lsearch $args {-r}] >= 0} {
  833.             edit -r "$fname"
  834.         } else {
  835.             edit "$fname"
  836.         }
  837.     }
  838.     if {[lsearch [getNamedMarks -n] $mname] < 0} {
  839.         global    mode
  840.         ${mode}MarkFile
  841.     } 
  842.     gotoMark $mname
  843. }
  844.  
  845.  
  846. proc winDirty {} {
  847.     getWinInfo arr
  848.     return $arr(dirty)
  849. }
  850.  
  851.  
  852. #===============================================================================
  853.  
  854. proc lreverse {l} {
  855.     if {[llength $l] > 1} {
  856.         set first [lindex $l 0]
  857.         set l [lreverse [lrange $l 1 end]]
  858.         lappend l $first
  859.     }
  860.     return $l
  861. }
  862.  
  863.     
  864. #===============================================================================
  865.  
  866.  
  867. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */}     }
  868. set {patternLibrary(C++ to C Comments)}            { {//(.*)}            {/* \1 */}     }
  869. set {patternLibrary(Space Runs to Tabs)}        { { +}                {\t}         }
  870.  
  871.  
  872.  
  873. proc getPatternLibrary {} {
  874.     global patternLibrary
  875.     
  876.     foreach nm [array names patternLibrary] {
  877.         lappend nms [concat [list $nm] $patternLibrary($nm)]
  878.     }
  879.     return $nms
  880. }
  881.  
  882. proc rememberPatternHook {search replace} {
  883.     global patternLibrary
  884.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  885.         return ""
  886.     }
  887.     addArrDef patternLibrary $name [list $search $replace]
  888.     set patternLibrary($name) [list $search $replace]
  889.     return $name
  890. }
  891.  
  892. proc deletePatternHook {} {
  893.     global patternLibrary
  894.     
  895.     
  896.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  897.     set name [eval [concat $temp [array names patternLibrary]]]
  898.     removeArrDef patternLibrary $name
  899.     unset patternLibrary($name)
  900. }
  901.  
  902. #===============================================================================
  903. set htmlEventSuiteIDs(MOSS) {WWW!}
  904. proc sendUrl {} {
  905.         global htmlBrowserPath htmlEventSuiteIDs
  906.         if {![info exists htmlBrowserPath]} {
  907.                 if {[catch {addAppPath "HTML Browser" htmlBrowserPath}]} {
  908.                         alertnote "You must choose an HTML browser"
  909.                         return
  910.                 }
  911.         }
  912.         set sig [getFileSig $htmlBrowserPath] 
  913.         
  914.         set name [checkRunning "HTML Browser" $sig htmlBrowserPath]
  915.         if {![string length $name]} {
  916.                 alertnote "Couldn't run HTML browser"
  917.                 return
  918.         }
  919.  
  920.         if {![info exists htmlEventSuiteIDs($sig)]} {
  921.                 alertnote "Can't send URLs to this HTML browser"
  922.                 return
  923.         }
  924.         set suite $htmlEventSuiteIDs($sig)
  925.  
  926.         AEBuild "'${sig}'" $suite {OURL} {----} "╥[getSelect]╙"
  927.         switchTo $name
  928. }
  929.