home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / jade-3.0.lha / Jade / lisp / info.jl < prev    next >
Encoding:
Text File  |  1994-04-17  |  11.0 KB  |  341 lines
  1. ;;;; info.jl -- Info browser
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. ;;; Limitations:
  21. ;;; - Depends wholly on tag tables --- does no searching for nodes just looks
  22. ;;;   up their position.
  23. ;;; - No support for `*' node name.
  24. ;;; - No following of xrefs (yet)
  25. ;;; - Doesn't work 100% with info files formatted by emacs. For best results
  26. ;;;   makeinfo has to be used.
  27. ;;; - No editing of nodes.
  28.  
  29. (provide 'info)
  30.  
  31. (defvar info-directory (if (amiga-p) "INFO:" "/usr/local/info/")
  32.   "Directory to search for info files if they can't be found as-is.")
  33.  
  34. (unless (boundp 'info-initialised)
  35.   (put 'info-error 'error-message "Info")
  36.   (setq
  37.     info-keymap (make-keytab)
  38.     info-buffer (make-buffer "*Info*")
  39.     info-tags-buffer (make-buffer "*Info tags*")
  40.     info-history nil          ; List of `(FILE NODE POS)'
  41.     info-file-name nil
  42.     info-node-name nil
  43.     info-file-modtime nil
  44.     info-indirect-list nil      ; List of `(START-OFFSET . FILE-NAME)'
  45.     info-initialised t)
  46.   (bind-keys info-keymap
  47.     "space" 'next-screen
  48.     "backspace" 'prev-screen
  49.     "1" '(info-menu-nth 1)
  50.     "2" '(info-menu-nth 2)
  51.     "3" '(info-menu-nth 3)
  52.     "4" '(info-menu-nth 4)
  53.     "5" '(info-menu-nth 5)
  54.     "b" 'goto-file-start
  55.     "f" 'info-follow-ref
  56.     "g" 'info-goto-node
  57.     "l" 'info-last
  58.     "m" 'info-menu
  59.     "n" 'info-next
  60.     "p" 'info-prev
  61.     "q" 'info-quit
  62.     "u" 'info-up)
  63.   (set-buffer-special info-buffer t)
  64.   (set-buffer-special info-tags-buffer t)
  65.   (with-buffer info-buffer
  66.     (setq keymap-path (cons info-keymap keymap-path))
  67.     (set-buffer-read-only info-buffer t)))
  68.  
  69. ;; Read the indirect list (if it exists) and tag table (must exist) from
  70. ;; the file FILENAME. Indirect list ends up in `info-indirect-list', tag
  71. ;; table is read into the `info-tags-buffer' buffer.
  72. (defun info-read-tags (filename)
  73.   (let
  74.       ((file (open filename "r"))
  75.        (dir (path-name filename))
  76.        str)
  77.     (unless file
  78.       (signal 'info-error (list "Can't open info file" filename)))
  79.     (with-buffer info-tags-buffer
  80.       (clear-buffer)
  81.       (setq info-indirect-list nil)
  82.       ;; Read until we find the tag table or the indirect list.
  83.       (setq str (read-file-until file "^(Tag Table:|Indirect:) *\n$" t))
  84.       (when (and str (regexp-match "Indirect" str t))
  85.     ;; Parse the indirect list
  86.     (while (and (setq str (read-line file))
  87.             (not (string-head-eq str "\^_")))
  88.       (setq info-indirect-list
  89.         (cons
  90.           (cons
  91.         (read-from-string (regexp-expand "^.*: ([0-9]+)\n$" str "\\1"))
  92.         (concat dir (regexp-expand "^(.*): [0-9]+\n$" str "\\1")))
  93.           info-indirect-list)))
  94.     (setq info-indirect-list (nreverse info-indirect-list))
  95.     ;; Now look for the tag table
  96.     (setq str (read-file-until file "^Tag Table: *\n$" t)))
  97.       (if (and str (regexp-match "Tag Table" str t))
  98.       (read-buffer file)
  99.     (signal 'info-error '("No tag table in info file")))
  100.       (setq
  101.     info-file-name filename
  102.     info-file-modtime (file-modtime filename))
  103.       t)))
  104.  
  105.  
  106. ;; Record the file, node and cursor-position in the `info-history' list
  107. ;; for the `info-last' command.
  108. (defun info-remember ()
  109.   (when (and info-file-name info-node-name)
  110.     (setq info-history
  111.       (cons (list info-file-name info-node-name (cursor-pos)) info-history))))
  112.  
  113. ;; Display the node NODENAME. NODENAME can contain a file name. If no node
  114. ;; is specified go to `Top' node.
  115. ;; This depends on some magic for locating the node text. It only works 100%
  116. ;; with `makeinfo' generated files.
  117. (defun info-find-node (nodename)
  118.   (let
  119.       ((filename (regexp-expand "^\\((.*)\\).*$" nodename "\\1"))
  120.     offset)
  121.     (if filename
  122.     ;; A filename was specified, first locate it, then if it's tags aren't
  123.     ;; already loaded find them.
  124.     (progn
  125.       (cond
  126.         ((file-exists-p filename))
  127.         ((file-exists-p (concat filename ".info"))
  128.           (setq filename (concat filename ".info")))
  129.         ((file-exists-p (concat info-directory filename))
  130.           (setq filename (concat info-directory filename)))
  131.         ((file-exists-p (concat info-directory filename ".info"))
  132.           (setq filename (concat info-directory filename ".info")))
  133.         (t
  134.           (signal 'info-error (list "Can't find file" filename))))
  135.       (when (or (not (equal info-file-name filename))
  136.             (> (file-modtime filename) info-file-modtime))
  137.         (info-read-tags filename))
  138.       ;; Get rid of the file spec.
  139.       (unless (setq nodename (regexp-expand "^\\(.*\\)(.+)$" nodename "\\1"))
  140.         (setq nodename "Top")))
  141.       (when (and info-file-name (> (file-modtime info-file-name) info-file-modtime))
  142.     (info-read-tags info-file-name)))
  143.     (unless info-file-name
  144.       (info-read-tags (concat info-directory "dir")))
  145.     (let
  146.     ((regexp (concat "^Node: " nodename ?\^?))
  147.      subfile text)
  148.       (if (find-next-regexp regexp (pos 1 1) info-tags-buffer t)
  149.       (progn
  150.         (setq offset (read (cons info-tags-buffer find-last-end-pos)))
  151.         (if (null info-indirect-list)
  152.         (setq
  153.           offset (+ offset 2)
  154.           subfile info-file-name)
  155.           (catch 'info
  156.         (let
  157.             ((list info-indirect-list))
  158.           (while (cdr list)
  159.             (when (< offset (car (car (cdr list))))
  160.               (setq subfile (car list))
  161.               (throw 'info))
  162.             (setq list (cdr list)))
  163.           (setq subfile (car list))))
  164.           ;; Use some magic to calculate the physical position of the
  165.           ;; node. This seems to work?
  166.           (if (eq subfile (car info-indirect-list))
  167.           (setq offset (+ offset 2))
  168.         (setq offset (+ (- offset (car subfile)) (car (car info-indirect-list)) 2)))
  169.           (setq subfile (cdr subfile)))
  170.         (if (setq text (read-file-from-to subfile offset ?\^_))
  171.         (progn
  172.           (set-buffer-read-only info-buffer nil)
  173.           (clear-buffer)
  174.           (insert text)
  175.           (set-buffer-read-only info-buffer t)
  176.           (goto-file-start)
  177.           (setq info-node-name nodename)
  178.           (setq mode-name (concat ?( (base-name info-file-name) ?) info-node-name)))
  179.           (signal 'info-error (list "Can't read from file" filename))))
  180.     (signal 'info-error (list "Can't find node" nodename))))))
  181.  
  182. ;; Return a list of all node names matching START in the current tag table
  183. (defun info-list-nodes (start)
  184.   (let
  185.       ((regexp (concat "^Node: (" start ".*)\^?"))
  186.        (list ()))
  187.     (with-buffer info-tags-buffer
  188.       (goto-file-start)
  189.       (while (find-next-regexp regexp nil nil t)
  190.     (goto find-last-end-pos)
  191.     (setq list (cons (regexp-expand-line regexp "\\1" nil nil t) list))))
  192.     list))
  193.  
  194. ;; `prompt2' variant. LIST-FUN is a function to call the first time a list
  195. ;; of possible completions is required.
  196. (defun info-prompt (list-fun &optional title default start)
  197.   (unless title
  198.     (setq title "Select node"))
  199.   (when default
  200.     (setq title (concat title " (default: " default ")")))
  201.   (unless start
  202.     (setq start ""))
  203.   (let
  204.       (res
  205.        prompt-list)
  206.     (setq res (prompt2
  207.     #'(lambda (w)
  208.       (unless prompt-list
  209.         (with-buffer info-buffer
  210.           (setq prompt-list (funcall list-fun))))
  211.       (prompt-complete-from-list w))
  212.     title
  213.     start))
  214.     (if (equal res "")
  215.     default
  216.       res)))
  217.  
  218. (defun info (&optional start-node)
  219.   "(info [NODE-NAME])
  220. Start the Info viewer. If NODE-NAME is given it specifies the node to
  221. show, otherwise the current node is used (or `(dir)' if this is the first
  222. time that `info' has been called)."
  223.   (info-remember)
  224.   (goto-buffer info-buffer)
  225.   (cond
  226.     (start-node
  227.       (info-find-node start-node))
  228.     ((and info-file-name info-node-name))
  229.     (t
  230.       (info-find-node "(dir)"))))
  231.  
  232. ;; Prompt for the name of a node and find it.
  233. (defun info-goto-node ()
  234.   (let
  235.       ((node (prompt "Goto node: ")))
  236.     (when node
  237.       (info-remember)
  238.       (info-find-node node))))
  239.  
  240. ;; Returns the node name of the menu item on the current line
  241. (defun info-parse-menu-line ()
  242.   (or (regexp-expand-line "^\\* ([a-zA-Z0-9]+.*)::" "\\1")
  243.       (regexp-expand-line "^\\* [a-zA-Z0-9]+.*: *(\\(.*\\).*)\\." "\\1")
  244.       (regexp-expand-line "^\\* [a-zA-Z0-9]+.*: *(.*)\\." "\\1")))
  245.  
  246. ;; Return a list of the names of all menu items. Starts searching from
  247. ;; the cursor position.
  248. (defun info-list-menu-items ()
  249.   (let
  250.       ((list ())
  251.        (opos (cursor-pos)))
  252.     (while (find-next-regexp "^\\* [a-zA-Z0-9]+.*:")
  253.       (goto find-last-end-pos)
  254.       (setq list (cons (regexp-expand-line "^\\* ([^:.]+)" "\\1") list)))
  255.     list))
  256.  
  257. ;; Position the cursor at the start of the menu.
  258. (defun info-goto-menu-start ()
  259.   (when (or (find-prev-regexp "^\\* Menu: *$" nil nil t)
  260.         (find-next-regexp "^\\* Menu: *$" nil nil t))
  261.     (goto (next-line 1 find-last-start-pos))))
  262.  
  263. ;; Goto the ITEM-INDEX'th menu item.
  264. (defun info-menu-nth (item-index)
  265.   (unless (info-goto-menu-start)
  266.     (signal 'info-error (list "Can't find menu")))
  267.   (while (and (> item-index 0) (find-next-regexp "^\\* .*:"))
  268.     (goto find-last-end-pos)
  269.     (setq item-index (1- item-index)))
  270.   (when (/= item-index 0)
  271.     (signal 'info-error (list "Can't find menu node")))
  272.   (goto-line-start)
  273.   (let
  274.       ((nodename (info-parse-menu-line)))
  275.     (if nodename
  276.     (progn
  277.       (info-remember)
  278.       (info-find-node nodename))
  279.       (signal 'info-error (list "Menu line malformed")))))
  280.  
  281. ;; Prompt for the name of a menu item (with a default) and find it's node.
  282. (defun info-menu ()
  283.   (let
  284.       ((menu-name (regexp-expand-line "^\\* ([^:.]+)" "\\1")))
  285.     (when (info-goto-menu-start)
  286.       (let
  287.       ((opos (cursor-pos)))
  288.     (setq menu-name (info-prompt 'info-list-menu-items "Menu item" menu-name))
  289.     (goto opos)))
  290.     (when menu-name
  291.       (if (find-next-regexp (concat "^\\* " menu-name ?:))
  292.       (progn
  293.         (goto find-last-start-pos)
  294.         (let
  295.         ((node-name (info-parse-menu-line)))
  296.           (if node-name
  297.           (progn
  298.             (info-remember)
  299.             (info-find-node node-name))
  300.         (signal 'info-error (list "Menu line malformed")))))
  301.     (signal 'info-error (list "Can't find menu" menu-name))))))
  302.  
  303. (defun info-follow-ref ()
  304. )
  305.  
  306. ;; Retrace our steps one node.
  307. (defun info-last ()
  308.   (if info-history
  309.       (progn
  310.     (let
  311.         ((hist (car info-history)))
  312.       (setq info-history (cdr info-history))
  313.       (when (info-find-node (concat ?( (car hist) ?) (nth 1 hist)))
  314.         (goto (nth 2 hist))
  315.         t)))
  316.     (title "No more history")
  317.     (beep)))
  318.  
  319. (defun info-next ()
  320.   (info-find-link "Next"))
  321.  
  322. (defun info-prev ()
  323.   (info-find-link "Prev"))
  324.  
  325. (defun info-up ()
  326.   (info-find-link "Up"))
  327.  
  328. (defun info-find-link (link-type)
  329.   (let*
  330.       ((regexp (concat link-type ": ([^,]*)(,| *$)"))
  331.        (new-node (regexp-expand-line regexp "\\1" (pos 1 1) nil t)))
  332.     (if new-node
  333.     (progn
  334.       (info-remember)
  335.       (info-find-node new-node))
  336.       (title (concat "No " link-type " node"))
  337.       (beep))))
  338.  
  339. (defun info-quit ()
  340.   (kill-buffer info-buffer))
  341.