home *** CD-ROM | disk | FTP | other *** search
/ Internet File Formats / InternetFileFormatsCD.bin / text / latex / mac / alpha.6.0.sit / modes.tcl / modes.tcl
Encoding:
Text File  |  1995-07-16  |  19.8 KB  |  767 lines  |  [TEXT/ALFA]
  1. # New modes can be specified by appending to the following vars.
  2. # are no longer any procs such as 'setTextMode' etc.
  3.  
  4. # 'mode' is nothing when we start up.
  5. set mode ""
  6.  
  7. set whichInfo mode
  8.  
  9. #================================================================================
  10. # The next two procs are called by Alpha to handle the mode flags popup menu.
  11. #================================================================================
  12.  
  13. proc getModeValuesAlpha {} {
  14.     global mode
  15.     global ${mode}modeVars
  16.     global allFlags
  17.     global whichInfo
  18.     set fvals {}
  19.     set vvals {}
  20.  
  21.     if {$whichInfo == "mode"} {
  22.         if {[info exists ${mode}modeVars]} {
  23.             set vars [lsort [array names ${mode}modeVars]]
  24.             foreach v $vars {
  25.                 if {[lsearch $allFlags $v] >= 0} {
  26.                     lappend fvals $v [set ${mode}modeVars($v)]
  27.                 } else {
  28.                     lappend vvals $v 0
  29.                 }
  30.             }
  31.         }
  32.         return [concat $fvals {-} 0 $vvals {{(-} 0 "Set Mode Menus╔" 0 "Change Mode Vars╔" 0 "Describe Mode" 0 {(-} 0 "(Mode Info" 0 "File Info" 0}]
  33.     } else {
  34.         getWinInfo blah
  35.         lappend m "Mac" [expr {$blah(platform) == "mac"}]
  36.         lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  37.         lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  38.         lappend m "MPW" [expr {$blah(state) == "mpw"}]
  39.         lappend m "Think" [expr {$blah(state) == "think"}]
  40.         lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  41.         lappend m "Read Only" $blah(read-only) {(-} 0
  42.         lappend m "Tab Size" 0 {(-} 0
  43.         lappend m "Mode Info" 0 "(File Info" 0
  44.         return $m
  45.     }
  46. }
  47.  
  48.  
  49. proc setModeVarAlpha {var} {
  50.     global mode allFlags modeVars modifiedModeVars
  51.     global whichInfo
  52.     global ${mode}modeVars
  53.     
  54.     if {$whichInfo == "file"} {
  55.         set var [string tolower $var]
  56.         switch $var {
  57.             "unix"        -
  58.             "mac"        -
  59.             "ibm"        { setWinInfo platform $var }
  60.             "mpw"        -
  61.             "think"        -
  62.             "none"        { setWinInfo state $var }
  63.             "mode info"    { set whichInfo mode }
  64.             "tab size"  {
  65.                 getWinInfo arr
  66.                 if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  67.                     setWinInfo tabsize $res
  68.                 }
  69.             }
  70.             "read only"    { 
  71.                 getWinInfo b
  72.                 setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  73.         }
  74.         return
  75.     }
  76.             
  77.     if {$var == "Set Mode Menus╔"} {
  78.         setModeMenus
  79.     } elseif {$var == "File Info"} {
  80.         set whichInfo file
  81.     } elseif {$var == "Mode Info"} {
  82.         set whichInfo mode
  83.     } elseif {$var == "Change Mode Vars╔"} {
  84.         set mvars {}
  85.         catch {set mvars [array names ${mode}modeVars]}
  86.         set vars [listpick -l -L $mvars -p "Set mode vars for '$mode':" [lsort $modeVars]]
  87.         if {![string length $vars]} return
  88.         
  89.         catch {unset ${mode}modeVars}
  90.         foreach v $vars {
  91.             global $v
  92.             set ${mode}modeVars($v) [set $v]
  93.         }
  94.     } elseif {$var == "Describe Mode"} {
  95.         describeMode
  96.     } elseif {[lsearch $allFlags $var] >= 0} {
  97.         global $var
  98.         set ${mode}modeVars($var) [set $var [expr -1 * ([set ${mode}modeVars($var)] - 1)]]
  99.         lappend modifiedModeVars [list $var ${mode}modeVars]
  100.     } else {
  101.         global $var
  102.         set res [prompt "New value of '$var':" [set ${mode}modeVars($var)]]
  103.         set ${mode}modeVars($var) $res
  104.         set $var $res
  105.         lappend modifiedModeVars [list $var ${mode}modeVars]
  106.     }
  107. }
  108.  
  109. #================================================================================
  110.  
  111.  
  112. # Suffixes used to initially determine mode for new window.
  113. set modeSuffixes { default { set winMode Text } }
  114.  
  115.  
  116. # The set of menus that the modes may choose to use.
  117. set allModeMenus {     thinkMenu cwarriorMenu toolserverMenu
  118.                     latexMenu thinkRefMenu toolboxRefMenu tclMenu perlMenu }
  119.  
  120. set modeVars { }
  121.  
  122.  
  123. # The dummy proc for a mode is called whenever we change to that mode,
  124. # so that the autoloading facility will load the correct file, if
  125. # necessary.
  126.  
  127. # The list of modes.
  128. set modes         {}
  129. set lastMode     0
  130.  
  131. # Can be used to add new mode-specific flags and variables (see think.tcl for example).
  132. proc newModeVar {mode var val isFlag} {
  133.     global ${mode}modeVars modeVars allFlags $var
  134.     
  135.     if {![info exists modeVars] || [lsearch $modeVars $var] < 0} {
  136.         lappend modeVars $var
  137.     }
  138.     if {![info exists ${mode}modeVars($var)]} {
  139.         set ${mode}modeVars($var) $val
  140.         if {![info exists $var]} {
  141.             set $var $val
  142.         }
  143.     }
  144.     if {$isFlag && (![info exists allFlags] || ([lsearch $allFlags $var] < 0))} {
  145.         lappend allFlags $var
  146.     }
  147. }
  148.  
  149. #================================================================================
  150. lappend modes C
  151. set dummyProc(C)                dummyC
  152. lappend modeSuffixes             {*.h} { set winMode C }
  153. lappend modeSuffixes            {*.c} { set winMode C }
  154. lappend modeSuffixes            {*.r} { set winMode C }
  155. set modeMenus(C)                 { thinkMenu cwarriorMenu thinkRefMenu toolboxRefMenu}
  156.  
  157. #================================================================================
  158. lappend modes C++
  159. set dummyProc(C++)                dummyC++
  160. lappend modeSuffixes             {*.H} { set winMode C++ }
  161. lappend modeSuffixes            {*.cc} { set winMode C++ }
  162. lappend modeSuffixes            {*.cp} { set winMode C++ }
  163. lappend modeSuffixes            {*.cpp} { set winMode C++ }
  164. lappend modeSuffixes            {*.CPP} { set winMode C++ }
  165. lappend modeSuffixes            {*.C} { set winMode C++ }
  166. set modeMenus(C++)                 { thinkMenu cwarriorMenu thinkRefMenu toolboxRefMenu}
  167.  
  168. #===============================================================================
  169.  
  170. #############################################################################
  171. # PL/SQL mode by Joel D. Elkins
  172. #############################################################################
  173. lappend modes SQL
  174. set modeMenus(SQL)                        { }
  175. set dummyProc(SQL)                        dummySQL
  176. lappend modeSuffixes                    {*.sql} { set winMode SQL }
  177. lappend modeSuffixes                    {*.SQL} { set winMode SQL }
  178. lappend modeSuffixes                    {*.pkg}    { set winMode SQL }
  179.  
  180. #================================================================================
  181. lappend modes Shel
  182. set dummyProc(Shel)                dummyShel
  183. set modeMenus(Shel)             { tclMenu }
  184. lappend modeSuffixes            {*tcl\ sh*} {set winMode Shel}
  185. newModeVar Shel wordBreak {(\$)?[a-zA-Z0-9_.]+} 0
  186. newModeVar Shel wordWrap {0} 1
  187. newModeVar Shel wordBreakPreface {[^a-zA-Z0-9_\$]} 0
  188. newModeVar Shel autoMark    0    1
  189. regModeKeywords -m {╟} Shel {}
  190.  
  191. #===============================================================================
  192. #    AppleScript mode
  193. lappend modes Scrp
  194. set dummyProc(Scrp)                dummyScrp
  195. lappend modeSuffixes             {*.script} { set winMode Scrp }
  196. set modeMenus(Scrp)             { }
  197.  
  198. #================================================================================
  199. lappend modes Text
  200. set modeMenus(Text)                { }
  201. newModeVar Text leftFillColumn {0} 0
  202. newModeVar Text suffixString { <--} 0
  203. newModeVar Text prefixString {> } 0
  204. newModeVar Text fillColumn {75} 0
  205. newModeVar Text wordWrap {1} 1
  206. newModeVar Text wordBreak {[a-zA-Z0-9_]+} 0
  207. newModeVar Text wordBreakPreface {([^a-zA-Z0-9_])} 0
  208. newModeVar Text wrapBreak {[a-zA-Z0-9_]+} 0
  209. newModeVar Text wrapBreakPreface {([^a-zA-Z0-9_])} 0
  210. newModeVar Text autoMark    0    1
  211.  
  212. #================================================================================
  213. lappend modes PS
  214. lappend modeSuffixes            {*.ps} { set winMode PS }
  215. newModeVar PS prefixString {% } 0 
  216. set PSKeyWords {
  217.     def begin end dict load
  218.     exec if ifelse for repeat loop exit stop stopped countexecstack execstack quit start
  219.     gsave grestore grestoreall initgraphics 
  220.     newpath erasepage fill eofill stroke image imagemask showpage copypage
  221. }
  222. if {[info exists PSwords]} {set PSKeyWords [concat $PSKeyWords $PSwords]}
  223. regModeKeywords -e {%} -m {/}  -c red -k blue PS $PSKeyWords -i "\}" -i "\{" -i {[} -i {]} -I green
  224. unset PSKeyWords
  225.  
  226. #================================================================================
  227. lappend modes Fort
  228. lappend modeSuffixes            {*.f} { set winMode Fort }
  229. lappend modeSuffixes            {*.inc} { set winMode Fort }
  230. lappend modeSuffixes            {*.INC} { set winMode Fort }
  231. lappend modeSuffixes            {*.fcm} { set winMode Fort }
  232. lappend modeSuffixes            {*.for} { set winMode Fort }
  233. lappend modeSuffixes            {*.FOR} { set winMode Fort }
  234. set dummyProc(Fort)                dummyFort
  235. set modeMenus(Fort)             { }
  236.  
  237. #================================================================================
  238. lappend modes Pasc
  239. lappend modeSuffixes             {*.p} { set winMode Pasc }
  240. set dummyProc(Pasc)                dummyPascal
  241. set modeMenus(Pasc)                { thinkRefMenu toolboxRefMenu}
  242.  
  243. #=============================================================================
  244. lappend modes Tcl
  245. set dummyProc(Tcl)                dummyTcl
  246. lappend modeSuffixes            {*.tcl} { set winMode Tcl }
  247. set modeMenus(Tcl)                 { tclMenu }
  248.  
  249. #================================================================================
  250. lappend modes MPW
  251. set modeMenus(MPW)                 { }
  252. lappend modeSuffixes            {*Toolserver\ *} { set winMode MPW }
  253.  
  254. #================================================================================
  255. lappend modes Brws
  256. set modeMenus(Brws)             { }
  257. set dummyProc(Brws)                dummyBrws
  258. #================================================================================
  259. lappend modes Diff
  260. set modeMenus(Diff)             { }
  261. #================================================================================
  262. # Ada mode definition !
  263. #================================================================================
  264. lappend modes Ada
  265. set dummyProc(Ada)                DUMMY_ADA
  266. set modeMenus(Ada)                 { }
  267. lappend modeSuffixes             {*.ada} { set winMode Ada }
  268. lappend modeSuffixes            {*.ads} { set winMode Ada }
  269. lappend modeSuffixes            {*.adb} { set winMode Ada }
  270. # only for my GNAT specific files
  271. lappend modeSuffixes            {*.gnat} { set winMode Ada }
  272. newModeVar Ada elecRBrace {1} 1
  273. newModeVar Ada leftFillColumn {3} 0
  274. newModeVar Ada prefixString {-- } 0 
  275. newModeVar Ada electricSemi {1} 1
  276. newModeVar Ada wordBreak {[a-zA-Z0-9_]+} 0
  277. newModeVar Ada elecLBrace {1} 1
  278. newModeVar Ada wordWrap {0} 1
  279. newModeVar Ada funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  280. newModeVar Ada wordBreakPreface {} 0
  281. newModeVar Ada optionIsMeta {1} 1
  282. newModeVar Ada electricTab {0} 1
  283.  
  284. set adaCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  285. set adaPreRegexp        {^\#[\t ]*[a-z]*}
  286. set adaKeyWords        {
  287.     abort abs accept access all and array at begin body case constant
  288.     declare delay delta digits do else elsif end entry exception exit
  289.     for function generic goto others if in is limited loop mod new not
  290.     null of or subtype out package pragma private procedure raise range
  291.     record rem renames return reverse select separate task terminate
  292.     then type use when while with xor = /=  := > <
  293.     }
  294. regModeKeywords -e {--} -c cyan -k blue Ada $adaKeyWords -i ")" -i "(" -i ":" -i ";" -i "," -i "." -I red
  295. #================================================================================
  296.  
  297. proc buildFlagsVars {} {
  298.     global allFlags allVars modeVars
  299.     
  300.     set fs {}
  301.     foreach f [lsort $allFlags] {
  302.         if {[lsearch $modeVars $f] < 0} {
  303. #             lappend fs "<E<S? $f"
  304. #             lappend fs "<S$f"
  305.               lappend flags $f
  306.         }
  307.     }
  308.     menu -m -n flags -p editFlag $flags
  309.     eval global $flags
  310.     foreach f $flags {
  311.         markMenuItem flags $f [set $f]
  312.     }
  313.  
  314.     set fs {}
  315.     set flags {}
  316.     foreach f [lsort $allVars] {
  317.         if {[lsearch $modeVars $f] < 0} {
  318. #             lappend fs "<E<S? $f"
  319. #             lappend fs "<S$f"
  320.             lappend fs "$f"
  321.         }
  322.     }
  323.     menu -m -n vars -p editVar $fs
  324. }
  325.  
  326.  
  327. proc saveVarValues {} {
  328.     global modes HOME
  329.     if {[askyesno "Save variables and values to \"$HOME:alphaFlags.tcl\"?"] == "yes"} {
  330.         set lines {}
  331.         foreach m $modes {
  332.             global ${m}modeVars
  333.             
  334.             if {[info exists ${m}modeVars]} {
  335.                 foreach v [array names ${m}modeVars] {
  336.                     append lines "set ${m}modeVars($v)\t\t\{[set ${m}modeVars($v)]\}\r"
  337.                 }
  338.                 append lines "\r"
  339.             }
  340.         }
  341.         
  342.         append lines "\r\r"
  343.         global allFlags allVars
  344.         set vars [lsort [concat $allFlags $allVars]]
  345.         eval global $vars
  346.         foreach f $vars {
  347.             append lines "set $f\t\t\{[set $f]\}\r"
  348.         }
  349.  
  350.         set fd [open "$HOME:alphaFlags.tcl" "w"]
  351.         puts $fd $lines
  352.         close $fd
  353.         message "New '$HOME:alphaFlags.tcl' written."
  354.     }
  355. }
  356.  
  357.  
  358. #================================================================================
  359.  
  360. proc setWinMode name {
  361.     global winModes modeSuffixes
  362.     set nm [file tail $name]
  363.     if {[set first [string last " <" $nm]] >= 0} {
  364.         set rname [string range $nm 0 [expr $first - 1]]
  365.     } else {
  366.         set rname $nm
  367.     }
  368.     case $rname in $modeSuffixes
  369.     set winModes($name) $winMode
  370. }
  371.  
  372.  
  373.  
  374. proc newMode mode {
  375.     global winModes modeProcs
  376.     
  377.     set name [lindex [winNames -f] 0]
  378.     changeMode $mode
  379.     set winModes($name) $mode
  380. }
  381.  
  382.  
  383. proc deactivateHook name {
  384. }
  385.  
  386. proc suspendHook name {
  387.     global iconifyOnSwitch
  388.     global suspIconed
  389.     if {$iconifyOnSwitch} {
  390.         set wins [winNames -f]
  391.         set suspIconed ""
  392.         foreach win $wins {
  393.             if {![icon -f "$win" -q]} {
  394.                 lappend suspIconed $win
  395.                 icon -f "$win" -t
  396.             }
  397.         }
  398.         set suspIconed [lreverse $suspIconed]
  399.     }
  400. }
  401.  
  402.  
  403. set killCompilerErrors 0
  404.  
  405. proc resumeHook name {
  406.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  407.  
  408.     if {$killCompilerErrors} {
  409.         set wins [winNames -f]
  410.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  411.             bringToFront [lindex $wins $res]
  412.             killWindow
  413.         }
  414.     }
  415.     
  416.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  417.         set wins [winNames -f]
  418.         foreach win $suspIconed {
  419.             icon -f "$win" -o
  420.         }
  421.         unset suspIconed
  422.     }
  423.     if {$resumeRevert} {
  424.         set resumeRevert 0
  425.         revert
  426.     }
  427. }
  428.  
  429.  
  430.  
  431. # Handles dynamically adding and deleting window names from menu.
  432. proc addWinName name {
  433.     global winNameToNum winMenu winNumToName
  434.     
  435.     for {set i 0} {$i<100} {incr i} {
  436.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  437.             regexp {[^:]*$} $name nm
  438.             if {$i < 10} {
  439.                 addMenuItem -m -l "/$i" $winMenu $nm
  440.             } else {
  441.                 addMenuItem -m -l "" $winMenu $nm
  442.             }
  443.             set winNumToName($i) $name
  444.             set winNameToNum($name) $i
  445.             return
  446.         }
  447.     }
  448. }
  449.  
  450. proc removeWinName name {
  451.     global winNameToNum winNumToName winMenu
  452.     
  453.     set num $winNameToNum($name)
  454.     unset winNumToName($num)
  455.     unset winNameToNum($name)
  456.     regexp {[^:]*$} $name nm
  457.     deleteMenuItem -m $winMenu $nm
  458. }
  459.  
  460.  
  461. proc menuWin {menu name} {
  462.     global winNameToNum
  463.  
  464.     set nms [array names winNameToNum]
  465.  
  466.     if {[lsearch $nms "*$name"] < 0} {
  467.         $name
  468.         return
  469.     }
  470.  
  471.     foreach nm $nms {
  472.         if {[string match *$name $nm] == "1"}  {
  473.             bringToFront $name
  474.             if [icon -q] { icon -f $name -o }
  475.             return
  476.         }
  477.     }
  478.     return "normal"
  479. }
  480.  
  481.  
  482. # Do not move 'displayMode' calls!
  483. proc changeMode {newMode} {
  484.     global lastMode modeMenus dummyProc mode
  485.     
  486.     set lastMode $mode
  487.     set mode $newMode
  488.     if {$lastMode == $mode} {
  489.         catch {displayMode $newMode}
  490.         return
  491.     }
  492.  
  493.     # Used to be after the modeVar stuff. Why?
  494.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  495.  
  496.     global ${mode}modeVars
  497.     if {[info exists ${mode}modeVars]} {
  498.         foreach v [array names ${mode}modeVars] {
  499.             global $v
  500.             set $v [set ${mode}modeVars($v)]
  501.         }
  502.     }
  503.  
  504.     if {[info exists modeMenus($lastMode)]} {
  505.         foreach m $modeMenus($lastMode) {
  506.             global $m
  507.             catch {removeMenu [set $m]}
  508.         }
  509.     }
  510.     if {[info exists modeMenus($mode)]} {
  511.         foreach m $modeMenus($mode) {
  512.             catch {$m}
  513.             global $m
  514.             catch {insertMenu [set $m]}
  515.         }
  516.     }
  517.     catch {displayMode $newMode}
  518. }
  519.  
  520.  
  521. proc setModeMenus {} {
  522.     global mode modeMenus allModeMenus modifiedModeMenus
  523.  
  524.     set menus [listpick -p "Pick menus for mode '$mode':" -l -L $modeMenus($mode) [lsort $allModeMenus]]
  525.     set modeMenus($mode) $menus
  526.  
  527.     lappend modifiedModeMenus $mode
  528.  
  529.     foreach m $allModeMenus {
  530.         global $m
  531.         catch {removeMenu [set $m]}
  532.     }
  533.     foreach m $menus {
  534.         global $m
  535.         catch {$m}
  536.         catch {insertMenu [set $m]}
  537.     }
  538. }
  539.  
  540.  
  541. #=============================================================================
  542. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  543. #                          "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  544. #=============================================================================
  545.  
  546. if {![info exists winActive]} {set winActive ""}
  547.  
  548. # Event hooks - set specific modes when files opened.
  549.  
  550.  
  551. proc openHook name {
  552.     global winModes winActive autoMark mode screenHeight screenWidth forceMainScreen recentFiles recentFilesCount
  553.     changeMode $winModes($name)
  554.     if {$name == {*Toolserver shell*}} startMPW
  555.     addWinName $name
  556.     message ""
  557.  
  558.     if {![catch {getFileInfo $name info}]} {
  559.         if {$info(creator) == {ttxt}} {
  560.             setWinInfo dirty 0
  561.         }
  562.         if {$info(type) == {ttro}} {
  563.             catch {setWinInfo read-only 1}
  564.             message "Read-only!"
  565.         }
  566.     }
  567.  
  568.     global ${mode}modeVars
  569.     
  570.     if {$forceMainScreen} {
  571.         set geo [getGeometry]
  572.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  573.         if {($l < 0) || ($t < 35) || ([expr $l + $w] > $screenWidth) || ([expr $t + $h + 18] > $screenHeight)} {
  574.             singlePage
  575.         }
  576.     }
  577.     getWinInfo arr
  578.     if {[info exists ${mode}modeVars(autoMark)] && [set ${mode}modeVars(autoMark)] && !$arr(read-only) && ![llength [getNamedMarks -n]]} {
  579.         markFile
  580.     }
  581.     
  582.     if {[string match "*Preferences*defs.tcl" $name]} {setWinInfo read-only 1}
  583.     
  584.     pushRecent $name 
  585. }
  586.  
  587.  
  588. # full pathname
  589. proc saveHook name {
  590.     global backup backExtension backDir mode
  591.     
  592.     if {($mode == "C") || ($mode == "C++")} {catch {modified}}
  593.  
  594.     if ($backup) {
  595.         if {![string length [set dir $backDir]]} {
  596.             set dir [file dirname $name]
  597.         }
  598.         if {![file exists $dir]} {
  599.             if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
  600.                 mkdir $dir
  601.             }
  602.         }
  603.         catch {rm $dir:[file tail $name]$backExtension}
  604.         catch {cp $name $dir:[file tail $name]$backExtension}
  605.     }
  606. }
  607.  
  608. # Clean up the mark stack.
  609. proc closeHook name {
  610.     global markStack winModes winActive
  611.  
  612.     unset winModes($name)
  613.     if [llength $markStack] {
  614.         set markStack [removePat $markStack $name*]
  615.     }
  616.     removeWinName $name
  617.  
  618.     if {[set ind [lsearch $winActive $name]] >= 0} {
  619.         set winActive [lreplace $winActive $ind $ind]
  620.     }
  621.  
  622.     catch {unset winModes($name)}
  623. }
  624.  
  625.  
  626. proc saveasHook {oldName newName} {
  627.     global winModes winActive
  628.     removeWinName $oldName
  629.     addWinName $newName
  630.     setWinMode $newName
  631.     changeMode $winModes($newName)
  632.     
  633.     pushRecent $newName
  634.     
  635.     if {[set ind [lsearch $winActive $oldName]] >= 0} {
  636.         set winActive [lreplace $winActive $ind $ind]
  637.     }
  638.     set winActive [linsert $winActive 0 $newName]
  639.     catch {unset winModes($oldName)}
  640. }
  641.  
  642. if {![info exists actives]} {set actives 0}
  643.  
  644. # and, install a new 'winActive' patch , to 'activateHook':
  645.  
  646. proc activateHook name {
  647.     global winModes winActive
  648.     if {![info exists winModes($name)]} {
  649.         setWinMode $name
  650.     }
  651.     changeMode $winModes($name)
  652.  
  653.     if {[set ind [lsearch $winActive $name]] == -1} {
  654.         set winActive [linsert $winActive 0 $name]
  655.         return
  656.     }
  657.     if {$ind >= 1} {
  658.         set winActive [lreplace $winActive $ind $ind]
  659.         set winActive [linsert $winActive 0 $name]
  660.     }
  661.  
  662. }
  663.  
  664.  
  665. proc dirtyHook {name dirty} {
  666.     global winMenu
  667.     markMenuItem $winMenu [file tail $name] $dirty "╫"
  668. }
  669.  
  670.  
  671. set modifiedVars        {}
  672. set modifiedModeVars    {}
  673. set modifiedModeMenus    {}
  674.  
  675.  
  676. proc quitHook {} {
  677.     saveModifiedVars
  678. }
  679.  
  680.  
  681. proc saveModifiedVars {} {
  682.     global modifiedVars modifiedModeVars modifiedModeMenus modeMenus prefDefs recentFilesSave recentFiles
  683.  
  684.     if {[llength $modifiedVars] || [llength $modifiedModeVars] || [llength $modifiedModeMenus]} {
  685.         foreach f [removeDups $modifiedModeMenus] {
  686.             addArrDef modeMenus $f $modeMenus($f)
  687.         }
  688.         foreach f [removeDups $modifiedVars] {
  689.             global $f
  690.             addDef $f [set $f]
  691.         }
  692.         foreach f [removeDups $modifiedModeVars] {
  693.             set nm [lindex $f 0]
  694.             set mode [lindex $f 1]
  695.             global $mode
  696.             addArrDef [set mode] $nm [set [set mode]($nm)]
  697.         }
  698.     }
  699.     
  700.     if {[info exists recentFiles]} {
  701.         addDef recentFilesSave $recentFiles
  702.     }
  703. }
  704.  
  705. #================================================================================
  706.  
  707. proc describeMode {} {
  708.     global mode modeSuffixes modeMenus modes
  709.     global ${mode}modeVars
  710.     
  711.     set text "\r\tMODE $mode\r\r"
  712.     set suffs ""
  713.     set first 1
  714.     foreach suf $modeSuffixes {
  715.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") && ([lindex $suf 2] == $mode)} {
  716.             if {$first} {
  717.                 lappend suffs $last
  718.                 set first 0
  719.             } else {
  720.                 append suffs ", $last"
  721.             }
  722.         }
  723.         set last $suf
  724.     }
  725.     append text "Mode suffixes: $suffs\r\r"
  726.     
  727.     set first 1
  728.     append text "Mode menus: "
  729.     if {[info exists modeMenus($mode)]} {
  730.         foreach m $modeMenus($mode) {
  731.             if $first {
  732.                 set first 0
  733.                 lappend text $m
  734.             } else {
  735.                 append text ", $m"
  736.             }
  737.         }
  738.     }
  739.     append text "\r\r"
  740.  
  741.     append text "Mode-specific variables:\r"
  742.     if {[info exists ${mode}modeVars]} {
  743.         foreach v [lsort [array names ${mode}modeVars]] {
  744.             append text [format "\t%-20s: \"%s\"\r" $v [set ${mode}modeVars($v)]]
  745.         }
  746.     }
  747.  
  748.  
  749.     set etext "\rMode-independent bindings:\r"
  750.     append text "\rMode-specific bindings:\r"
  751.     foreach b [split [bindingList] "\r"] {
  752.         set lst [lindex $b end]
  753.         if {$lst == $mode} {
  754.             append text "\t$b\r"
  755.         } elseif {[lsearch $modes $lst] < 0} {
  756.             append etext "\t$b\r"
  757.         }
  758.     }
  759.     new -n "* <$mode> MODE *"
  760.     insertText $text$etext
  761.     goto 0
  762.     
  763.     setWinInfo dirty 0
  764. }
  765.  
  766.  
  767.