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