home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34exe.zip
/
mutt
/
package
/
web.mut
< prev
next >
Wrap
Text File
|
1995-01-14
|
8KB
|
377 lines
;; web.mut : A [very] small hyper-text text browser, documentation reader.
;; C Durland 5/93 Public Domain
(include me.mh)
(const
DOC-ENV-VAR "ME3DOC"
ME3-ENV-VAR "ME3"
)
(const
INDEX-BUFFER "*web-index*"
INDEX-FILE-NAME "web.idx"
WEB-BUFFER "*web*"
WEB-MODE-NAME "web"
)
(const ;; Index tags
ZIP-TAG "0"
DOC-TAG "1"
PACKAGE-TAG "2"
MISC-MUTT-CODE "7"
MAN-TAGO "8"
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;; Manipulate Text ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(int web-mode-keymap)
(defun
MAIN
{
(web-mode-keymap (create-keymap))
(bind-key web-mode-keymap
"next-line" "j"
"previous-line" "k"
"next-character" "l"
"previous-character" "h"
"next-page" " "
"previous-page" "C-h"
"web-doc" "?"
"web-select-item" "C-m"
"web-word" "t"
"web-backtrack" "b"
"web-history" "p"
)
;; Load the index if it hasn't been already
(save-excursion
{{
(if (== -2 (attached-buffer INDEX-BUFFER))
{
(if (== "" (find-file INDEX-FILE-NAME))
{
(msg "Can't find web index file \"" INDEX-FILE-NAME "\".")
FALSE
(done)
})
(current-buffer (create-buffer INDEX-BUFFER BFHooHum))
(file-to-buffer (find-file INDEX-FILE-NAME))
(buffer-read-only TRUE)
TRUE
})
}})
}
web-mode
{
(clear-modes)
(install-keymap web-mode-keymap LOCAL-KEYMAP)
(major-mode WEB-MODE-NAME)
(minor-mode "? for info")
(buffer-read-only TRUE)
(if (pgm-exists "web-mode-hook") (floc "web-mode-hook"()))
}
)
(defun
web-doc
{
(menu-box
">Web Text Linker"
"C-m -- Show info on item under cursor."
"k j h l -- Move up, down, left, right."
"C-h -- Page back"
"Space -- Page forward"
"p -- View list of previous topics."
"b -- Back up one topic."
"t -- Pick a new topic."
"Other ME cursor motion."
"C-l to clear this message."
)
;(update) ;;;!!!??? maybe update() needs to force cursor?
}
web-select-item
{
(if
(save-point
{{
(looking-at '(' TRUE) ;; move over "(" if dot is sitting on (foo
(if (not (looking-at '\<')) (previous-word))
(or
(looking-at '\(\w+.doc\>\)') ;; foo.doc
(looking-at '\(\w+.mut\>\)') ;; foo.mut (a package)
(looking-at '[^ .,/:)"]+'))
}})
(web-word (get-matched '&'))
(msg "Can't find anything to look up."))
}
web-word
{
(string word file-name tag)
(word (complete (bit-or CC_PGM CC_MUTT CC_SYSVAR)
"Info on word (return for the word at the cursor): "))
(if (== "" word) { (web-select-item)(done) })
(if (not (lookup-item word file-name tag))
{
(if (re-string '\w+.mut\>' word) ;; foo.mut but not a package
(tag MAN-TAGO)
{
(msg "No entry for \"" word "\".")
(done)
})
})
(if (== tag MAN-TAGO)
(web-manual word)
(read-item word file-name tag))
(add-to-backtrack-list word)
}
web-manual (string manual-file-name)
{
(int j)
(string fname bname)
(if (== "" (fname (find-file manual-file-name)))
{ (msg "Can't find manual: \"" manual-file-name "\".")(done) })
;; Check to see if the manual is already loaded
(bname (buffer-name fname))
(for (j 0) (< j (buffers)) (+= j 1)
(if { (current-buffer (nth-buffer j))
(and
(== bname (buffer-name -1))
(== WEB-MODE-NAME (major-mode))) }
{
(current-buffer -1 TRUE)
(done)
}))
(visit-file fname)
(file-name -1 "")(turn-off-undo)
(web-mode)
}
)
(defun
lookup-item (string item file-name tag) HIDDEN
{
(bool s)
(int index cb)
(string key)
(if (== -2 (index (attached-buffer INDEX-BUFFER)))
{ (msg "web index has vanished!")(halt) })
(cb (current-buffer))
(current-buffer index)
(beginning-of-buffer)
(cond
(search-forward (concat "^J" item "^J"))
{
(re-search-reverse '=#=\(.+\)=#=\(.+\)')
(file-name (get-matched '\1'))
(tag (get-matched '\2'))
(s TRUE)
}
(search-forward (concat ' ' item ' '))
{
(beginning-of-line)
(looking-at '.+ \([^ ]+\)')
(s (lookup-item (item (get-matched '\1')) file-name tag))
}
(search-forward (concat '=#=' item "=#=")) ;; want the entire manual
{ (tag MAN-TAGO) (s TRUE) }
{ ;; Maybe it's a bound key
(current-buffer cb)
(!= "" (key (key-bound-to item)))
}
(s (lookup-item (item key) file-name tag))
TRUE (s FALSE))
(current-buffer cb)
s
}
read-item (string item file-name tag) HIDDEN
{
(int web-buffer bid bag n error-code cb)
(cb (current-buffer))
(if (== -2 (web-buffer (attached-buffer WEB-BUFFER)))
{
(web-buffer (create-buffer WEB-BUFFER BFFoo))
(current-buffer web-buffer)
(web-mode)
})
(current-buffer web-buffer)
(buffer-read-only FALSE)
(clear-buffer)
(msg "Looking up entry for \"" item "\" ...")
(current-buffer (create-buffer "ack" 0))
;;;!!! search for file on path
(if (not (file-to-buffer (find-file file-name) (loc n) (loc error-code)))
{
(if (== error-code FIO_FNF)
(msg "Can't find manual \"" file-name "\"!"))
FALSE
(done)
})
(beginning-of-buffer)
(switch tag
DOC-TAG (read-doc item)
PACKAGE-TAG (read-package item)
;;??? read hook?
)
(append-to-bag (bag (create-bag)) APPEND-REGION)
(current-buffer web-buffer)
(insert-bag bag)(free-bag bag)
(buffer-read-only TRUE)
(minor-mode file-name)
(popup-buffer web-buffer 1 1)
(msg "")
}
read-doc (string item) HIDDEN
{
(re-search-forward (concat '^(' item "[ )]"))
(beginning-of-line)
(set-mark)
(forward-line 1)
(while TRUE
{
(if (EoB) (break))
(if (looking-at '(\([^ )]+\)')
{ (if (!= item (get-matched '\1')) (break)) }
(if (looking-at '[^ ]') (break)))
(forward-line 1)
})
}
read-package (string item) HIDDEN
{
(re-search-forward (concat '^Package:\ +' item))
(beginning-of-line)
(set-mark)
(forward-line 1)
(while TRUE
{
(if (EoB) (break))
(if (looking-at 'Package:') (break))
(if (looking-at '==') (break))
(forward-line 1)
})
}
)
(defun
find-file (string fname) HIDDEN
{
(if (!= "" (getenv DOC-ENV-VAR))
(file-name fname (getenv DOC-ENV-VAR))
(file-name fname))
}
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;; Other Help Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun
pgm-bound-to
{
(int bid)
(string pgm)
(pgm (complete CC_PGM "Program name: "))
(bid (create-buffer "" 0))
(list-keys bid pgm 0x9 GLOBAL-KEYMAP LOCAL-KEYMAP)
(current-buffer bid)(beginning-of-buffer)
(if (re-search-forward (concat '^' pgm))
{
(beginning-of-line)
(looking-at '.+')
(msg (get-matched '&'))
}
(msg '"' pgm '" not found.'))
}
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;; Backtracking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(const MAX-BACKTRACKERS 16)
(list backtrack-list)
(defun
add-to-backtrack-list (string word) HIDDEN
{
(insert-object backtrack-list -1 word)
(if (< MAX-BACKTRACKERS (length-of backtrack-list))
(remove-elements backtrack-list MAX-BACKTRACKERS 100))
}
web-backtrack
{
(if (< (length-of backtrack-list) 2)
{
(msg "Backtrack list empty.")
(done)
})
(web-word (extract-element backtrack-list 1))
(remove-elements backtrack-list 0 2)
}
web-history
{
(int i)
(query-menu 3
{{
(int n)
(n (- (arg 0) 1))
(if (< 0 n)
{
(remove-elements backtrack-list n 1)
(web-word (arg 1))
})
}}
">Previously Viewed Topics"
"-"
(for (i 1) (< i (length-of backtrack-list))(+= i 1)
(push-arg (extract-element backtrack-list i)))
)
}
)