home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / package / web.mut < prev    next >
Text File  |  1995-01-14  |  8KB  |  377 lines
  1. ;; web.mut : A [very] small hyper-text text browser, documentation reader.
  2. ;; C Durland 5/93 Public Domain
  3.  
  4. (include me.mh)
  5.  
  6. (const
  7.   DOC-ENV-VAR    "ME3DOC"
  8.   ME3-ENV-VAR    "ME3"
  9. )
  10.  
  11. (const
  12.   INDEX-BUFFER        "*web-index*"
  13.   INDEX-FILE-NAME    "web.idx"
  14.   WEB-BUFFER        "*web*"
  15.  
  16.   WEB-MODE-NAME        "web"
  17. )
  18.  
  19. (const        ;; Index tags
  20.   ZIP-TAG        "0"
  21.   DOC-TAG        "1"
  22.   PACKAGE-TAG        "2"
  23.  
  24.   MISC-MUTT-CODE    "7"
  25.   MAN-TAGO        "8"
  26. )
  27.  
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;; Manipulate Text ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. (int web-mode-keymap)
  33.  
  34. (defun
  35.   MAIN
  36.   {
  37.     (web-mode-keymap (create-keymap))
  38.  
  39.     (bind-key web-mode-keymap
  40.     "next-line"            "j"
  41.     "previous-line"            "k"
  42.     "next-character"        "l"
  43.     "previous-character"        "h"
  44.  
  45.     "next-page"            " "
  46.     "previous-page"            "C-h"
  47.  
  48.     "web-doc"            "?"
  49.  
  50.     "web-select-item"        "C-m"
  51.     "web-word"            "t"
  52.  
  53.     "web-backtrack"            "b"
  54.     "web-history"            "p"
  55.     )
  56.  
  57.     ;; Load the index if it hasn't been already
  58.     (save-excursion
  59.       {{
  60.     (if (== -2 (attached-buffer INDEX-BUFFER))
  61.       {
  62.         (if (== "" (find-file INDEX-FILE-NAME))
  63.           {
  64.         (msg "Can't find web index file \"" INDEX-FILE-NAME "\".")
  65.         FALSE
  66.         (done)
  67.           })
  68.         (current-buffer (create-buffer INDEX-BUFFER BFHooHum))
  69.         (file-to-buffer (find-file INDEX-FILE-NAME))
  70.         (buffer-read-only TRUE)
  71.         TRUE
  72.       })
  73.       }})
  74.   }
  75.   web-mode
  76.   {
  77.     (clear-modes)
  78.  
  79.     (install-keymap web-mode-keymap LOCAL-KEYMAP)
  80.     (major-mode WEB-MODE-NAME)
  81.     (minor-mode "? for info")
  82.  
  83.     (buffer-read-only TRUE)
  84.     (if (pgm-exists "web-mode-hook") (floc "web-mode-hook"()))
  85.   }
  86. )
  87.  
  88. (defun
  89.   web-doc
  90.   {
  91.     (menu-box
  92.       ">Web Text Linker"
  93.       "C-m -- Show info on item under cursor."
  94.       "k j h l -- Move up, down, left, right."
  95.       "C-h   -- Page back"
  96.       "Space -- Page forward"
  97.       "p -- View list of previous topics."
  98.       "b -- Back up one topic."
  99.       "t -- Pick a new topic."
  100.       "Other ME cursor motion."
  101.       "C-l to clear this message."
  102.     )
  103. ;(update)    ;;;!!!??? maybe update() needs to force cursor?
  104.   }
  105.   web-select-item
  106.   {
  107.     (if
  108.       (save-point
  109.         {{
  110.       (looking-at '(' TRUE)    ;; move over "(" if dot is sitting on (foo
  111.  
  112.       (if (not (looking-at '\<')) (previous-word))
  113.  
  114.       (or 
  115.         (looking-at '\(\w+.doc\>\)')    ;; foo.doc
  116.         (looking-at '\(\w+.mut\>\)')    ;; foo.mut (a package)
  117.         (looking-at '[^     .,/:)"]+'))
  118.     }})
  119.       (web-word (get-matched '&'))
  120.       (msg "Can't find anything to look up."))
  121.   }
  122.   web-word
  123.   {
  124.     (string word file-name tag)
  125.  
  126.     (word (complete (bit-or CC_PGM CC_MUTT CC_SYSVAR)
  127.     "Info on word (return for the word at the cursor): "))
  128.     (if (== "" word) { (web-select-item)(done) })
  129.  
  130.     (if (not (lookup-item word file-name tag))
  131.       {
  132.     (if (re-string '\w+.mut\>' word)    ;; foo.mut but not a package
  133.       (tag MAN-TAGO)
  134.       {
  135.         (msg "No entry for \"" word "\".")
  136.         (done)
  137.       })
  138.       })
  139.  
  140.     (if (== tag MAN-TAGO)
  141.       (web-manual word)
  142.       (read-item word file-name tag))
  143.  
  144.     (add-to-backtrack-list word)
  145.   }
  146.   web-manual (string manual-file-name)
  147.   {
  148.     (int j)
  149.     (string fname bname)
  150.  
  151.     (if (== "" (fname (find-file manual-file-name)))
  152.       { (msg "Can't find manual: \"" manual-file-name "\".")(done) })
  153.  
  154.     ;; Check to see if the manual is already loaded
  155.     (bname (buffer-name fname))
  156.     (for (j 0) (< j (buffers)) (+= j 1)
  157.       (if { (current-buffer (nth-buffer j))
  158.     (and
  159.       (== bname (buffer-name -1))
  160.       (== WEB-MODE-NAME (major-mode))) }
  161.     {
  162.       (current-buffer -1 TRUE)
  163.       (done)
  164.     }))
  165.  
  166.     (visit-file fname)
  167.     (file-name -1 "")(turn-off-undo)
  168.     (web-mode)
  169.   }
  170. )
  171.  
  172. (defun
  173.   lookup-item (string item file-name tag) HIDDEN
  174.   {
  175.     (bool s)
  176.     (int index cb)
  177.     (string key)
  178.  
  179.     (if (== -2 (index (attached-buffer INDEX-BUFFER)))
  180.       { (msg "web index has vanished!")(halt) })
  181.     
  182.     (cb (current-buffer))
  183.  
  184.     (current-buffer index)
  185.     (beginning-of-buffer)
  186.     (cond
  187.       (search-forward (concat "^J" item "^J"))
  188.     {
  189.       (re-search-reverse '=#=\(.+\)=#=\(.+\)')
  190.       (file-name (get-matched '\1'))
  191.       (tag       (get-matched '\2'))
  192.       (s TRUE)
  193.     }
  194.       (search-forward (concat ' ' item ' '))
  195.     {
  196.       (beginning-of-line)
  197.       (looking-at '.+ \([^ ]+\)')
  198.       (s (lookup-item (item (get-matched '\1')) file-name tag))
  199.     }
  200.       (search-forward (concat '=#=' item "=#="))    ;; want the entire manual
  201.     { (tag MAN-TAGO) (s TRUE) }
  202.  
  203.       {                        ;; Maybe it's a bound key
  204.     (current-buffer cb)
  205.     (!= "" (key (key-bound-to item)))
  206.       }
  207.     (s (lookup-item (item key) file-name tag))
  208.       TRUE (s FALSE))
  209.  
  210.     (current-buffer cb)
  211.     s
  212.   }
  213.   read-item (string item file-name tag) HIDDEN
  214.   {
  215.     (int web-buffer bid bag n error-code cb)
  216.  
  217.     (cb (current-buffer))
  218.  
  219.     (if (== -2 (web-buffer (attached-buffer WEB-BUFFER)))
  220.       {
  221.     (web-buffer (create-buffer WEB-BUFFER BFFoo))
  222.     (current-buffer web-buffer)
  223.     (web-mode)
  224.       })
  225.     (current-buffer web-buffer)
  226.     (buffer-read-only FALSE)
  227.     (clear-buffer)
  228.  
  229.     (msg "Looking up entry for \"" item "\" ...")
  230.     (current-buffer (create-buffer "ack" 0))
  231.  
  232.     ;;;!!! search for file on path
  233.     (if (not (file-to-buffer (find-file file-name) (loc n) (loc error-code)))
  234.       {
  235.     (if (== error-code FIO_FNF)
  236.       (msg "Can't find manual \"" file-name "\"!"))
  237.     FALSE
  238.     (done)
  239.       })
  240.     (beginning-of-buffer)
  241.  
  242.     (switch tag
  243.       DOC-TAG        (read-doc     item)
  244.       PACKAGE-TAG    (read-package item)
  245. ;;??? read hook?
  246.     )
  247.  
  248.     (append-to-bag (bag (create-bag)) APPEND-REGION)
  249.     (current-buffer web-buffer)
  250.     (insert-bag bag)(free-bag bag)
  251.  
  252.     (buffer-read-only TRUE)
  253.  
  254.     (minor-mode file-name)
  255.  
  256.     (popup-buffer web-buffer 1 1)
  257.  
  258.     (msg "")
  259.   }
  260.   read-doc (string item) HIDDEN
  261.   {
  262.     (re-search-forward (concat '^(' item "[ )]"))
  263.     (beginning-of-line)
  264.     (set-mark)
  265.  
  266.     (forward-line 1)
  267.     (while TRUE
  268.       {
  269.     (if (EoB) (break))
  270.     (if (looking-at '(\([^ )]+\)')
  271.       { (if (!= item (get-matched '\1')) (break)) }
  272.       (if (looking-at '[^     ]') (break)))
  273.  
  274.     (forward-line 1)
  275.       })
  276.  
  277.   }
  278.   read-package (string item) HIDDEN
  279.   {
  280.     (re-search-forward (concat '^Package:\ +' item))
  281.     (beginning-of-line)
  282.     (set-mark)
  283.  
  284.     (forward-line 1)
  285.     (while TRUE
  286.       {
  287.     (if (EoB) (break))
  288.     (if (looking-at 'Package:') (break))
  289.     (if (looking-at '==') (break))
  290.  
  291.     (forward-line 1)
  292.       })
  293.   }
  294. )
  295.  
  296. (defun
  297.   find-file (string fname) HIDDEN
  298.   {
  299.     (if (!= "" (getenv DOC-ENV-VAR))
  300.       (file-name fname (getenv DOC-ENV-VAR))
  301.       (file-name fname))
  302.   }
  303. )
  304.  
  305. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  306. ;;;;;;;;;;;;;;;;;;;;;;;;;; Other Help Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;
  307. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  308.  
  309. (defun
  310.   pgm-bound-to
  311.   {
  312.     (int bid)
  313.     (string pgm)
  314.  
  315.     (pgm (complete CC_PGM "Program name: "))
  316.  
  317.     (bid (create-buffer "" 0))
  318.     (list-keys bid pgm 0x9 GLOBAL-KEYMAP LOCAL-KEYMAP)
  319.     (current-buffer bid)(beginning-of-buffer)
  320.     (if (re-search-forward (concat '^' pgm))
  321.       {
  322.     (beginning-of-line)
  323.     (looking-at '.+')
  324.     (msg (get-matched '&'))
  325.       }
  326.       (msg '"' pgm '" not found.'))
  327.   }
  328. )
  329.  
  330. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  331. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Backtracking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  332. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  333.  
  334. (const MAX-BACKTRACKERS    16)
  335.  
  336. (list backtrack-list)
  337.  
  338. (defun
  339.   add-to-backtrack-list (string word) HIDDEN
  340.   {
  341.     (insert-object backtrack-list -1 word)
  342.     (if (< MAX-BACKTRACKERS (length-of backtrack-list))
  343.     (remove-elements backtrack-list MAX-BACKTRACKERS 100))
  344.   }
  345.   web-backtrack
  346.   {
  347.     (if (< (length-of backtrack-list) 2)
  348.       {
  349.     (msg "Backtrack list empty.")
  350.     (done)
  351.       })
  352.     (web-word (extract-element backtrack-list 1))
  353.     (remove-elements backtrack-list 0 2)
  354.   }
  355.   web-history
  356.   {
  357.     (int i)
  358.  
  359.     (query-menu 3
  360.       {{
  361.     (int n)
  362.  
  363.     (n (- (arg 0) 1))
  364.         (if (< 0 n)
  365.     {
  366.       (remove-elements backtrack-list n 1)
  367.       (web-word (arg 1))
  368.     })
  369.       }}
  370.       ">Previously Viewed Topics"
  371.       "-"
  372.       (for (i 1) (< i (length-of backtrack-list))(+= i 1)
  373.     (push-arg (extract-element backtrack-list i)))
  374.     )
  375.   }
  376. )
  377.