;;;; info.jl -- Info browser
;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>

;;; This file is part of Jade.

;;; Jade is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.

;;; Jade is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.

;;; You should have received a copy of the GNU General Public License
;;; along with Jade; see the file COPYING.  If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(provide 'info)

;;; Limitations:
;;; - Depends wholly on tag tables --- does no searching for nodes just looks
;;;   up their position (except in the dir file).
;;; - No support for `*' node name.
;;; - Doesn't work 100% with info files formatted by emacs. For best results
;;;   makeinfo has to be used.
;;; - No editing of nodes.

(defvar info-directory-list
  (if (amiga-p) '("INFO:") '("/usr/info" "/usr/local/info/" "~/info"))
  "List of directories to search for info files if they can't be found as-is.")

(defvar info-keymap (make-keytab)
  "Keymap for Info.")

(defvar info-buffer (make-buffer "*Info*")
  "Buffer in which Info nodes are displayed.")
(set-buffer-special info-buffer t)

(defvar info-tags-buffer (make-buffer "*Info tags*")
  "Buffer for storing the current Info file's tag table.")
(set-buffer-special info-tags-buffer t)

(defvar info-history '()
  "List of `(FILE NODE POS)' showing how we got to the current node.")

(defvar info-file-name nil
  "The true name (in the filesystem) of the current Info file.")

(defvar info-node-name nil
  "The name of the current Info node.")

(defvar info-file-modtime nil
  "The modtime of file `info-file-name' last time we read something from it.")

(defvar info-indirect-list nil
  "List of `(START-OFFSET . FILE-NAME)' saying where the current Info file
is split.")

(defvar info-has-tags-p nil
  "t when we were able to load a tag table for this Info file.")

(defvar info-initialised nil
  "Protection against being loaded multiple times.")

(unless info-initialised
  (setq info-initialised t)
  (put 'info-error 'error-message "Info")
  (bind-keys info-keymap
    "SPC" 'next-screen
    "BS" 'prev-screen
    "1" 'info-menu-nth
    "2" 'info-menu-nth
    "3" 'info-menu-nth
    "4" 'info-menu-nth
    "5" 'info-menu-nth
    "6" 'info-menu-nth
    "7" 'info-menu-nth
    "8" 'info-menu-nth
    "9" 'info-menu-nth
    "b" 'goto-buffer-start
    "d" '(info "(dir)Top")
    "f" 'info-follow-ref
    "h" '(info "(info)Help")
    "g" 'info-goto-node
    "l" 'info-last
    "m" 'info-menu
    "n" 'info-next
    "p" 'info-prev
    "q" 'bury-buffer
    "u" 'info-up
    "?" 'describe-mode
    "HELP" 'describe-mode
    "RET" 'info-goto-link
    "LMB-CLICK2" 'info-goto-link
    "TAB" 'info-next-link
    "Meta-TAB" 'info-prev-link
    "Shift-TAB" 'info-prev-link)
  (with-buffer info-buffer
    (setq keymap-path (cons 'info-keymap keymap-path)
	  major-mode 'info-mode
	  buffer-record-undo nil)
    (set-buffer-read-only info-buffer t))
  (with-buffer info-tags-buffer
    (setq buffer-record-undo nil)))

;; Read the indirect list (if it exists) and tag table from the file FILENAME.
;; Indirect list ends up in `info-indirect-list', tag table is read into the
;; `info-tags-buffer' buffer. `info-has-tags-p' is set to t if a tags table
;; was loaded.
(defun info-read-tags (filename)
  (let
      ((file (open filename "r"))
       (dir (file-name-directory filename))
       str)
    (unless file
      (signal 'info-error (list "Can't open info file" filename)))
    (unwind-protect
	(with-buffer info-tags-buffer
	  (clear-buffer)
	  (setq info-indirect-list nil
		info-file-name nil
		info-has-tags-p nil)
	  ;; Read until we find the tag table or the indirect list.
	  (setq str (read-file-until file "^(Tag Table:|Indirect:) *\n$" t))
	  (when (and str (regexp-match "Indirect" str t))
	    ;; Parse the indirect list
	    (while (and (setq str (read-line file))
			(/= (aref str 0) ?\^_))
	      (setq info-indirect-list
		(cons
		  (cons
		    (read-from-string (regexp-expand "^.*: ([0-9]+)\n$" str "\\1"))
		    (concat dir (regexp-expand "^(.*): [0-9]+\n$" str "\\1")))
		  info-indirect-list)))
	    (setq info-indirect-list (nreverse info-indirect-list))
	    ;; Now look for the tag table
	    (setq str (read-file-until file "^Tag Table: *\n$" t)))
	  (when (and str (regexp-match "Tag Table" str t))
	    (read-buffer file)
	    (setq info-has-tags-p t))
	  (setq info-file-name filename
		info-file-modtime (file-modtime filename))
	  t)
      (close file))))

;; Read the `dir' file, if multiple `dir' files exist concatenate them
(defun info-read-dir ()
  (let
      ((read-dir nil)
       (path info-directory-list))
    (clear-buffer)
    (while path
      (let
	  ((name (file-name-concat (expand-file-name (car path)) "dir")))
	(when (file-exists-p name)
	  (if read-dir
	      (let
		  ((spos (cursor-pos)))
		(insert (read-file name))
		;; lose all text from the beginning of the file to the
		;; first menu item
		(when (find-next-regexp "^\\* Menu:" spos nil t)
		  (delete-area spos (next-line 1 (match-start)))))
	    (read-buffer name)
	    ;; try to delete the file's preamble
	    (when (find-next-regexp "^File:" (buffer-start) nil t)
	      (delete-area (buffer-start) (match-start)))
	    (goto-buffer-end)
	    (setq read-dir t))
	  (unless (equal (cursor-pos) (line-start))
	    (split-line))))
      (setq path (cdr path)))
    (unless read-dir
      (signal 'info-error '("Can't find `dir' file")))
    (setq info-file-name "dir"
	  info-file-modtime 0
	  info-node-name "Top"
	  mode-name "(dir)")
    (goto-buffer-start)
    t))

;; Record the file, node and cursor-position in the `info-history' list
;; for the `info-last' command.
(defun info-remember ()
  (when (and info-file-name info-node-name)
    (setq info-history (cons (list info-file-name
				   info-node-name
				   (cursor-pos))
			     info-history))))

;; Find the actual file for the info-file FILENAME
(defun info-locate-file (filename)
  (if (and info-file-name (or (not filename) (equal filename "")))
      info-file-name
    (let*
	((filename-and-info (concat filename ".info"))
	 (lcase-name (translate-string (copy-sequence filename)
				       downcase-table))
	 (lcase-and-info (concat lcase-name ".info")))
      (cond
       ((file-exists-p filename)
	filename)
       ((file-exists-p filename-and-info)
	filename-and-info)
       ((file-exists-p lcase-name)
	lcase-name)
       ((file-exists-p lcase-and-info)
	lcase-and-info)
       (t
	(catch 'foo
	  (let
	      ((dir info-directory-list)
	       real)
	    (while dir
	      (setq real (expand-file-name (car dir)))
	      (cond
	       ((file-exists-p (file-name-concat real filename))
		(throw 'foo (file-name-concat real filename)))
	       ((file-exists-p (file-name-concat real filename-and-info))
		(throw 'foo (file-name-concat real filename-and-info)))
	       ((file-exists-p (file-name-concat real lcase-name))
		(throw 'foo (file-name-concat real lcase-name)))
	       ((file-exists-p (file-name-concat real lcase-and-info))
		(throw 'foo (file-name-concat real lcase-and-info))))
	      (setq dir (cdr dir)))
	    (signal 'info-error (list "Can't find file" filename)))))))))

;; Display the node NODENAME. NODENAME can contain a file name. If no node
;; is specified go to `Top' node.
;; This depends on some magic for locating the node text. It only works 100%
;; with `makeinfo' generated files.
(defun info-find-node (nodename)
  (let
      ((filename (regexp-expand "^\\((.*)\\).*$" nodename "\\1"))
       (inhibit-read-only t)
       offset)
    (when filename
      (unless (setq nodename (regexp-expand "^\\(.*\\)(.+)$" nodename "\\1"))
	(setq nodename "Top")))
    (if (member filename '("dir" "DIR" "Dir"))
	(info-read-dir)
      (setq filename (info-locate-file filename))
      (when (or (not (equal info-file-name filename))
		(> (file-modtime filename) info-file-modtime))
	(info-read-tags filename))
      (if (not info-has-tags-p)
	  (progn
	    (clear-buffer)
	    (read-buffer info-file-name info-buffer)
	    (goto-buffer-start)
	    (setq info-node-name ""
		  mode-name (concat ?( (file-name-nondirectory info-file-name) ?))))
	(let
	    ((regexp (concat "^Node: " (regexp-quote nodename) ?\^?))
	     subfile text)
	  (if (find-next-regexp regexp (buffer-start) info-tags-buffer t)
	      (progn
		(setq offset (read (cons info-tags-buffer (match-end))))
		(if (null info-indirect-list)
		    (setq offset (+ offset 2)
			  subfile info-file-name)
		  (catch 'info
		    (let
			((list info-indirect-list))
		      (while (cdr list)
			(when (< offset (car (car (cdr list))))
			  (setq subfile (car list))
			  (throw 'info))
			(setq list (cdr list)))
		      (setq subfile (car list))))
		  ;; Use some magic to calculate the physical position of the
		  ;; node. This seems to work?
		  (if (eq subfile (car info-indirect-list))
		      (setq offset (+ offset 2))
		    (setq offset (+ (- offset (car subfile))
				    (car (car info-indirect-list)) 2)))
		  (setq subfile (cdr subfile)))
		(if (setq text (read-file-from-to subfile offset ?\^_))
		    (progn
		      (clear-buffer)
		      (insert text)
		      (goto-buffer-start)
		      (setq info-node-name nodename
			    mode-name (concat ?( (file-name-nondirectory info-file-name)
					      ?) info-node-name)))
		  (signal 'info-error (list "Can't read from file" filename))))
	    (signal 'info-error (list "Can't find node" nodename))))))))

;; Return a list of all node names matching START in the current tag table
(defun info-list-nodes (start)
  (let
      ((regexp (concat "^Node: (" (regexp-quote start) ".*)\^?"))
       (list ()))
    (with-buffer info-tags-buffer
      (goto-buffer-start)
      (while (find-next-regexp regexp nil nil t)
	(goto-char (match-end))
	(setq list (cons (regexp-expand-line regexp "\\1" nil nil t) list))))
    list))

;; `prompt2' variant. LIST-FUN is a function to call the first time a list
;; of possible completions is required.
(defun info-prompt (list-fun &optional title default start)
  (unless title
    (setq title "Select node"))
  (when default
    (setq title (concat title " (default: " default ")")))
  (unless start
    (setq start ""))
  (let*
      ((prompt-completion-function #'(lambda (w)
				       (unless prompt-list
					 (with-buffer info-buffer
					   (setq prompt-list (funcall list-fun))))
				       (prompt-complete-from-list w)))
       (prompt-validate-function 'prompt-validate-from-list)
       (prompt-word-regexps prompt-def-regexps)
       (prompt-list '())
       (res (prompt2 title start)))
    (if (equal res "")
	default
      res)))

;;;###autoload
(defun info (&optional start-node)
  "Start the Info viewer. If START-NODE is given it specifies the node to
show, otherwise the current node is used (or `(dir)' if this is the first
time that `info' has been called)."
  (interactive)
  (goto-buffer info-buffer)
  (cond
   (start-node
    (info-remember)
    (info-find-node start-node))
   ((and info-file-name info-node-name)
    (when (> (file-modtime info-file-name) info-file-modtime)
      (info-find-node info-node-name)))
   (t
    (info-find-node "(dir)"))))

;; The *Info* buffer has this function as its major-mode so that `Ctrl-h m'
;; displays some meaningful text
(defun info-mode ()
  "Info mode:\n
This mode is used to browse through the Info tree of documentation, special
commands are,\n
  `SPC'		Next screen of text
  `BS'		Previous screen
  `b'		Move to the start of this node
  `1' to `9'	Go to the Nth menu item in this node
  `d'		Find the `(dir)' node -- the root of Info
  `f'		Find the node of the next cross-reference in this node
  `g NODE RET'	Go to the node called NODE
  `h'		Display the Info tutorial, the node `(info)Help'
  `l'		Backtrack one node
  `m'		Choose a menu item from this node
  `n'		Find the `next' node
  `p'		Go to the `previous' node
  `u'		Display the parent node of this one
  `q'		Quit Info
  `?', `HELP'	Display this command summary
  `RET',
  `LMB-CLICK2'	Go to the link (menu item or xref) on this line
  `TAB'		Put the cursor on the next link in this node
  `Meta-TAB'	Move to the previous link in this node")

;; Prompt for the name of a node and find it.
(defun info-goto-node (node)
  (interactive "sGoto node: ")
  (when node
    (info-remember)
    (info-find-node node)))

;; Returns the node name of the menu item on the current line
(defun info-parse-menu-line ()
  (or (regexp-expand-line "^\\* (.+)::" "\\1")
      (regexp-expand-line "^\\* .+:[\t ]*((\\([^ ]+\\)|)([^,.]+|))\\." "\\1")))

;; Return a list of the names of all menu items. Starts searching from
;; the cursor position.
(defun info-list-menu-items ()
  (let
      ((list ())
       (opos (cursor-pos)))
    (while (find-next-regexp "^\\* [a-zA-Z0-9]+.*:")
      (goto-char (match-end))
      (setq list (cons (regexp-expand-line "^\\* ([^:.]+)" "\\1") list)))
    list))

;; Position the cursor at the start of the menu.
(defun info-goto-menu-start ()
  (when (or (find-prev-regexp "^\\* Menu:" nil nil t)
	    (find-next-regexp "^\\* Menu:" nil nil t))
    (goto-char (next-line 1 (match-start)))))

;; Goto the ITEM-INDEX'th menu item.
(defun info-menu-nth (item-index)
  (interactive (list (- (strtoc (current-event-string)) ?0)))
  (unless (info-goto-menu-start)
    (signal 'info-error (list "Can't find menu")))
  (while (and (> item-index 0) (find-next-regexp "^\\* .*:"))
    (goto-char (match-end))
    (setq item-index (1- item-index)))
  (when (/= item-index 0)
    (signal 'info-error (list "Can't find menu node")))
  (goto-line-start)
  (let
      ((nodename (info-parse-menu-line)))
    (if nodename
	(progn
	  (info-remember)
	  (info-find-node nodename))
      (signal 'info-error (list "Menu line malformed")))))

;; Prompt for the name of a menu item (with a default) and find it's node.
(defun info-menu ()
  (interactive)
  (let
      ((menu-name (regexp-expand-line "^\\* ([^:.]+)" "\\1")))
    (when (info-goto-menu-start)
      (let
	  ((opos (cursor-pos)))
	(setq menu-name (info-prompt 'info-list-menu-items
				     "Menu item:" menu-name))
	(goto-char opos)))
    (when menu-name
      (if (find-next-regexp (concat "^\\* " (regexp-quote menu-name) ?:))
	  (progn
	    (goto-char (match-start))
	    (let
		((node-name (info-parse-menu-line)))
	      (if node-name
		  (progn
		    (info-remember)
		    (info-find-node node-name))
		(signal 'info-error (list "Menu line malformed")))))
	(signal 'info-error (list "Can't find menu" menu-name))))))

;; Retrace our steps one node.
(defun info-last ()
  (interactive)
  (if info-history
      (progn
	(let
	    ((hist (car info-history)))
	  (setq info-history (cdr info-history))
	  (when (info-find-node (concat ?( (car hist) ?) (nth 1 hist)))
	    (goto-char (nth 2 hist))
	    t)))
    (message "No more history")
    (beep)))

(defun info-next ()
  (interactive)
  (info-find-link "Next"))

(defun info-prev ()
  (interactive)
  (info-find-link "Prev"))

(defun info-up ()
  (interactive)
  (info-find-link "Up"))

(defun info-find-link (link-type)
  (let*
      ((regexp (concat link-type ": ([^,]*)(,|[\t ]*$)"))
       (new-node (regexp-expand-line regexp "\\1" (buffer-start) nil t)))
    (if new-node
	(progn
	  (info-remember)
	  (info-find-node new-node))
      (message (concat "No " link-type " node"))
      (beep))))

;; Check this line for a menuitem of an xref, if one exists find its node
(defun info-goto-link ()
  (interactive)
  (let
      (node)
    (unless (setq node (cdr (info-parse-ref)))
      (goto-line-start)
      (unless (setq node (info-parse-menu-line))
	(signal 'info-error '("Nothing on this line to go to"))))
    (info-remember)
    (info-find-node node)))

;; Move the cursor to the next menuitem or xref
(defun info-next-link ()
  (interactive)
  (let
      ((pos (find-next-regexp "(^\\* |\\*Note)" (next-char) nil t)))
    (while (and pos (looking-at "\\* Menu:" pos nil t))
      (setq pos (find-next-regexp "(^\\* |\\*Note)" (next-char 1 pos) nil t)))
    (goto-char pos)))

;; Move the cursor to the previous menuitem or xref
(defun info-prev-link ()
  (interactive)
  (let
      ((pos (find-prev-regexp "(^\\* |\\*Note)" (prev-char) nil t)))
    (while (and pos (looking-at "\\* Menu:" pos nil t))
      (setq pos (find-prev-regexp "(^\\* |\\*Note)" (prev-char 1 pos) nil t)))
    (goto-char pos)))

;; Parse the cross-reference under the cursor into a cons-cell containing
;; its title and node. This is fairly hairy since it has to cope with refs
;; crossing line boundarys.
(defun info-parse-ref ()
  (when (looking-at "\\*Note *" nil nil t)
    (let
	((pos (match-end))
	 end ref-title ref-node)
      (if (setq end (find-next-regexp "[\t ]*:"))
	  (progn
	    (while (> (pos-line end) (pos-line pos))
	      (let
		  ((bit (copy-area pos (find-next-regexp "[\t ]*$" pos))))
		(unless (equal bit "")
		  (setq ref-title (cons ?\  (cons bit ref-title)))))
	      (setq pos (find-next-regexp "[^\t ]" (match-end)))
	      (unless pos
		(signal 'info-error '("Malformed reference"))))
	    (setq ref-title (apply 'concat (nreverse (cons (copy-area pos end)
							   ref-title)))
		  pos (next-char 1 end))
	    (if (= (get-char pos) ?:)
		(setq ref-node ref-title)
	      (when (looking-at " +" pos)
		(setq pos (match-end)))
	      (if (setq end (find-next-regexp "[\t ]*[:,.]" pos))
		  (progn
		    (while (> (pos-line end) (pos-line pos))
		      (let
			  ((bit (copy-area pos (find-next-regexp "[\t ]*$"
								 pos))))
			(unless (equal bit "")
			  (setq ref-node (cons ?\  (cons bit ref-node))))
			(setq pos (find-next-regexp "[^\t ]" (match-end))))
		      (unless pos
			(signal 'info-error '("Malformed reference"))))
		    (setq ref-node (apply 'concat (nreverse (cons (copy-area
								   pos end)
								  ref-node)))))
		(signal 'info-error '("Malformed reference")))))
	(signal 'info-error '("Malformed reference")))
      (when (and ref-title ref-node)
	(cons ref-title ref-node)))))

;; This should give you a prompt with all xrefs in the node to complete from,
;; currently it just finds the node of the next xref
(defun info-follow-ref ()
  (interactive)
  (unless (looking-at "\\*Note" nil nil t)
    (goto-char (find-next-regexp "\\*Note" nil nil t)))
  (let
      ((ref (info-parse-ref)))
    (when ref
      (info-remember)
      (info-find-node (cdr ref)))))