*** empty log message ***
[bpt/emacs.git] / lisp / info-look.el
index 8a8faff..3ae7b70 100644 (file)
@@ -1,9 +1,10 @@
 ;;; 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, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc.
 
 ;; Author: Ralph Schleicher <rs@purple.UL.BaWue.DE>
+;; Maintainers: FSF (unless Schleicher can be found)
 ;; Keywords: help languages
 
 ;; This file is part of GNU Emacs.
 ;;; Code:
 
 (require 'info)
-(eval-and-compile
-  (condition-case nil
-      (require 'custom)
-    (error
-     (defmacro defgroup (&rest arg)
-       nil)
-     (defmacro defcustom (symbol value doc &rest arg)
-       `(defvar ,symbol ,value ,doc ,@arg)))))
 
 (defgroup info-lookup nil
   "Major mode sensitive help agent."
@@ -57,6 +50,21 @@ Setting this variable to nil disables highlighting."
 (defvar info-lookup-highlight-overlay nil
   "Overlay object used for highlighting.")
 
+(defcustom info-lookup-file-name-alist
+  '(("\\`configure\\.in\\'" . autoconf-mode)
+    ("\\`aclocal\\.m4\\'" . autoconf-mode)
+    ("\\`acsite\\.m4\\'" . autoconf-mode)
+    ("\\`acinclude\\.m4\\'" . autoconf-mode))
+  "Alist of file names handled specially.
+List elements are cons cells of the form
+
+    (REGEXP . MODE)
+
+If a file name matches REGEXP, then use help mode MODE instead of the
+buffer's major mode."
+  :group 'info-lookup :type '(repeat (cons (string :tag "Regexp")
+                                          (symbol :tag "Mode"))))
+
 (defvar info-lookup-history nil
   "History of previous input lines.")
 
@@ -208,28 +216,31 @@ REFER-MODES is a list of other help modes to use.")
                 (cons (cons topic nil)
                       info-lookup-cache)))))
 
