home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / modes.tcl < prev    next >
Encoding:
Text File  |  1997-12-19  |  18.0 KB  |  664 lines  |  [TEXT/ALFA]
  1. # (nowrap)
  2.  
  3. namespace eval mode {}
  4. namespace eval win {}
  5. namespace eval file {}
  6.  
  7. # ◊◊◊◊ Declare Alpha packages ◊◊◊◊ #
  8. proc alpha::extension {name version {script ""} args} {
  9.     global alpha::rebuilding
  10.     if {!${alpha::rebuilding}} {return}
  11.     global index::extension rebuild_cmd_count
  12.     set index::extension($name) [list $version $script]
  13.  
  14.     if {[llength $args]} {
  15.         eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  16.         return
  17.     }
  18.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  19.         return -code 11
  20.     }
  21. }
  22.  
  23. proc alpha::mode {name version dummyProc {ext ""} {menus ""} {script ""} args} {
  24.     global alpha::rebuilding
  25.     if {!${alpha::rebuilding}} {return}
  26.     namespace eval ::$name {}
  27.     global index::mode rebuild_cmd_count
  28.     set index::mode($name) [list $version $dummyProc $ext $menus $script]
  29.     if [llength $args] {
  30.         eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  31.         return
  32.     }
  33.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  34.         return -code 11
  35.     }        
  36. }
  37.  
  38. proc alpha::menu {name version value {menu 0} {script ""} args} {
  39.     global alpha::rebuilding
  40.     if {!${alpha::rebuilding}} {return}
  41.     global index::menu rebuild_cmd_count
  42.     if {$menu == "in_menu"} { set in_menu 1 } else {set in_menu 0}
  43.     set index::menu($name) [list $version $value $in_menu $script]
  44.     if [llength $args] {
  45.         eval alpha::package [lindex $args 0] $name $version [lrange $args 1 end]
  46.         return
  47.     }
  48.     if {[info exists rebuild_cmd_count] && [incr rebuild_cmd_count -1] == 0} {
  49.         return -code 11
  50.     }        
  51. }
  52.  
  53. ## 
  54.  # -------------------------------------------------------------------------
  55.  # 
  56.  # "addMode" -- you probably won't call this proc yourself
  57.  # 
  58.  # -------------------------------------------------------------------------
  59.  ##
  60. proc addMode {m dummy suffs menus} {
  61.     global modeMenus filepats dummyProc
  62.     namespace eval ::$m {}
  63.     if {[string length $dummy]} {set dummyProc($m) $dummy}
  64.     ensureset modeMenus($m) $menus
  65.     ensureset filepats($m) $suffs
  66. }
  67.  
  68. proc addMenu {name {val ""}} {
  69.     global menus
  70.     lunion menus $name
  71.     if {$val != ""} {
  72.         global $name
  73.         if {![info exists $name]} { set $name $val }
  74.     }
  75. }
  76.  
  77.  
  78. # ◊◊◊◊ Procs Alpha calls directly ◊◊◊◊ #
  79. proc getModeValuesAlpha {} {
  80.     global showInvisibles
  81.     
  82.     getWinInfo blah
  83.     lappend m "Mac" [expr {$blah(platform) == "mac"}]
  84.     lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  85.     lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  86.     lappend m "MPW" [expr {$blah(state) == "mpw"}]
  87.     lappend m "Think" [expr {$blah(state) == "think"}]
  88.     lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  89.     lappend m "Read Only" $blah(read-only)
  90.     lappend m "Show Invisibles" $showInvisibles {(-} 0
  91.     lappend m "Tab Size" 0
  92.     return $m
  93. }
  94.  
  95.  
  96. proc setModeVarAlpha {var} {
  97.     global mode allFlags modeVars
  98.     global ${mode}modeVars
  99.     
  100.     set var [string tolower $var]
  101.     switch -- $var {
  102.         "unix"      -
  103.         "mac"       -
  104.         "ibm"       { setWinInfo platform $var ; setWinInfo dirty 1 }
  105.         "mpw"       -
  106.         "think"     -
  107.         "none"      { setWinInfo state $var }
  108.         "tab size"  {
  109.             getWinInfo arr
  110.             if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  111.                 setWinInfo tabsize $res
  112.             }
  113.         }
  114.         "read only" { 
  115.             getWinInfo b
  116.             setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  117.         "show invisibles" { 
  118.             global showInvisibles
  119.             set showInvisibles [expr 1 - $showInvisibles]
  120.         }
  121.     }
  122.     return
  123. }
  124.  
  125. # Called from alpha in response to the mode popup.
  126. proc newMode mode {
  127.     if [package::helpOrDescribe $mode] { return }
  128.     global win::Modes modeProcs
  129.     changeMode $mode
  130.     if {[catch {car [winNames -f]} name]} return
  131.     set win::Modes($name) $mode
  132.     refresh
  133. }
  134.  
  135. # ◊◊◊◊ Mode specific items ◊◊◊◊ #
  136.  
  137. proc mode::menuProc {menu item} {
  138.     if {![llength [winNames]]} {
  139.         alertnote "No window!"
  140.         return
  141.     }
  142.     switch -- $item {
  143.         "preferences"       dialog::modifyModeFlags
  144.         "menus"             mode::setMenus
  145.         "editPrefsFile"     mode::editPrefsFile
  146.         "loadPrefsFile"     mode::sourcePrefsFile
  147.         "describeMode"      mode::describe
  148.         "change"            mode::changeDialog
  149.         default {
  150.             mode::$item
  151.         }        
  152.     }
  153. }
  154.  
  155. ## 
  156.  # -------------------------------------------------------------------------
  157.  #     
  158.  # "win::setMode"    --
  159.  #    
  160.  #    Copes with endings like    '.orig'
  161.  #    or the backup ending '~' or ' copy', and checks a smart-mode line
  162.  #    like emacs, and handles a few Alpha-specific windows (trace dumps).
  163.  #
  164.  # -------------------------------------------------------------------------
  165.  ##
  166. proc win::setMode name {
  167.     global win::Modes
  168.     set win::Modes($name) [file::whichModeForWin $name]
  169. }
  170.  
  171. ## 
  172.  # -------------------------------------------------------------------------
  173.  #     
  174.  #    "file::getModeForFile" --
  175.  #    
  176.  #     This is an    adaptation of Tom Pollard's    emacs mode setting facility.
  177.  #     I call    it from    activateHook, which    means it takes effect before
  178.  #     the window    yet    exists,    so you don't get a double redraw.
  179.  #     Here are Tom's    comments from the original:
  180.  #       
  181.  #       # Emacs-style mode selection    using first    nonblank line of file
  182.  #       #
  183.  #       # Checks    for    interpreter    line "#!/dir/subdir/command    ...", or
  184.  #       # explicit major    mode election "-*-Mode:    vars ...-*-".
  185.  #       #
  186.  #       # "command" or "Mode" is    compared (case-insensitively) to Alpha mode
  187.  #       # names and first matching mode is used for the file.
  188.  #       #
  189.  #       # Author:   Tom Pollard    <pollard@chem.columbia.edu>
  190.  #       # Modified: 9/11/95
  191.  #    
  192.  #    Note: this proc actually opens the file for reading.  It _must_ close
  193.  #    the file before exiting.  If you modify this proc, make sure that
  194.  #    happens!
  195.  #    
  196.  #  To Do: I currently use 'file exists' to catch activation of non-file 
  197.  #           windows such as '*tcl shell*'. There may be a better way.
  198.  #
  199.  # --Version--Author------------------Changes-------------------------------  
  200.  #      1.0      <darley@fas.harvard.edu> first modification from Tom Pollard's
  201.  #    1.1     <darley@fas.harvard.edu> copes with a common Tcl/Tk exec trick.
  202.  #    1.2     <darley@fas.harvard.edu> can map creators if desired.
  203.  # -------------------------------------------------------------------------
  204.  ##
  205. proc file::getModeForFile {name} {
  206.     # if it doesn't exist as a file it's probably a funny window, so return
  207.     if ![file exists "$name"] { 
  208.         if {[string first "* Trace" $name] == "0" } {
  209.             zoom
  210.             toggleScrollbar
  211.             return Tcl
  212.         }
  213.         return
  214.     }
  215.     global modeCreator
  216.     if {[info exists modeCreator([set sig [getFileSig $name]])]} {
  217.         return $modeCreator($sig)
  218.     }
  219.     if [catch { set fid [open "$name" r] } ] { return }
  220.     # find first non-empty line. Return if we fail
  221.     for { set line "" } { [string trim $line] == "" } {} {
  222.         if { [gets $fid line] == -1} { close $fid ; return }
  223.     }
  224.     if {[regexp -nocase {^[^\n\r]+install} $line]} {
  225.         global HOME
  226.         if ![string match "${HOME}:Tcl:*" $name] {
  227.             close $fid
  228.             return "Inst"
  229.         }
  230.     }
  231.     if {[regexp {^#![     ]*([^     \n\r]+)} $line dmy mtch] } {
  232.         if [regexp {([^/]+)$} $mtch majorMode] { 
  233.             # remove trailing version number
  234.             set majorMode [string trimright $majorMode "01234567890."]
  235.             if {$majorMode == "sh"} {
  236.                 # need to check if we're using a common unix trick
  237.                 if {[gets $fid ll] != -1} {
  238.                     while {[string index [string trimleft $ll] 0] == "#"} {
  239.                         if {[gets $fid ll] == -1} { close $fid ; return }
  240.                     } 
  241.                 } else {
  242.                     if [regexp {[\n\r][ \t]*[^#][^\r\n]*[\r\n]} $line ll] {
  243.                         set ll [string trimleft $ll]
  244.                     } else {
  245.                         set ll ""
  246.                     }
  247.                 }
  248.                 if [regexp {^exec +([^ ]+) } $ll dummy ll] {
  249.                     regexp {([^/]+)$} [string trimright $ll "01234567890."] majorMode
  250.                 }
  251.             }        
  252.         } else {
  253.             close $fid
  254.             return 
  255.         }
  256.     } elseif {[regexp {\-\*\- *([^     :;]+).*\-\*\-} $line mtch majorMode]} {
  257.         # do nothing
  258.     } else {
  259.         close $fid
  260.         return
  261.     }
  262.     close $fid
  263.  
  264.     global unixMode
  265.     set majorMode [string tolower $majorMode]
  266.     if [info exists unixMode($majorMode)] {
  267.         return $unixMode($majorMode)
  268.     } else {
  269.         global modeMenus
  270.         set m [array names modeMenus]
  271.         if {[set i [lsearch [string tolower $m] $majorMode]] != -1} {
  272.             return [lindex $m $i]
  273.         }
  274.     }
  275.     return 
  276. }
  277.  
  278. # These are mappings required by the above proc.  If you need to extend this 
  279. # list to include a mode you are writting, place a statement like the following 
  280. # in your alpha::mode body
  281. set unixMode(matlab) {MATL}
  282.  
  283. ## 
  284.  # -------------------------------------------------------------------------
  285.  # 
  286.  # "file::whichModeForWin" --
  287.  # 
  288.  #  Copes with trailing '<2>', .orig, copy, '~',...
  289.  # -------------------------------------------------------------------------
  290.  ##
  291. proc file::whichModeForWin {name} {
  292.     regexp {(.*) <[0-9]+>$} $name dmy name
  293.     if {[set m [file::getModeForFile $name]] != ""} { return $m }
  294.     global ModeSuffixes
  295.     set nm [file tail $name]
  296.     
  297.     regexp {(.*) copy$} $nm dmy nm
  298.     regexp {(.*)~[0-9]*$} $nm dmy nm
  299.     if {[file extension $nm] == ".orig"} {
  300.           set nm [file root $nm]
  301.     }     
  302.     case $nm in $ModeSuffixes
  303.     return $winMode
  304. }
  305.  
  306.  
  307. ## 
  308.  # -------------------------------------------------------------------------
  309.  # 
  310.  # "win::addToMenu" --
  311.  # 
  312.  #  Adds a window name to the window menu.  This new version adds a 
  313.  #  binding, to work-around a bug in Alpha, so that using cmd-0-9
  314.  #  works if the window name contains square brackets.  The problem
  315.  #  is that the 'addMenuItem' line creates a binding of the form
  316.  #  'menu::winProc •263 namewith[square]brackets' which when evaluated
  317.  #  causes an error.  We force a separate binding to
  318.  #  'menu::winProc •263 {namewith[square]brackets}' which does work.
  319.  # -------------------------------------------------------------------------
  320.  ##
  321. proc win::addToMenu {name} {
  322.     global winNameToNum winMenu winNumToName
  323.     
  324.     for {set i 0} {$i<100} {incr i} {
  325.         if ![info exists winNumToName($i)] {
  326.             regsub { <\w+>$} $name {} nm
  327.             if [file exists $nm] {
  328.                 regexp {[^:]*$} $name nm
  329.             } else {
  330.                 set nm $name
  331.             }
  332.             if {$i < 10} {
  333.                 addMenuItem -m -l "/$i" $winMenu "$nm"
  334.                 namespace eval ::alpha [list bind '$i' <c> [list menu::winProc $winMenu $nm]]
  335.             } else {
  336.                 addMenuItem -m -l "" $winMenu "$nm"
  337.             }
  338.             set winNumToName($i) $name
  339.             set winNameToNum($name) $i
  340.             return
  341.         }
  342.     }
  343. }
  344.  
  345. proc win::removeFromMenu {name} {
  346.     global winNameToNum winNumToName winMenu
  347.     regsub -all {\\([][])} $name {\1} name
  348.     set num $winNameToNum($name)
  349.     unset winNumToName($num)
  350.     unset winNameToNum($name)
  351.     regsub { <\d+>$} $name {} nm
  352.     if [file exists $nm] {
  353.         regexp {[^:]*$} $name nm
  354.     } else {
  355.         # in case it was a file but the file was actually moved!
  356.         if [regexp {[^:]*$} $name nm] {
  357.             if {![catch {deleteMenuItem -m $winMenu $nm}]} { return } }
  358.         set nm $name
  359.     }
  360.     # to handle alpha problem with rebuilding the menu
  361.     if [catch {deleteMenuItem -m $winMenu $nm}] { deleteMenuItem $winMenu $nm }
  362. }
  363.  
  364. proc mode::changeDialog {} {
  365.     global mode modeMenus
  366.  
  367.     set nmode [listpick -p "Mode:" -L $mode \
  368.       [lsort -ignore [array names modeMenus]]]
  369.     newMode $nmode
  370. }
  371.  
  372. proc mode::describe {} {
  373.     global mode ModeSuffixes modeMenus
  374.     global ${mode}modeVars
  375.     
  376.     set text "\r\tMODE $mode\r\r"
  377.     if ![catch {package::describe $mode 1} res] {
  378.         append text $res "\r\r"
  379.     }
  380.     append text [package::helpFile $mode 1] "\r"
  381.     set suffs ""
  382.     set first 1
  383.     foreach suf $ModeSuffixes {
  384.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") \
  385.           && ([lindex $suf 2] == $mode)} {
  386.             if {$first} {
  387.                 lappend suffs $last
  388.                 set first 0
  389.             } else {
  390.                 append suffs ", $last"
  391.             }
  392.         }
  393.         set last $suf
  394.     }
  395.     append text "Mode filepats: " $suffs "\r\r"
  396.     
  397.     set first 1
  398.     append text "Mode menus: "
  399.     if {[info exists modeMenus($mode)]} {
  400.         foreach m $modeMenus($mode) {
  401.             if $first {
  402.                 set first 0
  403.                 lappend text $m
  404.             } else {
  405.                 append text ", " $m
  406.             }
  407.         }
  408.     }
  409.     append text "\r\r"
  410.  
  411.     append text "Mode-specific variables:\r"
  412.     if {[info exists ${mode}modeVars]} {
  413.         foreach v [lsort [array names ${mode}modeVars]] {
  414.             set val [set ${mode}modeVars($v)]
  415.             global flag::type
  416.             if {[info exists flag::type($v)] \
  417.               && [regexp {binding$} [set flag::type($v)]]} {
  418.                 set val [dialog::specialView_binding $val]
  419.             }
  420.             append text [format "\t%-20s: \"%s\"\r" $v $val]
  421.         }
  422.     }
  423.  
  424.  
  425.     set etext "\rMode-independent bindings:\r"
  426.     append text "\rMode-specific bindings:\r"
  427.     foreach b [split [bindingList] "\r"] {
  428.         set lst [lindex $b end]
  429.         if {$lst == $mode} {
  430.             append text "\t$b\r"
  431.         }
  432.     }
  433.     append text "\rTo list mode-independent bindings, select\
  434.       'List Global Bindings'\rfrom the Global menu.\r"
  435.     new -n "* <$mode> MODE *" -m Tcl
  436.     insertText $text
  437.     winReadOnly
  438. }
  439.  
  440. # Now calls the new proc dialog::pickMenus
  441. proc mode::setMenus {} {
  442.     global mode modeMenus menus modifiedModeMenus globalMenus_curr
  443.  
  444.     set ms [dialog::pickMenus $mode]
  445.     set modeMenus($mode) $ms
  446.  
  447.     lappend modifiedModeMenus $mode
  448.  
  449.     foreach m $menus {
  450.         if {[lsearch $globalMenus_curr $m] < 0} {
  451.             global $m
  452.             catch {removeMenu [set $m]}
  453.         }
  454.     }
  455.  
  456.     foreach m $ms {
  457.         global $m
  458.         catch {$m}
  459.         catch {insertMenu [set $m]}
  460.     }
  461. }
  462. if {[info tclversion] < 8.0} {
  463. proc mode::proc {name args} {
  464.     global mode
  465.     if {[info commands ${mode}::$name] != ""} {
  466.         eval ${mode}::$name $args
  467.     } elseif {[info commands ${mode}$name] != ""} {
  468.         eval ${mode}$name $args
  469.     } else {
  470.         error ""
  471.     }
  472. }
  473. proc mode::getProc {name} {
  474.     global mode
  475.     if {[info commands ${mode}::$name] != ""} {
  476.         return ${mode}::$name
  477.     } elseif {[info commands ${mode}$name] != ""} {
  478.         return ${mode}$name
  479.     } else {
  480.         return ""
  481.     }
  482. }
  483. } else {
  484.     proc mode::proc {name args} {
  485.         global mode
  486.         namespace eval ::$mode "$name $args"
  487.     }
  488.     proc mode::getProc {name} {
  489.         global mode
  490.         namespace eval ::$mode "namespace which $name"
  491.     }
  492. }
  493.  
  494. # Suffixes used to determine mode for new windows.
  495. proc mode::updateSuffixes {} {
  496.     global ModeSuffixes modeMenus filepats
  497.  
  498.     set ModeSuffixes { default { set winMode Text } }
  499.     foreach m [lsort -ignore [array names modeMenus]] {
  500.         if {[info exists filepats($m)]} {
  501.             lappend ModeSuffixes $filepats($m) "set winMode $m"
  502.         }
  503.     }
  504. }
  505.  
  506.  
  507. proc synchroniseModeVar {var args} {
  508.     global mode $var
  509.     if {[llength $args] > 0} {
  510.         set $var [lindex $args 0]
  511.     }
  512.     global ${mode}ModeVars modifiedArrayElements
  513.     lappend modifiedArrayElements [list $var ${mode}modeVars]
  514.     set ${mode}modeVars($var) [set $var]
  515. }
  516.  
  517. # ◊◊◊◊ Miscellaneous ◊◊◊◊ #
  518.  
  519. ## 
  520.  # -------------------------------------------------------------------------
  521.  # 
  522.  # "saveACopyAs" --
  523.  # 
  524.  # Finally a proc to add to your collection of Alpha bugs.
  525.  # copyFile has an interesting bug. If the destination file exists it
  526.  # puts the file in [pwd] instead. This proc makes sure it is removed first.
  527.  #  
  528.  # -------------------------------------------------------------------------
  529.  ##
  530. proc saveACopyAs {} {
  531.     if {[file exists [set nm [stripNameCount [win::Current]]]]} {
  532.         set nm2 [putfile "Save a copy as:" [file tail $nm]]
  533.         if {[file exists $nm2]} {removeFile $nm2}
  534.         copyFile $nm $nm2
  535.     }
  536. }
  537.  
  538. proc menu::winProc {menu name} {
  539.     global winNameToNum
  540.  
  541.     set nms [array names winNameToNum]
  542.  
  543.     if {[lsearch $nms "*[quote::Find $name]"] < 0} {
  544.         $name
  545.         return
  546.     }
  547.  
  548.     foreach nm $nms {
  549.         if {[string match *[quote::Find $name] $nm] == "1"}  {
  550.             bringToFront $name
  551.             if [icon -q] { icon -f $name -o }
  552.             return
  553.         }
  554.     }
  555.     return "normal"
  556. }
  557.  
  558. proc alpha::try {msg args} {
  559.     message "${msg}…"
  560.     set i -1
  561.     set ok 1
  562.     while 1 {
  563.         set do [lindex $args [incr i]]
  564.         set say [lindex $args [incr i]]
  565.         if {$say == ""} {
  566.             set say "loading $do"
  567.         }
  568.         if {$do == ""} {
  569.             if $ok {
  570.                 message "${msg}…Complete."
  571.             } else {
  572.                 alertnote "${msg}…Failed."
  573.             }
  574.             return $ok
  575.         }
  576.         message "$say…"
  577.         if [catch $do] {
  578.             alertnote "$say failed!"
  579.         }
  580.         
  581.     }
  582. }
  583.  
  584. # ◊◊◊◊ Read in all the packages ◊◊◊◊ #
  585.  
  586. proc alpha::getBasicModes {} {
  587.     global PSwords
  588.     addMode PS {} {*.ps} {}
  589.     newPref v prefixString {% } PS
  590.     set PSKeyWords {
  591.         def begin end dict load exec if ifelse for repeat loop exit 
  592.         stop stopped countexecstack execstack quit start gsave 
  593.         grestore grestoreall initgraphics newpath erasepage fill 
  594.         eofill stroke image imagemask showpage copypage
  595.     }
  596.     if {[info exists PSwords]} {set PSKeyWords [concat $PSKeyWords $PSwords]}
  597.     regModeKeywords -e {%} -m {/}  -c red -k blue PS $PSKeyWords -i "\}" -i "\{" -i {[} -i {]} -I green
  598.  
  599.     addMode Inst "" [list "*Install" "*INSTALL"] {installMenu}
  600.     addMenu installMenu
  601.     hook::register openHook install::openHook Inst
  602.     
  603.     addMode Text {} {default} {}
  604.     newPref v leftFillColumn {0} Text
  605.     newPref v suffixString { <--} Text
  606.     newPref v prefixString {> } Text
  607.     newPref v fillColumn {75} Text
  608.     newPref f wordWrap {1} Text
  609.     newPref v wordBreak {\w+} Text
  610.     newPref v wordBreakPreface {(\W)} Text
  611.     newPref v wrapBreak {[\w_]+} Text
  612.     newPref v wrapBreakPreface {([^\w_])} Text
  613.     newPref f autoMark 0 Text
  614.     newPref flag quietlyClearMarks 0 Text
  615. }
  616.  
  617. proc alpha::findAllPlugins {} {
  618.     alpha::findAllModes
  619.     global skipPrefs
  620.     if {!$skipPrefs} {
  621.         alpha::findAllExtensions
  622.     }
  623.     alpha::findAllMenus
  624. }
  625.  
  626. proc alpha::findAllModes {} {
  627.     alpha::getBasicModes
  628.     rename alpha::getBasicModes {}
  629.     cache::read index::mode
  630.     foreach f [array names index::mode] {
  631.         eval addMode $f [lrange [set index::mode($f)] 1 3]
  632.         if {[set script [lindex [set index::mode($f)] 4]] != ""} {
  633.             if [catch {uplevel #0 $script}] {
  634.                 lappend problems "$f"
  635.             }
  636.         }
  637.     }
  638.     if {[info exists problems]} {
  639.         alertnote "Problems loading modes: $problems"
  640.     }
  641.     mode::updateSuffixes
  642. }
  643.  
  644. proc alpha::findAllMenus {} {
  645.     cache::read index::menu
  646.     global alpha::package_menus
  647.     ensureset alpha::package_menus ""
  648.     foreach f [array names index::menu] {
  649.         addMenu $f [lindex [set index::menu($f)] 1]
  650.         if [lindex [set index::menu($f)] 2] {
  651.             lappend alpha::package_menus $f
  652.         }
  653.         if {[set script [lindex [set index::menu($f)] 3]] != ""} {
  654.             if [catch {uplevel #0 $script}] {
  655.                 lappend problems "$f"
  656.             }
  657.         }
  658.     }
  659.     if {[info exists problems]} {
  660.         alertnote "Problems loading menus: $problems"
  661.     }
  662. }
  663.  
  664.