Initial revision

1 files changed, 511 insertions, 0 deletions

diff --git a/lisp/info-look.el b/lisp/info-look.el
new file mode 100644
index 00000000000..c798bb769b4
--- /dev/null
+++ b/lisp/info-look.el
@@ -0,0 +1,511 @@
+;;; info-look.el --- major-mode-sensitive Info index lookup facility.
+;; An older version of this was known as libc.el.
+
+;; Copyright (C) 1995, 1996, 1997 Ralph Schleicher.
+
+;; Author: Ralph Schleicher <rs@purple.UL.BaWue.DE>
+;; Keywords: help languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'info)
+
+(defvar info-lookup-mode nil
+  "*Symbol of the current buffer's help mode.
+Provide help according to the buffer's major mode if value is nil.
+Automatically becomes buffer local when set in any fashion.")
+(make-variable-buffer-local 'info-lookup-mode)
+
+(defvar info-lookup-other-window-flag t
+  "*Non-nil means pop up the Info buffer in another window.")
+
+(defvar info-lookup-highlight-face 'highlight
+  "*Face for highlighting looked up help items.
+Setting this variable to nil disables highlighting.")
+
+(defvar info-lookup-highlight-overlay nil
+  "Overlay object used for highlighting.")
+
+(defvar info-lookup-history nil
+  "History of previous input lines.")
+
+(defvar info-lookup-alist '((symbol . info-lookup-symbol-alist)
+			    (file . info-lookup-file-alist))
+  "*Alist of known help topics.
+Cons cells are of the form
+
+    (HELP-TOPIC . VARIABLE)
+
+HELP-TOPIC is the symbol of a help topic.
+VARIABLE is a variable storing HELP-TOPIC's public data.
+ Value is an alist with elements of the form
+
+    (HELP-MODE REGEXP IGNORE-CASE DOC-SPEC PARSE-RULE OTHER-MODES)
+
+HELP-MODE is a mode's symbol.
+REGEXP is a regular expression matching those help items whose
+ documentation can be looked up via DOC-SPEC.
+IGNORE-CASE is non-nil if help items are case insensitive.
+DOC-SPEC is a list of documentation specifications of the form
+
+    (INFO-NODE TRANS-FUNC PREFIX SUFFIX)
+
+INFO-NODE is the name (including file name part) of an Info index.
+TRANS-FUNC is a function translating index entries into help items;
+ nil means add only those index entries matching REGEXP, a string
+ means prepend string to the first word of all index entries.
+PREFIX and SUFFIX are parts of a regular expression.  If one of
+ them is non-nil then search the help item's Info node for the
+ first occurrence of the regular expression `PREFIX ITEM SUFFIX'.
+ ITEM will be highlighted with `info-lookup-highlight-face' if this
+ variable is not nil.
+PARSE-RULE is either the symbol name of a function or a regular
+ expression for guessing the default help item at point.  Fuzzy
+ regular expressions like \"[_a-zA-Z0-9]+\" do a better job if
+ there are no clear delimiters; do not try to write too complex
+ expressions.  PARSE-RULE defaults to REGEXP.
+OTHER-MODES is a list of cross references to other help modes.")
+
+(defsubst info-lookup->topic-value (topic)
+  (symbol-value (cdr (assoc topic info-lookup-alist))))
+
+(defsubst info-lookup->mode-value (topic mode)
+  (assoc mode (info-lookup->topic-value topic)))
+
+(defsubst info-lookup->regexp (topic mode)
+  (nth 1 (info-lookup->mode-value topic mode)))
+
+(defsubst info-lookup->ignore-case (topic mode)
+  (nth 2 (info-lookup->mode-value topic mode)))
+
+(defsubst info-lookup->doc-spec (topic mode)
+  (nth 3 (info-lookup->mode-value topic mode)))
+
+(defsubst info-lookup->parse-rule (topic mode)
+  (nth 4 (info-lookup->mode-value topic mode)))
+
+(defsubst info-lookup->other-modes (topic mode)
+  (nth 5 (info-lookup->mode-value topic mode)))
+
+(defvar info-lookup-cache nil
+  "Cache storing data maintained automatically by the program.
+Value is an alist with cons cell of the form
+
+    (HELP-TOPIC . ((HELP-MODE INITIALIZED COMPLETIONS REFER-MODES) ...))
+
+HELP-TOPIC is the symbol of a help topic.
+HELP-MODE is a mode's symbol.
+INITIALIZED is nil if HELP-MODE is uninitialized, t if
+ HELP-MODE is initialized, and `0' means HELP-MODE is
+ initialized but void.
+COMPLETIONS is an alist of documented help items.
+REFER-MODES is a list of other help modes to use.")
+
+(defsubst info-lookup->cache (topic)
+  (or (assoc topic info-lookup-cache)
+      (car (setq info-lookup-cache
+		 (cons (cons topic nil)
+		       info-lookup-cache)))))
+
+(defsubst info-lookup->topic-cache (topic)
+  (cdr (info-lookup->cache topic)))
+
+(defsubst info-lookup->mode-cache (topic mode)
+  (assoc mode (info-lookup->topic-cache topic)))
+
+(defsubst info-lookup->initialized (topic mode)
+  (nth 1 (info-lookup->mode-cache topic mode)))
+
+(defsubst info-lookup->completions (topic mode)
+  (or (info-lookup->initialized topic mode)
+      (info-lookup-setup-mode topic mode))
+  (nth 2 (info-lookup->mode-cache topic mode)))
+
+(defsubst info-lookup->refer-modes (topic mode)
+  (or (info-lookup->initialized topic mode)
+      (info-lookup-setup-mode topic mode))
+  (nth 3 (info-lookup->mode-cache topic mode)))
+
+(defsubst info-lookup->all-modes (topic mode)
+  (cons mode (info-lookup->refer-modes topic mode)))
+
+(defvar info-lookup-symbol-alist
+  '((autoconf-mode
+     "A[CM]_[_A-Z0-9]+" nil
+     (("(autoconf)Macro Index" "AC_"
+       "^[ \t]+- \\(Macro\\|Variable\\): .*\\<" "\\>")
+      ("(automake)Index" nil
+       "^[ \t]*`" "'"))
+     ;; Autoconf symbols are M4 macros.  Thus use M4's parser.
+     ignore
+     (m4-mode))
+    (bison-mode
+     "[:;|]\\|%\\([%{}]\\|[_a-z]+\\)\\|YY[_A-Z]+\\|yy[_a-z]+" nil
+     (("(bison)Index" nil
+       "`" "'"))
+     "[:;|]\\|%\\([%{}]\\|[_a-zA-Z][_a-zA-Z0-9]*\\)"
+     (c-mode))
+    (c-mode
+     "\\(struct \\|union \\|enum \\)?[_a-zA-Z][_a-zA-Z0-9]*" nil
+     (("(libc)Function Index" nil
+       "^[ \t]+- \\(Function\\|Macro\\): .*\\<" "\\>")
+      ("(libc)Variable Index" nil
+       "^[ \t]+- \\(Variable\\|Macro\\): .*\\<" "\\>")
+      ("(libc)Type Index" nil
+       "^[ \t]+- Data Type: \\<" "\\>")
+      ("(termcap)Var Index" nil
+       "^[ \t]*`" "'"))
+     info-lookup-guess-c-symbol)
+    (m4-mode
+     "[_a-zA-Z][_a-zA-Z0-9]*" nil
+     (("(m4)Macro index"))
+     "[_a-zA-Z0-9]+")
+    (makefile-mode
+     "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*" nil
+     (("(make)Name Index" nil
+       "^[ \t]*`" "'"))
+     "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+")
+    (texinfo-mode
+     "@\\([a-zA-Z]+\\|[^a-zA-Z]\\)" nil
+     (("(texinfo)Command and Variable Index"
+       ;; Ignore Emacs commands and prepend a `@'.
+       (lambda (item)
+	 (if (string-match "^\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\( .*\\)?$" item)
+	     (concat "@" (match-string 1 item))))
+       "`" "'"))))
+  "*Alist of help specifications for symbol names.
+See the documentation of the variable `info-lookup-alist' for more details.")
+
+(defvar info-lookup-file-alist
+  '((c-mode
+     "[_a-zA-Z0-9./+-]+" nil
+     (("(libc)File Index"))))
+  "*Alist of help specifications for file names.
+See the documentation of the variable `info-lookup-alist' for more details.")
+
+;;;###autoload
+(defun info-lookup-reset ()
+  "Throw away all cached data.
+This command is useful if the user wants to start at the beginning without
+quitting Emacs, for example, after some Info documents were updated on the
+system."
+  (interactive)
+  (setq info-lookup-cache nil))
+
+;;;###autoload
+(defun info-lookup-symbol (symbol &optional mode)
+  "Display the documentation of a symbol.
+If called interactively, SYMBOL will be read from the mini-buffer.
+Prefix argument means unconditionally insert the default symbol name
+into the mini-buffer so that it can be edited.
+The default symbol is the one found at point."
+  (interactive
+   (info-lookup-interactive-arguments 'symbol))
+  (info-lookup 'symbol symbol mode))
+
+;;;###autoload
+(defun info-lookup-file (file &optional mode)
+  "Display the documentation of a file.
+If called interactively, FILE will be read from the mini-buffer.
+Prefix argument means unconditionally insert the default file name
+into the mini-buffer so that it can be edited.
+The default file name is the one found at point."
+  (interactive
+   (info-lookup-interactive-arguments 'file))
+  (info-lookup 'file file mode))
+
+(defun info-lookup-interactive-arguments (topic)
+  "Return default value and help mode for help topic TOPIC."
+  (let* ((mode (if (info-lookup->mode-value
+		    topic (or info-lookup-mode major-mode))
+		   (or info-lookup-mode major-mode)
+		 (info-lookup-change-mode topic)))
+	 (completions (info-lookup->completions topic mode))
+	 (default (info-lookup-guess-default topic mode))
+	 (input (if (or current-prefix-arg (not (assoc default completions)))
+		    default))
+	 (completion-ignore-case (info-lookup->ignore-case topic mode))
+	 (enable-recursive-minibuffers t)
+	 (value (completing-read
+		 (if (and default (not input))
+		     (format "Describe %s (default %s): " topic default)
+		   (format "Describe %s: " topic))
+		 completions nil nil input 'info-lookup-history)))
+    (list (if (equal value "") default value) mode)))
+
+(defun info-lookup-change-mode (topic)
+  (let* ((completions (mapcar (lambda (arg)
+				(cons (symbol-name (car arg)) (car arg)))
+			      (info-lookup->topic-value topic)))
+	 (mode (completing-read
+		(format "Use %s help mode: " topic)
+		completions nil t nil 'info-lookup-history)))
+    (or (setq mode (cdr (assoc mode completions)))
+	(error "No %s help available" topic))
+    (or (info-lookup->mode-value topic mode)
+	(error "No %s help available for `%s'" topic mode))
+    (setq info-lookup-mode mode)))
+
+(defun info-lookup (topic item mode)
+  "Display the documentation of a help item."
+  (if (not mode)
+      (setq mode (or info-lookup-mode major-mode)))
+  (or (info-lookup->mode-value topic mode)
+      (error "No %s help available for `%s'" topic mode))
+  (let ((entry (or (assoc (if (info-lookup->ignore-case topic mode)
+			      (downcase item) item)
+			  (info-lookup->completions topic mode))
+		   (error "Not documented as a %s: %s" topic (or item ""))))
+	(modes (info-lookup->all-modes topic mode))
+	(window (selected-window))
+	found doc-spec node prefix suffix)
+    (if (not info-lookup-other-window-flag)
+	(info)
+      (save-window-excursion (info))
+      (switch-to-buffer-other-window "*info*"))
+    (while (and (not found) modes)
+      (setq doc-spec (info-lookup->doc-spec topic (car modes)))
+      (while (and (not found) doc-spec)
+	(setq node (nth 0 (car doc-spec))
+	      prefix (nth 2 (car doc-spec))
+	      suffix (nth 3 (car doc-spec)))
+	(condition-case nil
+	    (progn
+	      (Info-goto-node node)
+	      (Info-menu (or (cdr entry) item))
+	      (setq found t)
+	      (if (or prefix suffix)
+		  (let ((case-fold-search
+			 (info-lookup->ignore-case topic (car modes)))
+			(buffer-read-only nil))
+		    (goto-char (point-min))
+		    (re-search-forward
+		     (concat prefix (regexp-quote item) suffix))
+		    (goto-char (match-beginning 0))
+		    (and window-system info-lookup-highlight-face
+			 ;; Search again for ITEM so that the first
+			 ;; occurence of ITEM will be highlighted.
+			 (re-search-forward (regexp-quote item))
+			 (let ((start (match-beginning 0))
+			       (end (match-end 0)))
+			   (if (overlayp info-lookup-highlight-overlay)
+			       (move-overlay info-lookup-highlight-overlay
+					     start end (current-buffer))
+			     (setq info-lookup-highlight-overlay
+				   (make-overlay start end))))
+			 (overlay-put info-lookup-highlight-overlay
+				      'face info-lookup-highlight-face)))))
+	  (error nil))
+	(setq doc-spec (cdr doc-spec)))
+      (setq modes (cdr modes)))
+    ;; Don't leave the Info buffer if the help item couldn't be looked up.
+    (if (and info-lookup-other-window-flag found)
+	(select-window window))))
+
+(defun info-lookup-setup-mode (topic mode)
+  "Initialize the internal data structure."
+  (or (info-lookup->initialized topic mode)
+      (let (cell data (initialized 0) completions refer-modes)
+	(if (not (info-lookup->mode-value topic mode))
+	    (message "No %s help available for `%s'" topic mode)
+	  ;; Recursively setup cross references.
+	  ;; But refer only to non-void modes.
+	  (mapcar (lambda (arg)
+		    (or (info-lookup->initialized topic arg)
+			(info-lookup-setup-mode topic arg))
+		    (and (eq (info-lookup->initialized topic arg) t)
+			 (setq refer-modes (cons arg refer-modes))))
+		  (info-lookup->other-modes topic mode))
+	  (setq refer-modes (nreverse refer-modes))
+	  ;; Build the full completion alist.
+	  (setq completions
+		(nconc (info-lookup-make-completions topic mode)
+		       (apply 'append
+			      (mapcar (lambda (arg)
+					(info-lookup->completions topic arg))
+				      refer-modes))))
+	  (setq initialized t))
+	;; Update `info-lookup-cache'.
+	(setq cell (info-lookup->mode-cache topic mode)
+	      data (list initialized completions refer-modes))
+	(if (not cell)
+	    (setcdr (info-lookup->cache topic)
+		    (cons (cons mode data) (info-lookup->topic-cache topic)))
+	  (setcdr cell data))
+	initialized)))
+
+(defun info-lookup-make-completions (topic mode)
+  "Create a unique alist from all index entries."
+  (condition-case nil
+      (let ((doc-spec (info-lookup->doc-spec topic mode))
+	    (regexp (concat "^\\(" (info-lookup->regexp topic mode)
+			    "\\)\\([ \t].*\\)?$"))
+	    node trans entry item prefix result)
+	(save-window-excursion
+	  (info)
+	  (while doc-spec
+	    (setq node (nth 0 (car doc-spec))
+		  trans (cond ((eq (nth 1 (car doc-spec)) nil)
+			       (lambda (arg)
+				 (if (string-match regexp arg)
+				     (match-string 1 arg))))
+			      ((stringp (nth 1 (car doc-spec)))
+			       (setq prefix (nth 1 (car doc-spec)))
+			       (lambda (arg)
+				 (if (string-match "^\\([^: \t\n]+\\)" arg)
+				     (concat prefix (match-string 1 arg)))))
+			      (t (nth 1 (car doc-spec)))))
+	    (message "Processing Info node \"%s\"..." node)
+	    (Info-goto-node node)
+	    (goto-char (point-min))
+	    (and (search-forward "\n* Menu:" nil t)
+		 (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
+		   (setq entry (match-string 1)
+			 item (funcall trans entry))
+		   (and (info-lookup->ignore-case topic mode)
+			(setq item (downcase item)))
+		   (and (string-equal entry item)
+			(setq entry nil))
+		   (or (assoc item result)
+		       (setq result (cons (cons item entry) result)))))
+	    (message "Processing Info node \"%s\"... done" node)
+	    (setq doc-spec (cdr doc-spec)))
+	  (Info-directory))
+	result)
+    (error nil)))
+
+(defun info-lookup-guess-default (topic mode)
+  "Pick up default item at point (with favor to look back).
+Return nil if there is nothing appropriate."
+  (let ((modes (info-lookup->all-modes topic mode))
+	(start (point)) guess whitespace)
+    (while (and (not guess) modes)
+      (setq guess (info-lookup-guess-default* topic (car modes))
+	    modes (cdr modes))
+      (goto-char start))
+    ;; Collapse whitespace characters.
+    (and guess (concat (delete nil (mapcar (lambda (ch)
+					     (if (or (char-equal ch ? )
+						     (char-equal ch ?\t)
+						     (char-equal ch ?\n))
+						 (if (not whitespace)
+						     (setq whitespace ? ))
+					       (setq whitespace nil) ch))
+					   guess))))))
+
+(defun info-lookup-guess-default* (topic mode)
+  (let ((case-fold-search (info-lookup->ignore-case topic mode))
+	(rule (or (info-lookup->parse-rule topic mode)
+		  (info-lookup->regexp topic mode)))
+	(start (point)) end regexp subexp result)
+    (if (symbolp rule)
+	(setq result (funcall rule))
+      (if (consp rule)
+	  (setq regexp (car rule)
+		subexp (cdr rule))
+	(setq regexp rule
+	      subexp 0))
+      (skip-chars-backward " \t\n") (setq end (point))
+      (while (and (re-search-backward regexp nil t)
+		  (looking-at regexp)
+		  (>= (match-end 0) end))
+	(setq result (match-string subexp)))
+      (if (not result)
+	  (progn
+	    (goto-char start)
+	    (skip-chars-forward " \t\n")
+	    (and (looking-at regexp)
+		 (setq result (match-string subexp))))))
+    result))
+
+(defun info-lookup-guess-c-symbol ()
+  "Get the C symbol at point."
+  (condition-case nil
+      (progn
+	(backward-sexp)
+	(let ((start (point)) prefix name)
+	  ;; Test for a leading `struct', `union', or `enum' keyword
+	  ;; but ignore names like `foo_struct'.
+	  (setq prefix (and (< (skip-chars-backward " \t\n") 0)
+			    (< (skip-chars-backward "_a-zA-Z0-9") 0)
+			    (looking-at "\\(struct\\|union\\|enum\\)\\s ")
+			    (concat (match-string 1) " ")))
+	  (goto-char start)
+	  (and (looking-at "[_a-zA-Z][_a-zA-Z0-9]*")
+	       (setq name (match-string 0)))
+	  ;; Caveat!  Look forward if point is at `struct' etc.
+	  (and (not prefix)
+	       (or (string-equal name "struct")
+		   (string-equal name "union")
+		   (string-equal name "enum"))
+	       (looking-at "[a-z]+\\s +\\([_a-zA-Z][_a-zA-Z0-9]*\\)")
+	       (setq prefix (concat name " ")
+		     name (match-string 1)))
+	  (and (or prefix name)
+	       (concat prefix name))))
+    (error nil)))
+
+;;;###autoload
+(defun info-complete-symbol (&optional mode)
+  "Perform completion on symbol preceding point."
+  (interactive
+   (list (if (info-lookup->mode-value
+	      'symbol (or info-lookup-mode major-mode))
+	     (or info-lookup-mode major-mode)
+	   (info-lookup-change-mode 'symbol))))
+  (info-complete 'symbol mode))
+
+;;;###autoload
+(defun info-complete-file (&optional mode)
+  "Perform completion on file preceding point."
+  (interactive
+   (list (if (info-lookup->mode-value
+	      'file (or info-lookup-mode major-mode))
+	     (or info-lookup-mode major-mode)
+	   (info-lookup-change-mode 'file))))
+  (info-complete 'file mode))
+
+(defun info-complete (topic mode)
+  "Try to complete a help item."
+  (barf-if-buffer-read-only)
+  (if (not mode)
+      (setq mode (or info-lookup-mode major-mode)))
+  (or (info-lookup->mode-value topic mode)
+      (error "No %s completion available for `%s'" topic mode))
+  (let ((modes (info-lookup->all-modes topic mode))
+	(start (point)) try completion)
+    (while (and (not try) modes)
+      (setq mode (car modes)
+	    modes (cdr modes)
+	    try (info-lookup-guess-default* topic mode))
+      (goto-char start))
+    (and (not try)
+	 (error "Found no %s to complete" topic))
+    (setq completion (try-completion
+		      try (info-lookup->completions topic mode)))
+    (cond ((not completion)
+	   (ding))
+	  ((stringp completion)
+	   (delete-region (- start (length try)) start)
+	   (insert completion)))))
+
+(provide 'info-look)
+
+;;; info-look.el ends here