-(defsubst info-lookup->topic-cache (topic)
+(defun info-lookup->topic-cache (topic)
   (cdr (info-lookup->cache topic)))
 
-(defsubst info-lookup->mode-cache (topic mode)
+(defun info-lookup->mode-cache (topic mode)
   (assoc mode (info-lookup->topic-cache topic)))
 
-(defsubst info-lookup->initialized (topic mode)
+(defun info-lookup->initialized (topic mode)
   (nth 1 (info-lookup->mode-cache topic mode)))
 
-(defsubst info-lookup->completions (topic mode)
+(defun 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)
+(defun 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)
+(defun info-lookup->all-modes (topic mode)
   (cons mode (info-lookup->refer-modes topic mode)))
 
+(defun info-lookup-quick-all-modes (topic mode)
+  (cons mode (info-lookup->other-modes topic mode)))
+
 ;;;###autoload
 (defun info-lookup-reset ()
   "Throw away all cached data.
@@ -241,45 +252,59 @@ system."
 
 ;;;###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."
+  "Display the definition of SYMBOL, as found in the relevant manual.
+When this command is called interactively, it reads SYMBOL from the minibuffer.
+In the minibuffer, use M-n to yank the default argument value
+into the minibuffer so you can edit it.
+The default symbol is the one found at point.
+
+With prefix arg a query for the symbol help mode is offered."
   (interactive
-   (info-lookup-interactive-arguments 'symbol))
+   (info-lookup-interactive-arguments 'symbol current-prefix-arg))
   (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."
+When this command is called interactively, it reads FILE from the minibuffer.
+In the minibuffer, use M-n to yank the default file name
+into the minibuffer so you can edit it.
+The default file name is the one found at point.
+
+With prefix arg a query for the file help mode is offered."
   (interactive
-   (info-lookup-interactive-arguments 'file))
+   (info-lookup-interactive-arguments 'file current-prefix-arg))
   (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)))
+(defun info-lookup-interactive-arguments (topic &optional query)
+  "Read and return argument value (and help mode) for help topic TOPIC.
+If optional argument QUERY is non-nil, query for the help mode."
+  (let* ((mode (cond (query
+                     (info-lookup-change-mode topic))
+                    ((info-lookup->mode-value topic (info-lookup-select-mode))
+                     info-lookup-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))
+                (if default
                     (format "Describe %s (default %s): " topic default)
                   (format "Describe %s: " topic))
-                completions nil nil input 'info-lookup-history)))
+                completions nil nil nil 'info-lookup-history default)))
     (list (if (equal value "") default value) mode)))
 
+(defun info-lookup-select-mode ()
+  (when (and (not info-lookup-mode) (buffer-file-name))
+    (let ((file-name (file-name-nondirectory (buffer-file-name)))
+         (file-name-alist info-lookup-file-name-alist))
+      (while (and (not info-lookup-mode) file-name-alist)
+       (when (string-match (caar file-name-alist) file-name)
+         (setq info-lookup-mode (cdar file-name-alist)))
+       (setq file-name-alist (cdr file-name-alist)))))
+  (or info-lookup-mode (setq info-lookup-mode major-mode)))
+
 (defun info-lookup-change-mode (topic)
   (let* ((completions (mapcar (lambda (arg)
                                (cons (symbol-name (car arg)) (car arg)))
@@ -295,8 +320,7 @@ The default file name is the one found at point."
 
 (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 mode (setq mode (info-lookup-select-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)
@@ -306,7 +330,8 @@ The default file name is the one found at point."
        (modes (info-lookup->all-modes topic mode))
        (window (selected-window))
        found doc-spec node prefix suffix doc-found)
-    (if (not info-lookup-other-window-flag)
+    (if (or (not info-lookup-other-window-flag)
+           (eq (current-buffer) (get-buffer "*info*")))
        (info)
       (save-window-excursion (info))
       (switch-to-buffer-other-window "*info*"))
@@ -317,10 +342,10 @@ The default file name is the one found at point."
              prefix (nth 2 (car doc-spec))
              suffix (nth 3 (car doc-spec)))
        (when (condition-case error-data
-                 (progn 
+                 (progn
                    (Info-goto-node node)
                    (setq doc-found t))
-               (error 
+               (error
                 (message "Cannot access Info node %s" node)
                 (sit-for 1)
                 nil))
@@ -336,7 +361,7 @@ The default file name is the one found at point."
                      (re-search-forward
                       (concat prefix (regexp-quote item) suffix))
                      (goto-char (match-beginning 0))
-                     (and window-system info-lookup-highlight-face
+                     (and (display-color-p) info-lookup-highlight-face
                           ;; Search again for ITEM so that the first
                           ;; occurence of ITEM will be highlighted.
                           (re-search-forward (regexp-quote item))
@@ -375,7 +400,9 @@ The default file name is the one found at point."
          (setq refer-modes (nreverse refer-modes))
          ;; Build the full completion alist.
          (setq completions
-               (nconc (info-lookup-make-completions topic mode)
+               (nconc (condition-case nil
+                          (info-lookup-make-completions topic mode)
+                        (error nil))
                       (apply 'append
                              (mapcar (lambda (arg)
                                        (info-lookup->completions topic arg))
@@ -414,10 +441,10 @@ The default file name is the one found at point."
       (with-current-buffer buffer
        (message "Processing Info node `%s'..." node)
        (when (condition-case error-data
-                 (progn 
+                 (progn
                    (Info-goto-node node)
                    (setq doc-found t))
-               (error 
+               (error
                 (message "Cannot access Info node `%s'" node)
                 (sit-for 1)
                 nil))
@@ -428,12 +455,17 @@ The default file name is the one found at point."
                     (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))))))
+                      ;; `trans' can return nil if the regexp doesn't match.
+                      (when (and item
+                                 ;; Sometimes there's more than one Menu:
+                                 (not (string= entry "Menu")))
+                        (and (info-lookup->ignore-case topic mode)
+                             (setq item (downcase item)))
+                        (and (string-equal entry item)
+                             (setq entry nil))
+                        (and (or (assoc item result)
+                                 (setq result (cons (cons item entry)
+                                                    result))))))))
            (error nil))))
       (message "Processing Info node `%s'...done" node)
       (setq doc-spec (cdr doc-spec)))
@@ -442,54 +474,57 @@ The default file name is the one found at point."
     result))
 
 (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."
+  "Return a guess for a symbol to look up, based on text around point.
+Try all related modes applicable to TOPIC and MODE.
+Return nil if there is nothing appropriate in the buffer near point."
   (let ((modes (info-lookup->all-modes topic mode))
-       (start (point)) guess whitespace)
+       guess)
     (while (and (not guess) modes)
       (setq guess (info-lookup-guess-default* topic (car modes))
-           modes (cdr modes))
-      (goto-char start))
+           modes (cdr modes)))
     ;; 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))))))
+    (when guess
+      (let ((pos 0))
+       (while (string-match "[ \t\n]+" guess pos)
+         (setq pos (1+ (match-beginning 0)))
+         (setq guess (replace-match " " t t guess)))))
+    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))))))
+    (save-excursion
+      (if (symbolp rule)
+         (setq result (funcall rule))
+       (if (consp rule)
+           (setq regexp (car rule)
+                 subexp (cdr rule))
+         (setq regexp rule
+               subexp 0))
+       ;; If at start of symbol, don't go back to end of previous one.
+       (if (save-match-data
+             (looking-at "[ \t\n]"))
+           (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)
+       (skip-syntax-backward "w_")
        (let ((start (point)) prefix name)
          ;; Test for a leading `struct', `union', or `enum' keyword
          ;; but ignore names like `foo_struct'.
@@ -519,8 +554,8 @@ Return nil if there is nothing appropriate."
   (info-complete 'symbol
                 (or mode
                     (if (info-lookup->mode-value
-                         'symbol (or info-lookup-mode major-mode))
-                        (or info-lookup-mode major-mode)
+                         'symbol (info-lookup-select-mode))
+                        info-lookup-mode
                       (info-lookup-change-mode 'symbol)))))
 
 ;;;###autoload
@@ -530,21 +565,19 @@ Return nil if there is nothing appropriate."
   (info-complete 'file
                 (or mode
                     (if (info-lookup->mode-value
-                         'file (or info-lookup-mode major-mode))
-                        (or info-lookup-mode major-mode)
+                         'file (info-lookup-select-mode))
+                        info-lookup-mode
                       (info-lookup-change-mode 'file)))))
 
 (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 mode (setq mode (info-lookup-select-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))
-       (completions (info-lookup->completions topic mode))
-       (completion-ignore-case (info-lookup->ignore-case topic mode))
-       (start (point)) try completion)
+  (let ((modes (info-lookup-quick-all-modes topic mode))
+       (start (point))
+       try)
     (while (and (not try) modes)
       (setq mode (car modes)
            modes (cdr modes)
@@ -552,77 +585,28 @@ Return nil if there is nothing appropriate."
       (goto-char start))
     (and (not try)
         (error "Found no %S to complete" topic))
-    (setq completion (try-completion try completions))
-    (cond ((not completion)
-          (ding)
-          (message "No match"))
-         ((stringp completion)
-          (or (assoc completion completions)
-              (setq completion (completing-read
-                                (format "Complete %S: " topic)
-                                completions nil t completion
-                                info-lookup-history)))
-          (delete-region (- start (length try)) start)
-          (insert completion))
-         (t
-          (message "%s is complete" (capitalize (prin1-to-string topic)))))))
-
-\f
-;;; Info-lookup minor mode.
-
-(defvar info-lookup-minor-mode nil
-  "Non-`nil' enables Info-lookup mode.")
-(make-variable-buffer-local 'info-lookup-minor-mode)
-
-(defvar info-lookup-minor-mode-string " Info"
-  "Indicator included in the mode line when in Info-lookup mode.")
-
-(or (assq 'info-lookup-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(info-lookup-minor-mode
-                                  info-lookup-minor-mode-string)
-                                minor-mode-alist)))
-
-(defvar info-lookup-minor-mode-map (make-sparse-keymap)
-  "Minor mode map for Info-lookup mode.")
-
-(or (assq 'info-lookup-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'info-lookup-minor-mode
-                                          info-lookup-minor-mode-map)
-                                    minor-mode-map-alist)))
-
-;;;### autoload
-(defun info-lookup-minor-mode (&optional arg)
-  "Minor mode for looking up the documentation of a symbol or file.
-Special commands:
-
-\\{info-lookup-minor-mode-map}"
-  (interactive "P")
-  (setq info-lookup-minor-mode (if (null arg)
-                                  (not info-lookup-minor-mode)
-                                (> (prefix-numeric-value arg) 0)))
-  (set-buffer-modified-p (buffer-modified-p)))
-
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-hf" 'info-lookup-symbol)     ; Describe function.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-hv" 'info-lookup-symbol)     ; Describe variable.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-ht" 'info-lookup-symbol)     ; Describe type.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-hp" 'info-lookup-file)       ; Describe program.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-if" 'info-complete-symbol)   ; Complete function.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-iv" 'info-complete-symbol)   ; Complete variable.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-it" 'info-complete-symbol)   ; Complete type.
-(define-key info-lookup-minor-mode-map
-  "\C-c\C-ip" 'info-complete-file)     ; Complete program.
-
-;;;### autoload
-(defun turn-on-info-lookup ()
-  "Unconditionally turn on Info-lookup mode."
-  (info-lookup-minor-mode 1))
+    (let ((completions (info-lookup->completions topic mode))
+         (completion-ignore-case (info-lookup->ignore-case topic mode))
+         completion)
+      (setq completion (try-completion try completions))
+      (cond ((not completion)
+            (ding)
+            (message "No match"))
+           ((stringp completion)
+            (or (assoc completion completions)
+                (setq completion (completing-read
+                                  (format "Complete %S: " topic)
+                                  completions nil t completion
+                                  info-lookup-history)))
+            ;; Find the original symbol and zap it.
+            (end-of-line)
+            (while (and (search-backward try nil t)
+                        (< start (point))))
+            (replace-match "")
+            (insert completion))
+           (t
+            (message "%s is complete"
+                     (capitalize (prin1-to-string topic))))))))
 
 \f
 ;;; Initialize some common modes.
@@ -737,7 +721,7 @@ Special commands:
 (info-lookup-maybe-add-help
  :mode 'latex-mode
  :regexp "\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)"
- :doc-spec '(("(latex2e)Command Index" nil
+ :doc-spec '(("(latex)Command Index" nil
              "`" "\\({[^}]*}\\)?'")))
 
 (info-lookup-maybe-add-help
@@ -760,6 +744,35 @@ Special commands:
  :parse-rule 'ignore
  :other-modes '(emacs-lisp-mode))
 
+(info-lookup-maybe-add-help
+ :mode 'lisp-mode
+ :regexp "[^()' \t\n]+"
+ :parse-rule 'ignore
+ :other-modes '(emacs-lisp-mode))
+
+(info-lookup-maybe-add-help
+ :mode 'scheme-mode
+ :regexp "[^()' \t\n]+"
+ :ignore-case t
+ ;; Aubrey Jaffer's rendition from <URL:ftp://ftp-swiss.ai.mit.edu/pub/scm>
+ :doc-spec '(("(r5rs)Index" nil
+             "^[ \t]+- [^:]+:[ \t]*" "\\b")))
+
+(info-lookup-maybe-add-help
+ :mode 'octave-mode
+ :regexp "[_a-zA-Z0-9]+"
+ :doc-spec '(("(octave)Function Index" nil 
+             "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil)
+            ("(octave)Variable Index" nil "^ - [^:]+:[ ]+" nil)
+            ;; Catch lines of the form "xyz statement"
+            ("(octave)Concept Index"
+             (lambda (item)
+               (cond
+                ((string-match "^\\([A-Z]+\\) statement\\b" item)
+                   (match-string 1 item))
+                (t nil)))
+             nil; "^ - [^:]+:[ ]+" don't think this prefix is useful here.
+             nil)))
 \f
 (provide 'info-look)