home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / help.tcl < prev    next >
Encoding:
Text File  |  2001-01-06  |  32.0 KB  |  895 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "help.tcl"
  6.  #                                    created: 07/21/2000 {18:31:50 PM} 
  7.  #                                last update: 01/06/2001 {10:32:07 AM} 
  8.  #                                
  9.  # The last 4 procs in this file are copyright (c) Pete Keleher
  10.  # ###################################################################
  11.  ##
  12.  
  13. namespace eval help {}
  14.  
  15. # Some Help files are available in multiple formats, such as html, pdf,
  16. # etc.  This preference sets a default format to open, if available.
  17. newPref var helpMenuOptions 0 global ""         \
  18.   [list "Always offer options"                  \
  19.   "Open html if available, then pdf"            \
  20.   "Open pdf if available, then html"            \
  21.   ] index
  22.  
  23. lunion varPrefs(WWW) helpMenuOptions  
  24.  
  25. ## 
  26.  # -------------------------------------------------------------------------
  27.  # 
  28.  # "alphaHelp" --
  29.  # 
  30.  #  Called from about box
  31.  # -------------------------------------------------------------------------
  32.  ##
  33.  
  34. proc alphaHelp {} {
  35.     global HOME alpha::platform
  36.     
  37.     set files [list "Alpha Manual" "Quick Start" "Readme"]
  38.     foreach f $files {
  39.         if {[file exists [file join $HOME Help $f]]} {
  40.             helpMenu $f
  41.             return
  42.         }
  43.     }
  44.     # No help files present ...
  45.     if {${alpha::platform} == "alpha"} {
  46.         url::execute "http://www.alpha.olm.net/"
  47.     } else {
  48.         url::execute "http://www.santafe.edu/~vince/Alphatk.html"
  49.     } 
  50. }
  51.  
  52. proc register {} {
  53.     global HOME alpha::platform
  54.     
  55.     if {${alpha::platform} == "alpha"} {
  56.        if {[file exists [file join $HOME Register]]} {
  57.             launch -f [file join $HOME Register]
  58.         } else {
  59.             url::execute "http://www.alpha.olm.net/"
  60.         } 
  61.     } else {
  62.         alpha::finalStartup
  63.     }
  64. }
  65.  
  66. # ◊◊◊◊ Help Menu procedures ◊◊◊◊ #
  67.  
  68. namespace eval help {}
  69.  
  70. ## 
  71.  # -------------------------------------------------------------------------
  72.  # 
  73.  # "help::buildMenu" --
  74.  # 
  75.  # Note: All file extensions are removed from files in the Help folder when
  76.  # building the Help menu, and no duplicates are inserted.  If there are
  77.  # two similarly named files with different extensions, the user can be
  78.  # presented with a list pick dialog (in the proc: helpMenu below).
  79.  # 
  80.  # Subdirectories --
  81.  # 
  82.  # If tcl version is less than 8.0, subdirectories are simply added as menu
  83.  # items.  Selecting the item will present the user with a list-pick dialog
  84.  # with the directory's contents, unless there is a .tcl file to be
  85.  # evalutated first.  
  86.  # 
  87.  # 8.0 and greater, subdirectories are added as submenus, unless there is a
  88.  # .tcl file present.   In this case only the subdirectory's name is added
  89.  # to the menu, and selecting it evaluates the .tcl file.
  90.  # -------------------------------------------------------------------------
  91.  ##
  92.  
  93. proc help::buildMenu {} {
  94.     global HOME alpha::platform
  95.     
  96.     if {![catch {glob -dir [file join $HOME Help] *} helpFiles]} {
  97.         foreach f $helpFiles {
  98.             lappend files [file rootname [file tail $f]]
  99.         } 
  100.     } else {
  101.         addHelpMenu "No Help files found"
  102.         return
  103.     }
  104.     if {${alpha::platform} == "alpha"} {
  105.     lappend men "Alpha Home Page"
  106.     } else {
  107.     lappend men "Alphatk Home Page"
  108.     }
  109.     
  110.     # We automatically remove any which aren't actually there.
  111.     lappend men \
  112.       "Alpha's www FAQ" \
  113.       "(-" \
  114.       "Readme" "Readme Alphatk" "Quick Start" "Alpha Manual" "Packages" \
  115.       "Mode Examples Help" "Bug Reports and Debugging" \
  116.       "(-" \
  117.       "Filesets Help" "FTP menu Help" "HTML Help" "LaTeX Help" \
  118.       "(-" \
  119.       "Extending Alpha" "Alpha Developers FAQ" "Alpha Commands" "Tcl Commands" \
  120.       "Error Help" "AEGizmos" "TclAE Help" "Help Files Help" \
  121.       "(-"
  122.     
  123.     if {${alpha::platform} == "alpha"} {
  124.     lappend men "Changes - Alpha"
  125.     } else {
  126.     lappend men "Changes - Alphatk"
  127.     }
  128.     
  129.     lappend men "Changes - AlphaTcl" "(-"
  130.     
  131.     # In this list, and for the remaining files in the Help folder, even if
  132.     # there are multiple formats included the filename root is only added
  133.     # once.  If there are no files, we don't include them.
  134.     foreach f $men {
  135.         if {$f != "(-" && [lsearch $files $f] < 0} {
  136.             set men [lremove $men $f]
  137.         }
  138.     }
  139.     # Add the remaining filename root-tails.
  140.     foreach f [lsort $files] {
  141.         if {[lsearch $men $f] < 0} {
  142.             lappend men $f
  143.         }
  144.     }
  145.     regsub -all {\(-[ \t\r\n]+\(-} $men {\(-} men
  146.     foreach f $men {
  147.         if {[info tclversion] >= 8.0 && \
  148.           [file isdirectory [file join $HOME Help $f]] && \
  149.           ![file exists [file join $HOME Help ${f}.tcl]]} {
  150.             # We only add sub-menus for tclversion 8.0 if a given
  151.             # subdirectory doesn't have an associated .tcl file.
  152.             set subfiles ""
  153.             foreach sub [glob -nocomplain -dir [file join $HOME Help $f] *] {
  154.                 lappend subfiles [file root [file tail $sub]]
  155.             }
  156.             addHelpMenu [list Menu -n $f $subfiles]
  157.         } else {
  158.             addHelpMenu $f
  159.         }
  160.     }
  161. }
  162.  
  163. proc help::MenuProc {menu item} {
  164.     menu::generalProc help $item
  165. }
  166.  
  167. proc helpMenu {args} {
  168.     uplevel 1 help::openFile $args
  169. }
  170.  
  171. ## 
  172.  # -------------------------------------------------------------------------
  173.  # 
  174.  # "help::openFile" --
  175.  # 
  176.  # Given the name delivered by the Help menu, find all files which contain
  177.  # it (including the name itself, and any variations with file extensions). 
  178.  # If there are multiple files, or if the item selected is actually a
  179.  # directory containing other files, offer the list to the user.
  180.  # 
  181.  # Thus there can be multiple versions of "LaTeX Help" (for example), such
  182.  # as "LaTeX Help", "LaTeX Help.html", "LaTeX Help.pdf", "LaTeX Help",
  183.  # which will be dealt with by help::openDirect. 
  184.  # 
  185.  # If there is a "<something> Help.tcl" file, as in "LaTeX Help.tcl", then
  186.  # that file is sourced immediately.  It's up to the script to decide if
  187.  # more options will be presented. 
  188.  # -------------------------------------------------------------------------
  189.  ##
  190.  
  191. proc help::openFile {args} {
  192.     global HOME alpha::platform helpMenuOptions
  193.     
  194.     # Set the filename delivered by the Help menu.
  195.     set filename [eval [list file join $HOME Help] $args]
  196.     if {[file exists ${filename}.tcl]} {
  197.         # There's a .tcl script to evaluate.  It is up to the script to
  198.         # decide if more options will be presented.
  199.         help::openDirect ${filename}.tcl
  200.         return
  201.     } elseif {[file tail $filename] == "No Help files found"} {
  202.         # The list was built without any files.
  203.         if {[askyesno "No help files were found -- perhaps you need to \
  204.           re-install them. Would you like to open Alpha's home page?"] != "no"} {
  205.             if {${alpha::platform} == "alpha"} {
  206.                 url::execute "http://www.alpha.olm.net/"
  207.             } else {
  208.                 url::execute "http://www.santafe.edu/~vince/Alphatk.html"            } 
  209.         } else {
  210.             error "No Help files found in the top level of Alpha's hierarchy."
  211.         }
  212.     } 
  213.     # Find out what file options we have.
  214.     set fileDir  [file dirname $filename]
  215.     if {[file isdirectory $filename]} {
  216.         # This item is actually a subdirectory.
  217.         set fileDir $filename
  218.         set files [glob -nocomplain -dir $filename *]
  219.     } elseif {[catch {glob -path "${filename}." *} files]} {
  220.         # There are no files with this name plus an extension.
  221.         set files ""
  222.     } 
  223.     if {(![llength $files] || !$helpMenuOptions) && [file isfile $filename]} {
  224.         # The filename exists without an extension, so we add that too.
  225.         lappend files $filename
  226.     } 
  227.     if {![llength $files]} {
  228.         # "filename" shouldn't have even been in the menu ...
  229.         message "Sorry, no \"$filename\" files were found."
  230.         error "No \"$filename\" files were found."
  231.     }
  232.     # Now that the list of potential files has been set, check some of the
  233.     # "help menu" preferences to see if we have some default action, or if
  234.     # we should adjust the list.
  235.     if {$helpMenuOptions == 1} {
  236.         # User would prefer a pdf file, then a html file.
  237.         if {[file exists ${filename}.pdf]} {
  238.             set helpFile ${filename}.pdf
  239.         } elseif {[file exists ${filename}.html]} {
  240.             set helpFile ${filename}.html
  241.         }
  242.     } elseif {$helpMenuOptions == 2} {
  243.         # User would prefer a html file, then a pdf file.
  244.         if {[file exists ${filename}.html]} {
  245.             set helpFile ${filename}.html
  246.         } elseif {[file exists ${filename}.pdf]} {
  247.             set helpFile ${filename}.pdf
  248.         }
  249.     } 
  250.     if {![info exists helpFile]} {
  251.         # No file has been set yet.
  252.         if {[llength $files] == 1} {
  253.             # Only one file found.
  254.             set helpFile [lindex $files 0]
  255.         } else {
  256.             # There is more than one file, with different extensions.
  257.             foreach f $files {
  258.                 lappend fileTails [file tail $f]
  259.             }
  260.             lappend fileTails "(Set WWW preferences to avoid this dialog …)"
  261.             set helpFile [listpick -p "\"[file tail $filename]\"  options : " $fileTails]
  262.             if {$helpFile == "(Set WWW preferences to avoid this dialog …)"} {
  263.                 dialog::preferences preferences "WWW"
  264.                 helpMenu $args
  265.                 return
  266.             } 
  267.             set helpFile [file join $fileDir $helpFile]
  268.             # In case $helpFile is itself a directory ...  This will also
  269.             # help make sure that the help menu item can work even if a
  270.             # .tcl file has been deleted.
  271.             while {[file isdirectory $helpFile]} {
  272.                 set files [glob -nocomplain -dir $helpFile *]
  273.                 set fileTails ""
  274.                 foreach f $files {
  275.                     lappend fileTails [file tail $f]
  276.                 }
  277.                 set fileDir $helpFile
  278.                 set helpFile [listpick -p \
  279.                   "\"[file tail $helpFile]\"  options :" \
  280.                   [lsort $fileTails]]
  281.                 set helpFile [file join $fileDir $helpFile]
  282.             }
  283.         }
  284.     }
  285.     help::openDirect $helpFile
  286. }
  287.  
  288. ## 
  289.  # ----------------------------------------------------------------------
  290.  #       
  291.  # "help::mimicHelpMenu" --
  292.  #      
  293.  # This proc can be used in the Alpha Developer Menu's "Help File Marking"
  294.  # menu, or called by other code.  Assume that this is for the current
  295.  # open window unless called from a shell prompt.
  296.  #      
  297.  # "help::mimicHelpMenu -choose" will offer a list-pick dialog to select
  298.  # files for pre-marking.
  299.  # 
  300.  # "help::mimicHelpMenu -all" will pre-mark all Help files, useful for
  301.  # public releases of Alpha (not Alphatk).
  302.  # 
  303.  # Both options will only select valid (i.e. Text mode) files in the top
  304.  # level of the Help folder. 
  305.  # ----------------------------------------------------------------------
  306.  ##
  307.  
  308. proc help::mimicHelpMenu {{files ""}} {
  309.     
  310.     global HOME alpha::platform
  311.     
  312.     set fileList ""
  313.     # Should we select of list of files to mark/hyper ...
  314.     if {$files == "-choose" || $files == "-all"} {
  315.         # Create the list of all valid help files (those in Text mode).
  316.         message "Creating the list of valid Help files for marking/hyperizing …"
  317.         foreach f [glob -dir [file join $HOME Help] *] {
  318.             if {[file isfile $f] && [win::FindMode $f] == "Text"} {
  319.                 lappend helpFiles $f
  320.             } 
  321.         } 
  322.         if {$files == "-choose"} {
  323.             # Offer a list-pick of Help files to mark/hyper.
  324.             foreach f $helpFiles {
  325.                 if {[file isfile $f] && [win::FindMode $f] == "Text"} {
  326.                     lappend helpFileTails [file tail $f]
  327.                 } 
  328.             }
  329.             set helpTailsList [listpick -l \
  330.               -p "Choose some Help files to pre-mark" $helpFileTails]
  331.             foreach f $helpTailsList {
  332.                 lappend fileList [file join $HOME Help $f]
  333.             } 
  334.         } elseif {${alpha::platform} != "alpha"} {
  335.             alertnote "Pre-marking/hyperizing help files is only useful\
  336.               for the Macintosh platform."
  337.             error "\"help::mimicHelpMenu -all\" is only useful on the Macintosh."
  338.         } else {
  339.             # Select all valid help files to mark.
  340.             set fileList $helpFiles
  341.         } 
  342.     }
  343.     # ...  or given a single file argument "f", which is surrounded either
  344.     # by quotes or brackets, assume that the file is in the Help folder
  345.     # unless the entire path is given ...
  346.     if {$files != "" && $fileList == ""} {
  347.         set f1 [list $files]
  348.         set f2 [file join $HOME Help $files]
  349.         if {[file isfile $f1]} {
  350.             lappend fileList $f1
  351.         } elseif {[file isfile $f2]} {
  352.             lappend fileList $f2
  353.         } 
  354.     } 
  355.     # ...  or given no arguments, use the current window.
  356.     if {$files == ""} {
  357.         set fileList [list [win::Current]]
  358.     }
  359.     # Do we have any files to mark/hyper?
  360.     if {![llength $fileList]} {
  361.         message "No valid files were selected."
  362.         error "No valid files were selected."
  363.     } 
  364.     # Now we actually mark/hyper the file.
  365.     foreach f $fileList {
  366.         # We already know that all files in "f2" exist, are complete paths.
  367.         help::removeCHMCleanly $f
  368.         help::openDirect [win::Current]
  369.         setWinInfo dirty 0
  370.         setWinInfo read-only 0
  371.         if {$files == "-all"} {
  372.             # If only marking files for public release, close them.
  373.             shrinkFull
  374.             menu::fileProc "File" "close"
  375.         }
  376.     }
  377. }
  378.  
  379. proc help::preMarkAllHelpFiles {} {
  380.     if {[askyesno "Do you really want to mark and hyper all help files?\
  381.       This could take a little while …"] != "no"} {
  382.         help::mimicHelpMenu -all
  383.     } 
  384. }
  385.  
  386. # ◊◊◊◊ Open File procedures ◊◊◊◊ #
  387.  
  388. ## 
  389.  # -------------------------------------------------------------------------
  390.  # 
  391.  # "help::openDirect" --
  392.  # 
  393.  #  Called from the Help menu to evaluate (.tcl), send (.html), or just
  394.  #  open/mark/hyper (no extension) a file .  Other formats opened by OS.
  395.  #  ------------------------------------------------------------------------
  396.  ##
  397.  
  398. proc help::openDirect {filename} {
  399.     if {![file exists $filename]} {
  400.         global HOME
  401.         set filename [file join $HOME Help $filename]
  402.     }
  403.     if {[file isfile $filename]} {
  404.         switch -- [file extension $filename] {
  405.             ".tcl" {
  406.                 uplevel \#0 [list source $filename]
  407.             }
  408.             ".html" {
  409.         htmlView $filename
  410.             }
  411.             "" {
  412.                 edit -r -c -tabsize 4 $filename
  413.                 global mode
  414.                 if {$mode == "Chng"} {
  415.                     Chng::MarkFile
  416.                     help::hyperiseUrls
  417.                 }
  418.                 if {$mode == "Text" && ![llength [getColors]]} {
  419.                     catch {
  420.                         message "Please wait: Colouring and marking the help file"
  421.                         help::hyperiseEmailAddresses
  422.                         help::hyperiseUrls
  423.                         set commandFiles [list \
  424.                           "Diff Help" "Error Help" "Perl Commands" \
  425.                           "Regular Expressions" "Tcl Commands" \
  426.                           ]
  427.                         set f [win::CurrentTail]
  428.                         if {$f == "Alpha Commands"} {
  429.                             help::markAlphaCommands
  430.                         } elseif {[lsearch $commandFiles $f] != "-1"} {
  431.                             help::markTclCommands
  432.                         } else {
  433.                             help::colourHeadingsEtc
  434.                         }
  435.                         message ""
  436.                         file::saveResourceChanges $filename
  437.                     }
  438.                 }
  439.             }
  440.             default {
  441.                 file::openInDefault $filename
  442.             }
  443.         }
  444.     } else {
  445.         file::openAny $filename
  446.     }
  447. }
  448.  
  449. ## 
  450.  # -------------------------------------------------------------------------
  451.  # 
  452.  # "help::openGeneral" --
  453.  # 
  454.  #  Called by embedded hyperlinks; look first for "package" help, and
  455.  #  otherwise try to open the named help file (as if from Help menu.)
  456.  #  ------------------------------------------------------------------------
  457.  ##
  458. proc help::openGeneral {name} {
  459.     global HOME
  460.     regsub -nocase { Help} $name {} package
  461.     if {[catch {package::helpFile $package}]} {
  462.     help::openFile $name
  463.     }
  464. }
  465.  
  466. ## 
  467.  # -------------------------------------------------------------------------
  468.  # 
  469.  # "help::openExample" --
  470.  # 
  471.  # Called by embedded hyperlinks. 
  472.  # 
  473.  # Example files must be of the form "<something>-Example.sfx", with the
  474.  # suffix optional.  If the hyperlink looks like "<something> Example.sfx",
  475.  # it will open in a shell window, and inserts some explanatory text at the
  476.  # beginning.  If there is a completions tutorial available for the mode,
  477.  # that will be noted as well.
  478.  # 
  479.  # Exceptions (which are evaluated first):
  480.  # 
  481.  # -- Hyperlinks such as "<something>-Example.sfx" (the actual file name,
  482.  # with the dash) open the actual example file, read-only.
  483.  #  
  484.  # -- If a package includes not only an example file, but wants to do
  485.  # something special with it, then it should install two different files,
  486.  # both a "<something>-Example.sfx" AND a "<something>-Example.sfx.tcl"
  487.  # file, and make the hyperlink with "<something> Example.sfx" .
  488.  # 
  489.  # The presence of a "<something>-Example.sfx.tcl" file creates a special
  490.  # case.  The hyperlink "Calculator Example", for example, evaluates the
  491.  # file "Calculator-Example.tcl", which will then open a calculator window,
  492.  # etc.  ("Tcl Example.tcl" will simply open as an example without being
  493.  # sourced, because there is no "Tcl-Example.tcl.tcl" file.)
  494.  # 
  495.  # ------------------------------------------------------------------------
  496.  ##
  497.  
  498. proc help::openExample {name} {
  499.     global HOME
  500.     
  501.     regsub -all { } $name {-} name2
  502.     set f  [file join $HOME "Mode Examples" $name]
  503.     set f2 [file join $HOME "Mode Examples" $name2]
  504.     
  505.     if {$name == $name2 && [file exists $f]} {
  506.         # Open as a read-only file
  507.     edit -r -c $f
  508.         return
  509.     } elseif {[file exists ${f2}.tcl]} {
  510.         # A special case -- evaluate the ${f2}.tcl file.
  511.         uplevel \#0 [list source ${f2}.tcl]
  512.         return
  513.     } elseif {[file exists ${f}.tcl]} {
  514.         # We'll also check to see if the file was erroneously named without 
  515.         # the dash, as in "<something> example.tcl" .
  516.         uplevel \#0 [list source ${f}.tcl]
  517.         return
  518.     } elseif {![file exists $f2]} {
  519.         # Special cases done, but the file defined by "f" doesn't exist.
  520.         beep
  521.         message "Sorry, \"$name2\" is not in the Mode Examples folder"
  522.         return
  523.     }
  524.     # File exists, and it's not a special case, so open it in a shell window.
  525.     set m [win::FindMode $f2]
  526.     # Does Alpha know what mode this is?  If not, send an alertnote.
  527.     if {$m == "Text"} {
  528.         alertnote "Alpha doesn't recognize the mode for this example,\
  529.           and will open it in as plain text."    
  530.     }
  531.     new -n "* $m Mode Example *" -m $m -text [file::readAll $f2] -shell 1
  532.     goto [minPos]
  533.     set    t "\r  $m mode example  --  Modify as much as you like ! \r\r"
  534.     append t "  None of the changes you make will affect the actual file.  If you close \r"
  535.     append t "  the window and then click on the hyperlink again, you will start with the \r"
  536.     append t "  same example as before.  This also means that you cannot send this window \r"
  537.     append t "  to other applications -- technically, it doesn't exist as a file. \r\r"
  538.     append t "  Type \"control-Help\" to open any available help for $m mode. \r\r"
  539.     # Find out if there's a tutorial available for this mode.
  540.     set f3 [file join ${HOME} Tcl Completions "[modeALike] Tutorial"]
  541.     if {[llength [glob -nocomplain -path $f3 *]] == 1} {
  542.         append t "  $m mode also has a Completions Tutorial in the Config --> Mode Prefs menu.\r\r"
  543.     }
  544.     insertText  $t
  545.     goto [minPos]
  546.     if {$m == "Text"} {
  547.         help::hyperiseEmailAddresses
  548.         help::hyperiseUrls
  549.     }
  550.     # Now try to mark the file.
  551.     markFile
  552. }
  553.  
  554. ## 
  555.  # -------------------------------------------------------------------------
  556.  # 
  557.  # "help::openHyper" --
  558.  # 
  559.  #  Called by embedded hyperlinks; we look through an installation
  560.  #  directory (and subdirs) if it is known, then the prefs directory, then
  561.  #  all of the auto_path.  If it is a tutorial shell, find the proper mode
  562.  #  and open it in a shell window.  Otherwise, if the file is of type TEXT
  563.  #  we open it as read-only, else we ask the finder to open it. 
  564.  #  -------------------------------------------------------------------------
  565.  ##
  566.  
  567. proc help::openHyper {name} {
  568.     global PREFS tclExtensionsFolder auto_path file::separator
  569.     set currD [list [file dirname [win::Current]]]
  570.     set dirs [glob -types d -dir $currD -nocomplain -- *]
  571.     foreach d $dirs {
  572.         lappend currD [string trimright $d ${file::separator}]
  573.     }
  574.     lappend currD $PREFS 
  575.     if {[info exists tclExtensionsFolder]} {lappend currD $tclExtensionsFolder}
  576.     foreach d [concat $currD $auto_path] {
  577.         if {[regsub -nocase {Prefs.tcl} $name {} m]} {
  578.             if {$m != ""} {
  579.                 # Edit a <mode>Prefs.tcl file, prompting to create if necessary.
  580.                 mode::editPrefsFile $m
  581.             } else {
  582.                 # Edit a prefs.tcl file, creating one if necessary.
  583.                 prefs::tclEdit
  584.             }
  585.             return
  586.         }
  587.         set f [file join $d $name]
  588.         if {[file exists $f]} {
  589.             if {[regexp {Tutorial} $name]} {
  590.                 # This is a tutorial, so open it in a shell window
  591.                 mode::completionsTutorial [win::FindMode $f]
  592.             } elseif {[getFileType $f] == {TEXT}} {
  593.                 # Type is Text, so open as read-only
  594.                 edit -r -c $f
  595.             } else {
  596.                 # Unknown type, so prompt user
  597.                 file::openAny $f 
  598.             }
  599.             return
  600.         }
  601.     }
  602.     beep
  603.     message "Sorry, couldn't find $name"
  604. }
  605.  
  606. # ◊◊◊◊ File Marking / Hyperizing ◊◊◊◊ #
  607.  
  608. ## 
  609.  # ----------------------------------------------------------------------
  610.  #       
  611.  #  "help::hyperiseUrls" --
  612.  #  "help::hyperiseEmailAddresses" --
  613.  #      
  614.  #  This attaches hypertext links to all '<http:...  >' or '<mailto...>'
  615.  #  strings in a document.  This procedure works best on files in Text
  616.  #  mode; in other modes the colouring schemes can make the links invisible
  617.  #  (although they still function).
  618.  #      
  619.  # ----------------------------------------------------------------------
  620.  ##
  621.  
  622. proc help::hyperiseUrls {} {
  623.     win::searchAndHyperise {<((http|news|mailto|ftp):[^ ]*)>} {url::execute "\1"} 1
  624. }
  625.  
  626. proc help::hyperiseEmailAddresses {} {
  627.     win::searchAndHyperise \
  628.       {<([-_a-zA-Z0-9.]+@([-_a-zA-Z0-9.]+))>} \
  629.       {url::execute "mailto:\1"} 1
  630. }
  631.  
  632. # Note: some regexps in this proc are full of extra (()|()) stuff which can
  633. # be removed.
  634. proc help::colourHeadingsEtc {{markFile 1}} {
  635.     
  636.     if {$markFile} {
  637.         catch {help::markAlphaManual}
  638.         catch {help::colorManualMarks}
  639.     } 
  640.     # Search for "<something>.tcl" and attach appropriate lookup.
  641.     # Search for "<something >Tutorial<.sfx>" and attach appropriate lookup.
  642.     win::searchAndHyperise {"([-a-zA-Z_+1-9 ]*\.tcl|Text Tutorial|[-a-zA-Z0-9_+ ]+Tutorial(([.a-zA-Z0-9_ ]+[.a-zA-Z0-9_])?.\w+))"} \
  643.       {help::openHyper "\1"} 1 3 +1 -1
  644.     # Search for "package: <something>" and attach appropriate lookup.
  645.     win::searchAndHyperise {package: ([-a-zA-Z0-9+]*[-a-zA-Z0-9+])} \
  646.       {help::openGeneral "\1"} 1 4 +9
  647.     # search for "<something>Example" and attach appropriate lookup.
  648.     win::searchAndHyperise {"([-a-zA-Z_+0-9 ]*Example(\.[a-zA-Z0-9_]+)?)"} \
  649.       {help::openExample "\1"}  1 3 +1 -1
  650.     # Search for "<<something>>" and embed as hypertext.
  651.     # (Can only handle ] at end of string, not within ...)
  652.     win::searchAndHyperise {<<([^>\r\n]+)>>} {\1} 1 4 +2 -2
  653.     # Search for "proc: <something>" and attach appropriate lookup.
  654.     win::searchAndHyperise {proc: ([-a-zA-Z:\+\.\_]+\w+)} \
  655.       {Tcl::DblClickHelper "\1" ; setWinInfo read-only 1} 1 4 +6 
  656.     # Search for "command: <something>" and attach appropriate lookup.
  657.     win::searchAndHyperise {command: ([-\w+:\+\.\_]+(\w+))} \
  658.       {Tcl::DblClickHelper "\1" ; setWinInfo read-only 1} 1 4 +9 
  659.  
  660.     # Help file hyperlinks -- 
  661.     # Don't make these lists too long, or there will be memory corruption.
  662.     # search for "<something>Help" etc and attach appropriate lookup.
  663.     win::searchAndHyperise {\"([-a-zA-Z_0-9+ ]+(Help|Commands))\"} \
  664.       {help::openGeneral "\1"}  1 3 +1 -1
  665.     # search for specific Help files and attach appropriate lookup.
  666.     win::searchAndHyperise {\"(Alpha Manual|Readme|Extending Alpha|Quick Start|Bug Reports and Debugging)\"} \
  667.       {help::openGeneral "\1"}  1 3 +1 -1
  668.     win::searchAndHyperise {\"(Changes|Changes - Alpha|Changes - AlphaTcl|Changes - Alphatk|Alpha Developers FAQ)\"} \
  669.       {help::openGeneral "\1"}  1 3 +1 -1
  670.     # search for more specific Help files and attach appropriate lookup.
  671.     # Note -- the more win::searchAndHyperise, the slower the marking.
  672.     # Changing Help file filenames to "<something> Help" is a better solution.
  673.     win::searchAndHyperise {"(Default Key Bindings|Internet Config|Packages|Regular Expressions)"} \
  674.       {help::openGeneral "\1"}  1 3 +1 -1
  675.     win::searchAndHyperise {"(AEGizmos|CodeWarrior|MacPerl Specifics|Registering|Shells)"} \
  676.       {help::openGeneral "\1"}  1 3 +1 -1
  677.     win::searchAndHyperise {\"(Symantec|Tcl Resources)\"} \
  678.       {help::openGeneral "\1"}  1 3 +1 -1
  679.     # etc.  More could be added.
  680.     
  681.     # Highlight IMPORTANT bits
  682.     win::searchAndHyperise {IMPORTANT:} {} 0 5
  683.     # Highlight "<something>-><something>" menu directions
  684.     win::searchAndHyperise {"([-a-zA-Z_ ]+-> ?)+[a-zA-Z_ ]+(…|...)?"} {} 1 5 +1 -1
  685.     # Highlight '<something>-><something>' menu directions
  686.     win::searchAndHyperise {'([-a-zA-Z_ ]+-> ?)+[a-zA-Z_ ]+(…|...)?'} \
  687.       {} 1 5 +1 -1
  688.     # make code inserts blue
  689.     set bluestr {^[ \t]*[\r\n]\t[^•" \t\r\n][^\n\r]*[\r\n](\t([ \t]*[\r\n]|[ \t]*[^ \t\r\n]+[^\n\r]*[\r\n]))*[ \t]*[\r\n]}
  690.     win::searchAndHyperise $bluestr {} 1 1
  691.     win::searchAndHyperise {CLICK[ A-Z]* INSTALL} "install::installThisPackage" 1 3    
  692.     if {![catch {set inds [search -f 1 -r 1 {Jump to recent changes} [minPos]]}]} {
  693.         set from [lindex $inds 0]
  694.         set to [lindex $inds 1]
  695.         text::color $from $to 3
  696.         text::hyper $from $to {gotoMark " Recent Changes:"}
  697.     }
  698.     goto [minPos]
  699. }
  700.  
  701. ## 
  702.  # ----------------------------------------------------------------------
  703.  #       
  704.  # "help::removeAllColoursAndHypers" --
  705.  # "help::removeCHMCleanly" --
  706.  #      
  707.  # Remove all colors and hypers from the current window.  Removing them
  708.  # "cleanly" also removes marks, but will not change the last save date
  709.  # contained in the resource fork.  "help::removeCHMCleanly" is also used
  710.  # by "help::mimicHelpMenu". 
  711.  # ----------------------------------------------------------------------
  712.  ##
  713.  
  714. proc help::removeAllColoursAndHypers {} {
  715.     # get rid of the old stuff
  716.     catch { removeColorEscapes }
  717.     refresh
  718. }
  719.  
  720. proc help::removeCHMCleanly {{filePath ""}} {
  721.  
  722.     global HOME win::Active
  723.  
  724.     # This proc can be used for open windows, or called by other code.
  725.     if {$filePath != ""} {
  726.         file::openQuietly $filePath
  727.     } elseif {[llength [set win::Active]] < 1} {
  728.         findFile [file join $HOME Help ""] 
  729.     } 
  730.     # Altered windows can not be saved "cleanly"
  731.     if {![catch {getWinInfo arr}] && $arr(dirty)} {
  732.         beep ; message "File must first be saved."
  733.         error "File must first be saved."
  734.     }
  735.     setWinInfo read-only 0
  736.     removeAllMarks
  737.     help::removeAllColoursAndHypers
  738.     setWinInfo dirty 0
  739. }
  740.  
  741. ## 
  742.  # ----------------------------------------------------------------------
  743.  #       
  744.  # "help::markTclCommands" --
  745.  #      
  746.  # An alternative marking scheme for help files which mainly contain lists
  747.  # of commands.  See "Tcl Commands" or "Error Help" for examples. 
  748.  # ----------------------------------------------------------------------
  749.  ##
  750.  
  751. proc help::markTclCommands {} {
  752.     global mode
  753.  
  754.     # Change mode to Tcl to use word break preference,
  755.     # in case the commands use :: .
  756.     set m $mode
  757.     changeMode Tcl
  758.     # Mark the Command file
  759.     removeAllMarks
  760.     set pos [minPos]
  761.     while {![catch {search -f 1 -r 1 -i 0 "^\[\t \]*NAME" $pos} inds]} {
  762.         set pos1     [lindex $inds 0]
  763.         goto         [lindex $inds 1]
  764.         hiliteWord
  765.         text::color  [getPos] [selEnd] 1
  766.         setNamedMark [getSelect] $pos1 $pos1 $pos1
  767.         set pos      [nextLineStart $pos1]
  768.     }
  769.     # Search and color red lines with all CAP words.
  770.     set pos [minPos]
  771.     while {![catch {search -f 1 -r 1 -i 0 {^[A-Z,\t ]+$} $pos} inds]} {
  772.         set from    [lindex $inds 0]
  773.         set to      [lindex $inds 1]
  774.         text::color $from $to 5
  775.         set pos     [nextLineStart $from]
  776.     }
  777.     # Color, underline the title (first alphanumeric line in file), and
  778.     # then color / hyper any extras using help::colourHeadingsEtc.
  779.     goto [minPos]
  780.     hiliteWord
  781.     endLineSelect
  782.     text::color [getPos] [selEnd] 5
  783.     text::color [getPos] [selEnd] 15
  784.     help::colourHeadingsEtc 0
  785.     # Change mode back to original
  786.     changeMode $m
  787. }
  788.  
  789. # This proc is obsolete I think - Vince.
  790. proc help::markReadme {} {
  791.     removeAllMarks
  792.     help::removeAllColoursAndHypers
  793.     win::multiSearchAndHyperise "Home Page" \
  794.       {url::execute http://alpha.olm.net/} \
  795.       "Quick Start" {edit -r [file join ${HOME} Help "Quick Start"]} \
  796.       "Bug Reports And Debugging" \
  797.       {edit -r [file join ${HOME} Help "Bug Reports And Debugging"]} \
  798.       "Manual" {edit -r [file join ${HOME} Help "Alpha Manual"]} \
  799.       "Click here to update Alpha's list of remote packages via the internet" \
  800.       {package::queryWebForList} \
  801.       "Config->Preferences->International" \
  802.       {dialog::preferences Preferences International}
  803.     
  804.     win::searchAndHyperise "[\r\n]Help" {alphaHelp} 1 3 1
  805.     win::searchAndHyperise "'Changes'" {edit -r [file join ${HOME} Help "Changes - Alpha"]} 0 3 1 -1
  806.     win::searchAndHyperise {<get ([^>]+)>} {remote::get \1} 1
  807.     win::searchAndHyperise {[\w ']+ \-\-\-} { } 1 5 0 -4
  808.     help::hyperiseUrls
  809.     help::hyperiseEmailAddresses
  810.     
  811. }
  812.  
  813. # ◊◊◊◊ Pete's manual-marking routines ◊◊◊◊ #
  814.  
  815. proc help::markAlphaManual {} {
  816.     set pos [minPos]
  817.     set labels ""
  818.     while {[string length [set inds [search -f 1 -r 1 {^\t  \t} $pos]]]} {
  819.         set pos1 [lindex $inds 1]
  820.         set label [getText $pos1 [pos::math [nextLineStart $pos1] - 1]]
  821.         regsub -all "\t" $label " " label
  822.         set pos2 [lineStart $pos1]
  823.         if {$label == ""} {set label "-"}
  824.         while {[lsearch -exact $labels $label] != -1} { append label " " }
  825.         setNamedMark $label $pos2 $pos2 $pos2
  826.         lappend labels $label
  827.         set pos [nextLineStart $pos1]
  828.     }
  829. }
  830.  
  831. proc help::colorManualMarks {} {
  832.     goto [minPos]
  833.     hiliteWord
  834.     endLineSelect
  835.     set from [getPos]
  836.     set to [selEnd]
  837.     text::color $from $to 5
  838.     text::color $from $to 15
  839.     
  840.     foreach mk [getNamedMarks] {
  841.         set name [lindex $mk 0]
  842.         set disp [lindex $mk 2]
  843.         set pos [lindex $mk 3]
  844.         set end [lindex $mk 4]
  845.         
  846.         goto $disp
  847.         hiliteWord
  848.         endLineSelect
  849.         set from [getPos]
  850.         set to [selEnd]
  851.         text::color $from $to 5
  852.         text::color $from $to 15
  853.     }
  854. }
  855.  
  856. proc help::markAlphaCommands {} {
  857.     global HOME alpha::platform
  858.     if {[set alpha::platform] == "alpha"} {
  859.         setWinInfo read-only 0
  860.     }
  861.     help::removeAllColoursAndHypers
  862.     removeAllMarks
  863.     changeMode Tcl
  864.     set pos [minPos]
  865.     while {![catch {search -f 1 -r 1 {^• } $pos} inds]} {
  866.         set pos1 [lindex $inds 1]
  867.         goto $pos1
  868.         hiliteWord
  869.         set label [getSelect]
  870.         set from [getPos]
  871.         set to [selEnd]
  872.         setNamedMark $label $pos1 $from $to
  873.         text::color $from $to 1
  874.         set pos [nextLineStart $pos1]
  875.     }
  876.     select [minPos] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  877.     redWord
  878.     changeMode Text
  879.     goto [minPos]
  880.     if {[set alpha::platform] == "alpha"} {
  881.         save
  882.     }
  883. }
  884.  
  885. proc help::markAlphaChanges {} {
  886.     set pos [minPos]
  887.     while {[string length [set inds [search -f 1 -r 1 {^= } $pos]]]} {
  888.         set pos1 [lindex $inds 1]
  889.         goto $pos1
  890.         endLineSelect
  891.         redWord
  892.         set pos [nextLineStart $pos1]
  893.     }
  894. }
  895.