home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / FrontierMenu / frontierMenu.tcl < prev    next >
Encoding:
Text File  |  1999-04-30  |  25.0 KB  |  919 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Frontier menu - tools for using Alpha as Frontier's external editor
  4.  # 
  5.  #  FILE: "frontierMenu.tcl"
  6.  #                                    created: 97-04-03 22.01.22 
  7.  #                                last update: 99-04-30 20.23.44 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.5
  13.  # 
  14.  # Copyright 1997-1999 by Johan Linde
  15.  #  
  16.  # Much of the tcl code and the Frontier scripts have been written by 
  17.  # Danis Georgiadis <dmg@hyper.gr>
  18.  # 
  19.  # This software may be used freely, and distributed freely, as long as the 
  20.  # receiver is not obligated in any way by receiving it.
  21.  #  
  22.  # If you make improvements to this file, please share them!
  23.  # 
  24.  # ###################################################################
  25.  ##
  26.  
  27. if {[alpha::package vsatisfies ${alpha::version} 7.1b8]} {
  28. alpha::menu frontierMenu 2.1.5 global "•142" {} {frontierMenu} {
  29.     catch {removeMenu $frontierScriptMenu}
  30. } uninstall {
  31.     removeFile $pkg_file
  32.     removeFile "$HOME:Help:Frontier Help"
  33. } maintainer {
  34.     "Johan Linde" jlinde@telia.com <http://www.theophys.kth.se/~jl/Alpha.html>
  35. } help {file "Frontier Help"}
  36. } else {
  37. ;alpha::menu frontierMenu 2.1.5 "•142" in_menu {
  38. } uninstall {
  39.     removeFile $pkg_file
  40.     removeFile "$HOME:Help:Frontier Help"
  41. } maintainer {
  42.     "Johan Linde" jlinde@telia.com <http://www.theophys.kth.se/~jl/Alpha.html>
  43. } help {file "Frontier Help"}
  44. }
  45.  
  46. proc frontierMenu {} {}
  47. set frontierScriptMenu •144
  48.  
  49.  
  50. # Preferences
  51. newPref f autoLaunch 0 Fron
  52. newPref v BrowsePoints {{root root} {Websites websites}} Fron
  53. newPref v OpenPoints {{Websites websites} {Glossary user.html.glossary} {Templates user.html.templates}} Fron
  54.  
  55. # Register hooks
  56. hook::register closeHook frontierCloseHook
  57. hook::register savePostHook frontierSavePostHook
  58. hook::register saveasHook frontierSaveasHook
  59.  
  60. if {[alpha::package vsatisfies ${alpha::version} 7.1b1]} {
  61. proc frontierBrowseMenu {} {
  62.     global FronmodeVars
  63.     set bl {}
  64.     foreach b $FronmodeVars(BrowsePoints) {
  65.         lappend bl [lindex $b 0]
  66.     }
  67.     return [list Menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  68. }
  69.  
  70. proc frontierOpenMenu {} {
  71.     global FronmodeVars
  72.     set bl {}
  73.     foreach b $FronmodeVars(OpenPoints) {
  74.         lappend bl [lindex $b 0]
  75.     }
  76.     return [list Menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  77. }
  78. } else {
  79. proc frontierBrowseMenu {} {
  80.     global FronmodeVars
  81.     set bl {}
  82.     foreach b $FronmodeVars(BrowsePoints) {
  83.         lappend bl [lindex $b 0]
  84.     }
  85.     return [list menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  86. }
  87.  
  88. proc frontierOpenMenu {} {
  89.     global FronmodeVars
  90.     set bl {}
  91.     foreach b $FronmodeVars(OpenPoints) {
  92.         lappend bl [lindex $b 0]
  93.     }
  94.     return [list menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  95. }
  96. }
  97.  
  98. # Menu definition
  99. proc menu::buildFrontierMenu {} {
  100.     global frontierMenu
  101.     return [list build [list  \
  102.     "<U<O/Fswitch toFrontier" \
  103.     "<U<O/'previewPage" \
  104.     "<B<O/'publishPage" \
  105.     "<I<O/YfrontierShell" \
  106.     [frontierBrowseMenu] \
  107.     [frontierOpenMenu] \
  108.     "rebuildScriptsMenu" \
  109.     preferences…] \
  110.     frontierMenuProc "" $frontierMenu]
  111. }
  112.  
  113. menu::buildProc frontierMenu menu::buildFrontierMenu
  114. menu::buildSome frontierMenu
  115.  
  116. proc frontierMenuProc {menu item} {
  117.     global frontierMenu FronmodeVars
  118.     switch -glob $menu {
  119.         •* {
  120.             switch -glob $item {
  121.                 "switch*toFrontier" {frontierLaunch Fore}
  122.                 preferences {FronmodifyFlags}
  123.                 default {eval frontier$item}
  124.             }
  125.         }
  126.         Browse {
  127.             switch $item {
  128.                 "Browse at" {frontierBrowseAt}
  129.                 Add {frontierAddPoint Browse}
  130.                 Remove {frontierRemovePoint Browse}
  131.                 default {
  132.                     foreach b $FronmodeVars(BrowsePoints) {
  133.                         if {[lindex $b 0] == $item} {
  134.                             frontierCheckExist [lindex $b 1] $item Browse
  135.                             odbBrowse [lindex $b 1]
  136.                             break
  137.                         }
  138.                     }
  139.                 }
  140.             }
  141.         }
  142.         Open {
  143.             switch $item {
  144.                 Open {frontierOpen}
  145.                 Add {frontierAddPoint Open}
  146.                 Remove {frontierRemovePoint Open}
  147.                 default {
  148.                     foreach b $FronmodeVars(OpenPoints) {
  149.                         if {[lindex $b 0] == $item} {
  150.                             frontierCheckExist [lindex $b 1] $item Open
  151.                             frontierDoScript "edit (@[lindex $b 1])" front
  152.                             break
  153.                         }
  154.                     }
  155.                 }
  156.             }
  157.         }
  158.     }
  159. }
  160.  
  161. proc frontierCheckExist {item mitem type} {
  162.     if {[frontierDoScript defined($item)] == "false"} {
  163.         alertnote "$mitem no longer exists in the database. It is removed from the menu."
  164.         frontierDoTheRemove $type $mitem
  165.         error ""
  166.     }
  167.     
  168. }
  169. # Called by Frontier when opening a Frontier text document in Alpha.
  170. proc openFromFrontier {} {
  171.     global frontierWinList
  172.     set name [lindex [winNames -f] 0]
  173.     set name0 [stripNameCount $name]
  174.     regsub -all {\[|\]} $name0 {\\&} name0
  175.     if {[lsearch -exact $frontierWinList $name0] < 0} {lappend frontierWinList $name0}
  176. }
  177.  
  178. # If the current document is a Frontier document, it is updated in Frontier.
  179. if {[alpha::package vsatisfies ${alpha::version} 7.2]} {
  180. proc frontierSavePostHook {name} {
  181.     global frontierWinList
  182.     regsub -all {\[|\]} $name {\\&} name
  183.     if {[lsearch -exact $frontierWinList $name] >= 0} {
  184.         frontierLaunch
  185.         regsub -all {\\([][])} $name {\1} name
  186.         AEBuild 'LAND' ALFA FMod "----" "“${name}”"
  187.     }
  188. }
  189. } else {
  190. ;proc frontierSavePostHook {name} {
  191.     global frontierWinList
  192.     if {[lsearch -exact $frontierWinList $name] >= 0} {
  193.         frontierLaunch
  194.         regsub -all {\\([][])} $name {\1} name
  195.         AEBuild 'LAND' ALFA FMod "----" "“${name}”"
  196.     }
  197. }
  198. }
  199.  
  200. proc frontierLaunch {{b Back}} {
  201.     if {![app::isRunning LAND]} {
  202.         if {[catch {eval app::launch$b LAND}]} {
  203.             alertnote "Could not launch Frontier."
  204.             error "Launch error"
  205.         }
  206.     } elseif {$b == "Fore"} {
  207.         switchTo 'LAND'
  208.     }
  209. }
  210.  
  211. # A list of windows opened from Frontier.
  212. if {![info exists frontierWinList]} {set frontierWinList {}}
  213.  
  214. # Executes a script in Frontier.
  215. proc frontierDoScript {script {front 0} {alert 1} {queue 0}} {
  216.     if {[catch frontierLaunch]} {error "Could not launch Frontier."}
  217.     if {$queue} {
  218.         # Never switch to Frontier when queing.
  219.         dosc -c 'LAND' -q -t 30000 -s $script
  220.         return
  221.     } elseif {[catch {dosc -c 'LAND' -s $script} returnvalue]} {
  222.         if {$alert} {
  223.             alertnote "Frontier $returnvalue"
  224.             error "Frontier $returnvalue"
  225.         }
  226.         error $returnvalue
  227.     } elseif {$front == "front"} {
  228.         switchTo 'LAND'
  229.     }
  230.     return $returnvalue
  231. }
  232.  
  233. # Executes one of the scripts in Frontier, which are required to use Alpha with Frontier.
  234. proc frontierDoAlphaScript {script {queue 0}} {
  235.     global HOME frontierHasWarned
  236.     if {[catch {frontierDoScript $script 0 0 $queue} res]} {
  237.         frontierError
  238.         error $res
  239.     }
  240.     return $res
  241. }
  242.  
  243. proc frontierError {} {
  244.     global frontierHasWarned
  245.     if {![info exists frontierHasWarned]} {
  246.         alertnote "The Frontier verbs required to integrate Alpha and Frontier have not been\
  247.           properly installed. See the file 'Frontier Help.'"
  248.         edit -r -c "$HOME:Help:Frontier Help"
  249.     }
  250. }
  251.     
  252. # closeHook
  253. # If the window to be closed is a Frontier document, it is removed
  254. # from Frontier's list of open external documents.
  255. proc frontierCloseHook {name} {
  256.     global frontierWinList frontierQSWin frontierCommandHistory frontierCommandNum
  257.     if {[set where [lsearch -exact $frontierWinList $name]] >= 0} {
  258.         regsub -all {\\([][])} $name {\1} name
  259.         set frontierWinList [lreplace $frontierWinList $where $where]
  260.         catch {AEBuild 'LAND' ALFA FCls "----" "“${name}”"}
  261.     }
  262.     if {$name == $frontierQSWin} {set frontierCommandHistory ""; set frontierCommandNum 0}
  263. }
  264.  
  265. # saveasHook
  266. proc frontierSaveasHook {oldname newname} {
  267.     frontierCloseHook $oldname
  268. }
  269.  
  270.  
  271. # Does the same as 'Preview Page' in Frontier's web menu.
  272. proc frontierpreviewPage {} {
  273.     frontierPrePub viewInBrowser
  274. }
  275.  
  276. # Does the same as 'Publish Page' in Frontier's web menu.
  277. proc frontierpublishPage {} {
  278.     frontierPrePub publishPage
  279. }
  280.  
  281. proc frontierPrePub {script} {
  282.     global frontierWinList
  283.     if {![llength [winNames]]} {
  284.         alertnote "No window!"
  285.         return
  286.     }
  287.     set name [lindex [winNames -f] 0]
  288.     set name0 [stripNameCount $name]
  289.     regsub -all {\[|\]} $name0 {\\&} name0
  290.     if {[lsearch -exact $frontierWinList $name0] >= 0} {
  291.         if {[winDirty]} {
  292.             if {[set ask [askyesno -c "Save '[file tail $name]'?"]] == "yes"} {
  293.                 save
  294.             } elseif {$ask == "cancel"} {
  295.                 return
  296.             }
  297.         }
  298.         regsub -all "\"" $name0 "\\\"" name0
  299.         frontierDoScript "Alpha.${script}(\"[string tolower $name0]\")"
  300.     } else {
  301.         alertnote "Not a Frontier window."
  302.     }
  303. }
  304.  
  305. # Open a window in Frontier
  306. proc frontierOpen {} {
  307.     if {![catch {frontierGetAddress} addr]} {
  308.         frontierDoScript "edit (@$addr)" front
  309.     }
  310. }
  311.  
  312. # Browse a table in Frontier
  313. proc frontierBrowseAt {} {
  314.     if {![catch {frontierGetAddress} addr]} {
  315.         odbBrowse $addr
  316.     }
  317. }
  318.  
  319. # Add to Browse and Open submenus
  320. proc frontierAddPoint {type} {
  321.     global FronmodeVars modifiedModeVars
  322.     set values ""
  323.     while {1} {
  324.         set values [dialog -w 450 -h 130 -t "Add $type menu item" 30 10 290 30 \
  325.             -t "Location in database:" 10 40 160 60 -e [lindex $values 0] 165 40 440 55 \
  326.             -t "Menu text:" 78 70 160 90 -e [lindex $values 1] 165 70 440 85 \
  327.             -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  328.         if {[lindex $values 3]} {return}
  329.         set addr [string trim [lindex $values 0]]
  330.         if {$addr == ""} {alertnote "Location is database must be specified."; continue}
  331.         set text [string trim [lindex $values 1]]
  332.         if {$text == ""} {alertnote "The menu item must be specified."; continue}
  333.         if {[frontierDoScript "defined($addr)"] == "true"} {
  334.             set ex 0
  335.             foreach b $FronmodeVars(${type}Points) {
  336.                 if {[lindex $b 0] == $text} {alertnote "A menu item '$text' already exists."; set ex 1}
  337.             }
  338.             if {!$ex} {break}
  339.         } else {
  340.             alertnote "“$addr” is not a valid database address."
  341.         }
  342.     }
  343.     lappend FronmodeVars(${type}Points) [list $text $addr]
  344.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  345.     eval [eval frontier${type}Menu]
  346. }
  347.  
  348. # Remove from Browse and Open submenus.
  349. proc frontierRemovePoint {type} {
  350.     global FronmodeVars
  351.     set points {}
  352.     foreach b $FronmodeVars(${type}Points) {
  353.         lappend points [lindex $b 0]
  354.         set pointat([lindex $b 0]) [lindex $b 1]
  355.     }
  356.     if {![llength $points] || [catch {listpick -p "Select [string tolower $type] point to remove:" -l $points} points] ||
  357.         ![llength $points]} {return}
  358.     set points [lindex $points 0]
  359.     if {[askyesno "'$points' points to '$pointat($points)'. Remove?"] != "yes"} {return}
  360.     frontierDoTheRemove $type $points
  361. }
  362.  
  363. proc frontierDoTheRemove {type points} {
  364.     global FronmodeVars modifiedModeVars
  365.     set n {}
  366.     foreach b $FronmodeVars(${type}Points) {
  367.         if {[lindex $b 0] != $points} {lappend n $b}
  368.     }
  369.     set FronmodeVars(${type}Points) $n
  370.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  371.     eval [eval frontier${type}Menu]
  372. }
  373.  
  374. proc frontierGetAddress {} {
  375.     while {1} {
  376.         if {[catch {set addr [prompt "Location in Frontier database:" ""]}]} {
  377.             error ""
  378.         } else {
  379.             set addr [string trimleft [string trim $addr] {@}]
  380.             switch [frontierDoScript "defined($addr)"] {
  381.                 "true"        {return $addr}
  382.                 "false"        {alertnote "“$addr” is not a valid database address"}
  383.                 ""            {error ""}
  384.             }
  385.         }
  386.     }
  387. }
  388.  
  389. proc FronmodifyFlags {} {
  390.     global FronmodeVars modifiedModeVars
  391.     set values [dialog -w 300 -h 110 -t "Frontier Preferences" 30 10 290 30 \
  392.         -c "Launch Frontier at startup" $FronmodeVars(autoLaunch) 10 40 290 60 \
  393.         -b OK 20 80 85 100 -b Cancel 105 80 170 100]
  394.     if {[lindex $values 2]} {return}
  395.     set i -1
  396.     foreach flag [list autoLaunch] {
  397.         global $flag
  398.         incr i
  399.         set val [lindex $values $i]
  400.         if {$FronmodeVars($flag) != $val} {
  401.             set $flag $val
  402.             set FronmodeVars($flag) $val
  403.             lappend modifiedModeVars [list $flag FronmodeVars]
  404.         }
  405.     }
  406. }
  407.  
  408. proc OdbmodifyFlags {} {
  409.     FronmodifyFlags
  410. }
  411.  
  412. proc frontierGetWin {} {
  413.     global frontierWinList frontierWinNum
  414.     if {![info exists frontierWinNum]} {set frontierWinNum 0}
  415.     if {[llength $frontierWinList] == $frontierWinNum} {
  416.         unset frontierWinNum
  417.         return ""
  418.     } else {
  419.         return [lindex $frontierWinList [expr [incr frontierWinNum] - 1]]
  420.     }
  421. }
  422.  
  423. proc frontierCloseAllWindows {} {
  424.     global frontierWinList
  425.     foreach win $frontierWinList {
  426.         regsub -all {\\([][])} $win {\1} win
  427.         bringToFront $win
  428.         setWinInfo dirty 0
  429.         killWindow
  430.     }
  431. }
  432.  
  433. #===============================================================================
  434. # Script menu
  435. # 
  436. # The code to extract a Frontier menu has been written by
  437. # Danis Georgiadis <dmg@hyper.gr>
  438. # 
  439. #===============================================================================
  440.  
  441. proc setFrontierMenuScript {menu item scpt} {
  442.     global frontierMenuScripts
  443.     if {[regexp {&$} $item]} {
  444.         set item [string trimright $item &]
  445.     } else {
  446.         regsub -all {<[BUISEO]} $item "" item
  447.         regsub {/[a-zA-Z]} $item "" item
  448.         regsub -all {[!\^].} $item "" item
  449.     }
  450.     set key [string trimright "$menu$item" …]
  451.     set frontierMenuScripts($key) $scpt
  452. }
  453.  
  454. proc frontierBuildScriptMenu {} {
  455.     global frontierScriptMenu FronmodeVars
  456.  
  457.     if {![app::isRunning LAND]} {
  458.         if {$FronmodeVars(autoLaunch)} {
  459.             app::launchBack LAND
  460.         } else {
  461.             return
  462.         }
  463.     }
  464.     currentReplyHandler frontierGetMenuReplyHandler
  465.     frontierDoAlphaScript "Alpha.getMenuSource()" 1
  466.  
  467. }
  468.  
  469. proc frontierScriptMenuProc {menu item} {
  470.     global frontierMenuScripts frontierScriptMenu
  471.     if {$menu == $frontierScriptMenu} {set menu ""}
  472.     set key "$menu$item"
  473.     frontierDoScript $frontierMenuScripts($key)
  474. }
  475.  
  476. proc frontierrebuildScriptsMenu {} {
  477.     global frontierMenuScripts
  478.     frontierLaunch
  479.     currentReplyHandler frontierInvalReplyHandler
  480.     frontierDoAlphaScript "Alpha.invalMenuSources()" 1
  481. }
  482.  
  483. proc frontierGetMenuReplyHandler {args} {
  484.     global frontierScriptMenu
  485.     if {[string range $args 12 16] == "errs:"} {
  486.         frontierError
  487.     } else {
  488.         regexp {“([^”]*)”} $args dum txt
  489.         regsub -all {\\\{} $txt "{" txt
  490.         regsub -all {\\\}} $txt "}" txt
  491.         menu -m -n $frontierScriptMenu -p frontierScriptMenuProc $txt
  492.         insertMenu $frontierScriptMenu
  493.          currentReplyHandler frontierGetDefsReplyHandler
  494.         catch {frontierDoAlphaScript "Alpha.getDefsSource()" 1}
  495.     }
  496.     return 1
  497. }
  498.  
  499. proc frontierGetDefsReplyHandler {args} {
  500.     if {[string range $args 12 16] == "errs:"} {
  501.         frontierError
  502.     } else {
  503.         regexp {“([^”]*)”} $args dum txt
  504.         regsub -all {\\\{} $txt "{" txt
  505.         regsub -all {\\\}} $txt "}" txt
  506.         catch {eval $txt}
  507.     }
  508.     message "Frontier script menu built."
  509.     return 1    
  510. }
  511.  
  512. proc frontierInvalReplyHandler {args} {
  513.     catch {unset frontierMenuScripts}
  514.     catch {frontierBuildScriptMenu}
  515.     return 1
  516. }
  517.  
  518.  
  519. #===============================================================================
  520. #
  521. # Frontier shell
  522. # 
  523. # Some ideas taken from Matlab mode by Stephen Merkowitz
  524. # 
  525. #===============================================================================
  526. set frontierQSWin "* Frontier shell *"
  527. set frontierCommandHistory ""
  528. set frontierCommandNum 0
  529.  
  530. proc frontierfrontierShell {} {
  531.     global frontierQSWin
  532.     
  533.     if {[lsearch [winNames] $frontierQSWin] >= 0} {
  534.         bringToFront $frontierQSWin
  535.     } else {
  536.         new -n $frontierQSWin -m Fron
  537.         setWinInfo -w $frontierQSWin shell 1
  538.         insertText "Welcome to Alpha's Frontier shell\r«» "
  539.     }
  540. }
  541.  
  542.  
  543. proc frontierRunQuickScript {} {
  544.     global frontierCommandHistory frontierCommandNum frontierQSWin
  545.     set pos [getPos]
  546.  
  547.     set ind [string first "«» " [getText [lineStart $pos] [nextLineStart [getPos]]]]
  548.     if {$ind >= 0} {
  549.         set lStart [expr [lineStart $pos]+$ind+2]
  550.         endOfLine
  551.         set scriptName [getText $lStart [getPos]]
  552.         if {[getPos] != [maxPos]} {
  553.             goto [maxPos]
  554.             insertText $scriptName
  555.         }
  556.         
  557.         if {[string trim $scriptName] != ""} {
  558.             catch {frontierDoScript $scriptName 0 0} result
  559.             if {[string compare [lindex $frontierCommandHistory [expr [llength $frontierCommandHistory]-1]] $scriptName] != 0} {
  560.                 lappend frontierCommandHistory $scriptName
  561.                 if {[llength $frontierCommandHistory] > 30} {
  562.                     set frontierCommandHistory [lrange $frontierCommandHistory 1 end]
  563.                 }
  564.             }
  565.             set frontierCommandNum [llength $frontierCommandHistory]
  566.         } else {
  567.             set result ""
  568.         }
  569.         if {[string length $result]} {
  570.             insertText -w $frontierQSWin "\r" $result \r "«» "
  571.         } else {
  572.             insertText -w $frontierQSWin \r "«» "
  573.         }
  574.     } else {
  575.            if {[getPos] == [maxPos]} {
  576.             insertText "«» "
  577.         } else {
  578.             bind::CarriageReturn
  579.         }
  580.     }
  581.     return
  582. }
  583.  
  584.  
  585. proc frontierPrevCommand {} {
  586.     global frontierCommandHistory frontierCommandNum
  587.     
  588.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  589.     if {[set ind [string first "«» " $text]] == 0} {
  590.         goto [expr [lineStart [getPos]] + $ind + 2]
  591.     } else return
  592.  
  593.     incr frontierCommandNum -1
  594.     if {$frontierCommandNum < 0} {
  595.         incr frontierCommandNum
  596.         endOfLine
  597.         return
  598.     }
  599.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  600.     set to [nextLineStart [getPos]]
  601.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  602.     replaceText [getPos] $to $text
  603. }
  604.  
  605.  
  606. proc frontierNextCommand {} {
  607.     global frontierCommandHistory frontierCommandNum
  608.     
  609.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  610.     if {[set ind [string first "«» " $text]] == 0} {
  611.         goto [expr [lineStart [getPos]] + $ind + 2]
  612.     } else return
  613.  
  614.     incr frontierCommandNum
  615.     if {$frontierCommandNum >= [llength $frontierCommandHistory]} {
  616.         incr frontierCommandNum -1
  617.         frontierCancelLine
  618.         return
  619.     }
  620.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  621.     set to [nextLineStart [getPos]]
  622.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  623.     replaceText [getPos] $to $text
  624. }
  625.  
  626. proc frontierCancelLine {} {
  627.     global frontierCommandHistory frontierCommandNum
  628.  
  629.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  630.     if {[set ind [string first "«» " $text]] == 0} {
  631.         goto [expr [lineStart [getPos]] + $ind + 3]
  632.     } else return
  633.     
  634.     set to [nextLineStart [getPos]]
  635.     deleteText [getPos] $to
  636.     
  637.     set frontierCommandNum [llength $frontierCommandHistory]
  638. }
  639.  
  640. proc frontierBol {} {
  641.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  642.     if {[set ind [string first "«» " $text]] == 0} {
  643.         goto [expr [lineStart [getPos]] + $ind + 3]
  644.     } else {
  645.         goto [lineStart [getPos]]
  646.     }
  647. }
  648.  
  649. proc Fron::OptionTitlebar {} {
  650.     global frontierCommandHistory
  651.     return $frontierCommandHistory
  652. }
  653.  
  654. proc Fron::OptionTitlebarSelect {item} {
  655.     insertText [string range $item [expr 1+[string first " " $item]] end]
  656.     if {[key::optionPressed]} {frontierRunQuickScript}
  657. }
  658.  
  659. regModeKeywords -m {«} Fron {}
  660. bind up <z> frontierPrevCommand Fron
  661. bind down <z> frontierNextCommand Fron
  662. bind '\r' frontierRunQuickScript Fron
  663. bind 'u'  <z>  frontierCancelLine  Fron
  664. bind left <c> frontierBol Fron
  665. bind 'a' <z> frontierBol Fron
  666.  
  667. #===============================================================================
  668. # Odb browser
  669. # 
  670. # Written by Danis Georgiadis <dmg@hyper.gr> and modified by me to be integrated 
  671. # with the rest.
  672. # 
  673. #===============================================================================
  674.  
  675. set odbBrowserTabLength 3
  676. set odbBrowserTypeOffset 60
  677.  
  678. proc odbget120Spaces {} {
  679.     set spaces40 "                                        "
  680.     return "$spaces40$spaces40$spaces40"
  681. }
  682.  
  683. proc odbGetIndLevel {indStr} {
  684.     global odbBrowserTabLength
  685.     return [expr [string length $indStr] / $odbBrowserTabLength]
  686. }
  687.  
  688. proc odbGetIndString {indLevel} {
  689.     global odbBrowserTabLength
  690.     return [string range [odbget120Spaces] 0 [expr [expr $indLevel * $odbBrowserTabLength] - 1]]
  691. }
  692.  
  693. proc odbGetNextIndString {thisIndStr} {
  694.     return [odbGetIndString [expr [odbGetIndLevel $thisIndStr] + 1]]
  695. }
  696.  
  697. proc odbBrowseGetLineParts {name type addr level} {
  698.     global odbBrowserTypeOffset
  699.     global odbBrowserTabLength
  700.     
  701.     set indPadPart [odbGetIndString $level]
  702.     set namePart [string trim $name "\t "]
  703.     set typePadSize [expr $odbBrowserTypeOffset - [expr [string length $indPadPart] + [string length $name]]]
  704.     set typePadPart [string range [odbget120Spaces] 0 [expr $typePadSize - 1]]
  705.     set typePart "◊$type◊"
  706.     set addrPart "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$addr∞"
  707.     
  708.     set res ""
  709.     lappend res $indPadPart $namePart $typePadPart $typePart $addrPart
  710.     
  711.     return $res
  712. }
  713.  
  714. proc odbBrowseDown {} {
  715.     set curPos [getPos]
  716.     set curLineStart [lineStart $curPos]
  717.     set curLineEnd [nextLineStart $curPos]
  718.     select $curLineStart $curLineEnd
  719.     
  720.     set newLineStart [nextLineStart $curLineStart]
  721.     set newLineEnd [nextLineStart $newLineStart]
  722.     if {$newLineStart < [maxPos]} {
  723.         select $newLineStart $newLineEnd
  724.     }
  725. }
  726.  
  727. proc odbBrowseCmdDown {{option 0}} {
  728.     set curPos [getPos]
  729.     set curLineStart [lineStart $curPos]
  730.     set curLineEnd [nextLineStart $curPos]
  731.     
  732.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  733.         if {[frontierDoScript "defined($addr)"] == "false"} {return}
  734.         if {$option} {killWindow}
  735.         odbBrowse $addr
  736.     }
  737. }
  738.  
  739. proc odbBrowseUp {} {
  740.     set curPos [getPos]
  741.     set curLineStart [lineStart $curPos]
  742.     set curLineEnd [nextLineStart $curPos]
  743.     select $curLineStart $curLineEnd
  744.     
  745.     set newLineStart [prevLineStart $curLineStart]
  746.     set newLineEnd [nextLineStart $newLineStart]
  747.     if {$newLineEnd > 0} {
  748.         select $newLineStart $newLineEnd
  749.     }
  750. }
  751.  
  752. proc odbBrowseCmdUp {{option 0}} {
  753.     regexp {∞(.+)∞} [getText 0 [nextLineStart 0]] junk addr
  754.     if {[set point [string last "." $addr]] >= 0} {
  755.         if {[frontierDoScript "defined($addr)"] == "false"} {return}
  756.         if {$option} {killWindow}
  757.         odbBrowse [string range $addr 0 [expr $point - 1]]
  758.     }
  759. }
  760.  
  761. proc odbBrowserAddCells {pos cells indLevel} {
  762.     
  763.     set tmp ""
  764.     set colorCodes ""
  765.     set lastPos $pos
  766.     
  767.     foreach cell $cells {
  768.         set cellName [lindex $cell 0]
  769.         set cellType [lindex $cell 1]
  770.         set cellAddr [lindex $cell 2]
  771.         
  772.         set parts [odbBrowseGetLineParts $cellName $cellType $cellAddr $indLevel]
  773.         
  774.         set indPart [lindex $parts 0]
  775.         set namePart [lindex $parts 1]
  776.         set typePartPad [lindex $parts 2]
  777.         set typePart [lindex $parts 3]
  778.         set addrPart [lindex $parts 4]
  779.         
  780.         set nameStart [expr $lastPos + [string length $indPart]]
  781.         set nameEnd [expr $nameStart + [string length $namePart]]
  782.         
  783.         if {$cellType == "TEXT" || $cellType == "wptx"} {
  784.             lappend colorCodes [concat $nameStart 3]
  785.             lappend colorCodes [concat $nameEnd 0]
  786.         } elseif {$cellType == "tabl"} {
  787.             lappend colorCodes [concat $nameStart 5]
  788.             lappend colorCodes [concat $nameEnd 0]
  789.         } else {
  790.             lappend colorCodes [concat $nameStart 1]
  791.             lappend colorCodes [concat $nameEnd 0]
  792.         }
  793.         
  794.         set typeStart [expr $lastPos + [string length $indPart] + [string length $namePart] + [string length $typePartPad]]
  795.         set typeEnd [expr $typeStart + [string length $typePart]]
  796.         lappend colorCodes [concat $typeStart 4]
  797.         lappend colorCodes [concat $typeEnd 0]
  798.         
  799.         set line ""
  800.         append line $indPart $namePart $typePartPad $typePart $addrPart "\n"
  801.         append tmp $line
  802.         
  803.         set lastPos [expr $lastPos + [string length $line]]
  804.     }
  805.     
  806.     select $pos $pos
  807.     setWinInfo read-only 0
  808.     
  809.     insertText $tmp
  810.     
  811.     foreach colorCode $colorCodes {
  812.         insertColorEscape [lindex $colorCode 0] [lindex $colorCode 1]
  813.     }
  814.     
  815.     setWinInfo dirty 0
  816.     setWinInfo read-only 1
  817.     eval sizeWin [lrange [getGeometry] 2 end]
  818. }
  819.  
  820. proc odbBrowseRight {} {
  821.     set curPos [getPos]
  822.     set curLineStart [lineStart $curPos]
  823.     set curLineEnd [nextLineStart $curPos]
  824.     
  825.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  826.         set nextIndString [odbGetNextIndString $ind]
  827.         set nextLineText [getText [nextLineStart $curLineStart] [nextLineStart [nextLineStart $curLineStart]]]
  828.         if {![regexp "^$nextIndString" $nextLineText junk]} {
  829.             if {[frontierDoScript "defined($addr)"] == "false"} {return}            
  830.             set cells [frontierDoAlphaScript "Alpha.getCellData(@$addr)"]
  831.             odbBrowserAddCells $curLineEnd $cells [odbGetIndLevel $nextIndString]
  832.             
  833.         }
  834.     }
  835.     
  836.     select $curLineStart $curLineEnd
  837. }
  838.  
  839. proc odbBrowseLeft {} {
  840.     set curPos [getPos]
  841.     set curLineStart [lineStart $curPos]
  842.     set curLineEnd [nextLineStart $curPos]
  843.     
  844.     if {[regexp {^( *).+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind elems]} {
  845.         set pos [nextLineStart $curLineStart]
  846.         set start $pos
  847.         set nextIndString [odbGetNextIndString $ind]
  848.         while {[regexp "^$nextIndString" [getText $pos [nextLineStart $pos]] junk]} {
  849.             set pos [nextLineStart $pos]
  850.         }
  851.         setWinInfo read-only 0
  852.         deleteText $start $pos
  853.         setWinInfo dirty 0
  854.         setWinInfo read-only 1
  855.     }
  856.     select $curLineStart $curLineEnd
  857. }
  858.  
  859. proc odbBrowseEditObj {} {
  860.     set curPos [getPos]
  861.     set curLineStart [lineStart $curPos]
  862.     set curLineEnd [nextLineStart $curPos]
  863.     
  864.     if {[regexp {^.+∞(.+)∞} [getText $curLineStart $curLineEnd] junk addr]} {
  865.         frontierDoAlphaScript "Alpha.editCell(@$addr)"
  866.     }
  867. }
  868.  
  869. proc odbBrowse {{addr root}} {
  870.     if {$addr == ""} {
  871.         return
  872.     }
  873.     
  874.     global odbBrowserTypeOffset
  875.     global odbBrowserTabLength
  876.     
  877.     set cell [frontierDoAlphaScript "Alpha.getCellData(@$addr, false)"]
  878.     set wtitle [lindex [lindex $cell 0] 2]
  879.     regsub -all {[][]} $wtitle "" wtitle
  880.     set wtitle "* Frontier “$wtitle” *"
  881.     
  882.     if {[lsearch [winNames] $wtitle] >= 0} {
  883.         bringToFront $wtitle
  884.     } else {
  885.         new -n $wtitle -g 4 42 449 300 -m Odb
  886.         setWinInfo dirty 0
  887.         odbBrowserAddCells 0 $cell 0
  888.         select 0 [nextLineStart 0]
  889.         odbBrowseRight
  890.     }
  891. }
  892.  
  893. bind '\r'        odbBrowseEditObj    Odb
  894. bind enter        odbBrowseEditObj    Odb
  895.  
  896. bind down         odbBrowseDown        Odb
  897. bind down <c>    odbBrowseCmdDown    Odb
  898. bind down <co>    {odbBrowseCmdDown 1}    Odb
  899. bind up            odbBrowseUp            Odb
  900. bind up <c>        odbBrowseCmdUp        Odb
  901. bind up <co>    {odbBrowseCmdUp 1}        Odb
  902. bind right        odbBrowseRight        Odb
  903. bind left        odbBrowseLeft        Odb
  904.  
  905. if {![info exists frontierVersion] || $frontierVersion != 2.12} {
  906.     dialog -w 400 -h 180 -t "Welcome to Frontier menu 2.1.5" 70 10 390 30 \
  907.       -t "Make sure you install all the scripts in the folder 'Frontier verbs' into Frontier.\r\
  908.       If you upgrade from a previous version make sure you install the Frontier verbs which have been updated.\r\
  909.       You find information in the file 'Frontier Help'." 10 50 390 135 \
  910.       -b OK 20 150 85 170
  911.     catch {edit -r -c "$HOME:Help:Frontier Help"}
  912.     addDef frontierVersion 2.12
  913.     set frontierHasWarned 1
  914. }
  915.  
  916.  
  917. catch {frontierBuildScriptMenu}
  918. catch {unset frontierHasWarned}
  919.