home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / info.jl < prev    next >
Lisp/Scheme  |  1994-10-03  |  19KB  |  563 lines
  1. ;;;; info.jl -- Info browser
  2. ;;;  Copyright (C) 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. (provide 'info)
  21.  
  22. ;;; Limitations:
  23. ;;; - Depends wholly on tag tables --- does no searching for nodes just looks
  24. ;;;   up their position (except in the dir file).
  25. ;;; - No support for `*' node name.
  26. ;;; - Doesn't work 100% with info files formatted by emacs. For best results
  27. ;;;   makeinfo has to be used.
  28. ;;; - No editing of nodes.
  29.  
  30. (defvar info-directory-list
  31.   (if (amiga-p) '("INFO:") '("/usr/info" "/usr/local/info/" "~/info"))
  32.   "List of directories to search for info files if they can't be found as-is.")
  33.  
  34. (defvar info-keymap (make-keytab)
  35.   "Keymap for Info.")
  36.  
  37. (defvar info-buffer (make-buffer "*Info*")
  38.   "Buffer in which Info nodes are displayed.")
  39. (set-buffer-special info-buffer t)
  40.  
  41. (defvar info-tags-buffer (make-buffer "*Info tags*")
  42.   "Buffer for storing the current Info file's tag table.")
  43. (set-buffer-special info-tags-buffer t)
  44.  
  45. (defvar info-history '()
  46.   "List of `(FILE NODE POS)' showing how we got to the current node.")
  47.  
  48. (defvar info-file-name nil
  49.   "The true name (in the filesystem) of the current Info file.")
  50.  
  51. (defvar info-node-name nil
  52.   "The name of the current Info node.")
  53.  
  54. (defvar info-file-modtime nil
  55.   "The modtime of file `info-file-name' last time we read something from it.")
  56.  
  57. (defvar info-indirect-list nil
  58.   "List of `(START-OFFSET . FILE-NAME)' saying where the current Info file
  59. is split.")
  60.  
  61. (defvar info-has-tags-p nil
  62.   "t when we were able to load a tag table for this Info file.")
  63.  
  64. (defvar info-initialised nil
  65.   "Protection against being loaded multiple times.")
  66.  
  67. (unless info-initialised
  68.   (setq info-initialised t)
  69.   (put 'info-error 'error-message "Info")
  70.   (bind-keys info-keymap
  71.     "SPC" 'next-screen
  72.     "BS" 'prev-screen
  73.     "1" 'info-menu-nth
  74.     "2" 'info-menu-nth
  75.     "3" 'info-menu-nth
  76.     "4" 'info-menu-nth
  77.     "5" 'info-menu-nth
  78.     "6" 'info-menu-nth
  79.     "7" 'info-menu-nth
  80.     "8" 'info-menu-nth
  81.     "9" 'info-menu-nth
  82.     "b" 'goto-buffer-start
  83.     "d" '(info "(dir)Top")
  84.     "f" 'info-follow-ref
  85.     "h" '(info "(info)Help")
  86.     "g" 'info-goto-node
  87.     "l" 'info-last
  88.     "m" 'info-menu
  89.     "n" 'info-next
  90.     "p" 'info-prev
  91.     "q" 'bury-buffer
  92.     "u" 'info-up
  93.     "?" 'describe-mode
  94.     "HELP" 'describe-mode
  95.     "RET" 'info-goto-link
  96.     "LMB-CLICK2" 'info-goto-link
  97.     "TAB" 'info-next-link
  98.     "Meta-TAB" 'info-prev-link
  99.     "Shift-TAB" 'info-prev-link)
  100.   (with-buffer info-buffer
  101.     (setq keymap-path (cons 'info-keymap keymap-path)
  102.       major-mode 'info-mode
  103.       buffer-record-undo nil)
  104.     (set-buffer-read-only info-buffer t))
  105.   (with-buffer info-tags-buffer
  106.     (setq buffer-record-undo nil)))
  107.  
  108. ;; Read the indirect list (if it exists) and tag table from the file FILENAME.
  109. ;; Indirect list ends up in `info-indirect-list', tag table is read into the
  110. ;; `info-tags-buffer' buffer. `info-has-tags-p' is set to t if a tags table
  111. ;; was loaded.
  112. (defun info-read-tags (filename)
  113.   (let
  114.       ((file (open filename "r"))
  115.        (dir (file-name-directory filename))
  116.        str)
  117.     (unless file
  118.       (signal 'info-error (list "Can't open info file" filename)))
  119.     (unwind-protect
  120.     (with-buffer info-tags-buffer
  121.       (clear-buffer)
  122.       (setq info-indirect-list nil
  123.         info-file-name nil
  124.         info-has-tags-p nil)
  125.       ;; Read until we find the tag table or the indirect list.
  126.       (setq str (read-file-until file "^(Tag Table:|Indirect:) *\n$" t))
  127.       (when (and str (regexp-match "Indirect" str t))
  128.         ;; Parse the indirect list
  129.         (while (and (setq str (read-line file))
  130.             (/= (aref str 0) ?\^_))
  131.           (setq info-indirect-list
  132.         (cons
  133.           (cons
  134.             (read-from-string (regexp-expand "^.*: ([0-9]+)\n$" str "\\1"))
  135.             (concat dir (regexp-expand "^(.*): [0-9]+\n$" str "\\1")))
  136.           info-indirect-list)))
  137.         (setq info-indirect-list (nreverse info-indirect-list))
  138.         ;; Now look for the tag table
  139.         (setq str (read-file-until file "^Tag Table: *\n$" t)))
  140.       (when (and str (regexp-match "Tag Table" str t))
  141.         (read-buffer file)
  142.         (setq info-has-tags-p t))
  143.       (setq info-file-name filename
  144.         info-file-modtime (file-modtime filename))
  145.       t)
  146.       (close file))))
  147.  
  148. ;; Read the `dir' file, if multiple `dir' files exist concatenate them
  149. (defun info-read-dir ()
  150.   (let
  151.       ((read-dir nil)
  152.        (path info-directory-list))
  153.     (clear-buffer)
  154.     (while path
  155.       (let
  156.       ((name (file-name-concat (expand-file-name (car path)) "dir")))
  157.     (when (file-exists-p name)
  158.       (if read-dir
  159.           (let
  160.           ((spos (cursor-pos)))
  161.         (insert (read-file name))
  162.         ;; lose all text from the beginning of the file to the
  163.         ;; first menu item
  164.         (when (find-next-regexp "^\\* Menu:" spos nil t)
  165.           (delete-area spos (next-line 1 (match-start)))))
  166.         (read-buffer name)
  167.         ;; try to delete the file's preamble
  168.         (when (find-next-regexp "^File:" (buffer-start) nil t)
  169.           (delete-area (buffer-start) (match-start)))
  170.         (goto-buffer-end)
  171.         (setq read-dir t))
  172.       (unless (equal (cursor-pos) (line-start))
  173.         (split-line))))
  174.       (setq path (cdr path)))
  175.     (unless read-dir
  176.       (signal 'info-error '("Can't find `dir' file")))
  177.     (setq info-file-name "dir"
  178.       info-file-modtime 0
  179.       info-node-name "Top"
  180.       mode-name "(dir)")
  181.     (goto-buffer-start)
  182.     t))
  183.  
  184. ;; Record the file, node and cursor-position in the `info-history' list
  185. ;; for the `info-last' command.
  186. (defun info-remember ()
  187.   (when (and info-file-name info-node-name)
  188.     (setq info-history (cons (list info-file-name
  189.                    info-node-name
  190.                    (cursor-pos))
  191.                  info-history))))
  192.  
  193. ;; Find the actual file for the info-file FILENAME
  194. (defun info-locate-file (filename)
  195.   (if (and info-file-name (or (not filename) (equal filename "")))
  196.       info-file-name
  197.     (let*
  198.     ((filename-and-info (concat filename ".info"))
  199.      (lcase-name (translate-string (copy-sequence filename)
  200.                        downcase-table))
  201.      (lcase-and-info (concat lcase-name ".info")))
  202.       (cond
  203.        ((file-exists-p filename)
  204.     filename)
  205.        ((file-exists-p filename-and-info)
  206.     filename-and-info)
  207.        ((file-exists-p lcase-name)
  208.     lcase-name)
  209.        ((file-exists-p lcase-and-info)
  210.     lcase-and-info)
  211.        (t
  212.     (catch 'foo
  213.       (let
  214.           ((dir info-directory-list)
  215.            real)
  216.         (while dir
  217.           (setq real (expand-file-name (car dir)))
  218.           (cond
  219.            ((file-exists-p (file-name-concat real filename))
  220.         (throw 'foo (file-name-concat real filename)))
  221.            ((file-exists-p (file-name-concat real filename-and-info))
  222.         (throw 'foo (file-name-concat real filename-and-info)))
  223.            ((file-exists-p (file-name-concat real lcase-name))
  224.         (throw 'foo (file-name-concat real lcase-name)))
  225.            ((file-exists-p (file-name-concat real lcase-and-info))
  226.         (throw 'foo (file-name-concat real lcase-and-info))))
  227.           (setq dir (cdr dir)))
  228.         (signal 'info-error (list "Can't find file" filename)))))))))
  229.  
  230. ;; Display the node NODENAME. NODENAME can contain a file name. If no node
  231. ;; is specified go to `Top' node.
  232. ;; This depends on some magic for locating the node text. It only works 100%
  233. ;; with `makeinfo' generated files.
  234. (defun info-find-node (nodename)
  235.   (let
  236.       ((filename (regexp-expand "^\\((.*)\\).*$" nodename "\\1"))
  237.        (inhibit-read-only t)
  238.        offset)
  239.     (when filename
  240.       (unless (setq nodename (regexp-expand "^\\(.*\\)(.+)$" nodename "\\1"))
  241.     (setq nodename "Top")))
  242.     (if (member filename '("dir" "DIR" "Dir"))
  243.     (info-read-dir)
  244.       (setq filename (info-locate-file filename))
  245.       (when (or (not (equal info-file-name filename)