X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..aad4679e7ddbc55a998a4b1111b0cc8c5d3a359f:/lisp/help-mode.el

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 83313fdc51..9d10d5170b 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,10 +1,11 @@
 ;;; help-mode.el --- `help-mode' used by *Help* buffers
 
 ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
-;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -202,6 +203,22 @@ The format is (FUNCTION ARGS...).")
 		       (message "Unable to find location in file"))))
   'help-echo (purecopy "mouse-2, RET: find function's definition"))
 
+(define-button-type 'help-function-cmacro
+  :supertype 'help-xref
+  'help-function (lambda (fun file)
+		   (setq file (locate-library file t))
+		   (if (and file (file-readable-p file))
+		       (progn
+			 (pop-to-buffer (find-file-noselect file))
+			 (goto-char (point-min))
+			 (if (re-search-forward
+			      (format "^[ \t]*(define-compiler-macro[ \t]+%s"
+				      (regexp-quote (symbol-name fun))) nil t)
+			     (forward-line 0)
+			   (message "Unable to find location in file")))
+		     (message "Unable to find file")))
+  'help-echo (purecopy "mouse-2, RET: find function's compiler macro"))
+
 (define-button-type 'help-variable-def
   :supertype 'help-xref
   'help-function (lambda (var &optional file)
@@ -228,6 +245,16 @@ The format is (FUNCTION ARGS...).")
 		       (message "Unable to find location in file"))))
   'help-echo (purecopy "mouse-2, RET: find face's definition"))
 
+(define-button-type 'help-package
+  :supertype 'help-xref
+  'help-function 'describe-package
+  'help-echo (purecopy "mouse-2, RET: Describe package"))
+
+(define-button-type 'help-package-def
+  :supertype 'help-xref
+  'help-function (lambda (file) (dired file))
+  'help-echo (purecopy "mouse-2, RET: visit package directory"))
+
 
 ;;;###autoload
 (defun help-mode ()
@@ -256,6 +283,9 @@ Commands:
 	  (with-current-buffer buffer
 	    (bury-buffer))))
 
+  (set (make-local-variable 'revert-buffer-function)
+       'help-mode-revert-buffer)
+
   (run-mode-hooks 'help-mode-hook))
 
 ;;;###autoload
@@ -358,6 +388,11 @@ restore it properly when going back."
 
 ;;;###autoload
 (defun help-buffer ()
+  "Return the name of a buffer for inserting help.
+If `help-xref-following' is non-nil, this is the name of the
+current buffer.
+Otherwise, it is *Help*; if no buffer with that name currently
+exists, it is created."
   (buffer-name				;for with-output-to-temp-buffer
    (if help-xref-following
        (current-buffer)
@@ -392,170 +427,172 @@ A special reference `back' is made to return back through a stack of
 help buffers.  Variable `help-back-label' specifies the text for
 that."
   (interactive "b")
-  (save-excursion
-    (set-buffer (or buffer (current-buffer)))
-    (goto-char (point-min))
-    ;; Skip the header-type info, though it might be useful to parse
-    ;; it at some stage (e.g. "function in `library'").
-    (forward-paragraph)
-    (let ((old-modified (buffer-modified-p)))
-      (let ((stab (syntax-table))
-            (case-fold-search t)
-            (inhibit-read-only t))
-        (set-syntax-table emacs-lisp-mode-syntax-table)
-        ;; The following should probably be abstracted out.
-        (unwind-protect
-            (progn
-              ;; Info references
-              (save-excursion
-                (while (re-search-forward help-xref-info-regexp nil t)
-                  (let ((data (match-string 2)))
-		    (save-match-data
-		      (unless (string-match "^([^)]+)" data)
-			(setq data (concat "(emacs)" data))))
-		    (help-xref-button 2 'help-info data))))
-              ;; URLs
-              (save-excursion
-                (while (re-search-forward help-xref-url-regexp nil t)
-                  (let ((data (match-string 1)))
-		    (help-xref-button 1 'help-url data))))
-	      ;; Mule related keywords.  Do this before trying
-	      ;; `help-xref-symbol-regexp' because some of Mule
-	      ;; keywords have variable or function definitions.
-	      (if help-xref-mule-regexp
-		  (save-excursion
-		    (while (re-search-forward help-xref-mule-regexp nil t)
-		      (let* ((data (match-string 7))
-			     (sym (intern-soft data)))
-			(cond
-			 ((match-string 3) ; coding system
-			  (and sym (coding-system-p sym)
-			       (help-xref-button 6 'help-coding-system sym)))
-			 ((match-string 4) ; input method
-			  (and (assoc data input-method-alist)
-			       (help-xref-button 7 'help-input-method data)))
-			 ((or (match-string 5) (match-string 6)) ; charset
-			  (and sym (charsetp sym)
-			       (help-xref-button 7 'help-character-set sym)))
-			 ((assoc data input-method-alist)
-			  (help-xref-button 7 'help-character-set data))
-			 ((and sym (coding-system-p sym))
-			  (help-xref-button 7 'help-coding-system sym))
-			 ((and sym (charsetp sym))
-			  (help-xref-button 7 'help-character-set sym)))))))
-              ;; Quoted symbols
-              (save-excursion
-                (while (re-search-forward help-xref-symbol-regexp nil t)
-                  (let* ((data (match-string 8))
-                         (sym (intern-soft data)))
-                    (if sym
-                        (cond
-                         ((match-string 3)  ; `variable' &c
-                          (and (or (boundp sym) ; `variable' doesn't ensure
+  (with-current-buffer (or buffer (current-buffer))
+    (save-excursion
+      (goto-char (point-min))
+      ;; Skip the header-type info, though it might be useful to parse
+      ;; it at some stage (e.g. "function in `library'").
+      (forward-paragraph)
+      (let ((old-modified (buffer-modified-p)))
+        (let ((stab (syntax-table))
+              (case-fold-search t)
+              (inhibit-read-only t))
+          (set-syntax-table emacs-lisp-mode-syntax-table)
+          ;; The following should probably be abstracted out.
+          (unwind-protect
+              (progn
+                ;; Info references
+                (save-excursion
+                  (while (re-search-forward help-xref-info-regexp nil t)
+                    (let ((data (match-string 2)))
+                      (save-match-data
+                        (unless (string-match "^([^)]+)" data)
+                          (setq data (concat "(emacs)" data)))
+			(setq data ;; possible newlines if para filled
+			      (replace-regexp-in-string "[ \t\n]+" " " data t t)))
+                      (help-xref-button 2 'help-info data))))
+                ;; URLs
+                (save-excursion
+                  (while (re-search-forward help-xref-url-regexp nil t)
+                    (let ((data (match-string 1)))
+                      (help-xref-button 1 'help-url data))))
+                ;; Mule related keywords.  Do this before trying
+                ;; `help-xref-symbol-regexp' because some of Mule
+                ;; keywords have variable or function definitions.
+                (if help-xref-mule-regexp
+                    (save-excursion
+                      (while (re-search-forward help-xref-mule-regexp nil t)
+                        (let* ((data (match-string 7))
+                               (sym (intern-soft data)))
+                          (cond
+                           ((match-string 3) ; coding system
+                            (and sym (coding-system-p sym)
+                                 (help-xref-button 6 'help-coding-system sym)))
+                           ((match-string 4) ; input method
+                            (and (assoc data input-method-alist)
+                                 (help-xref-button 7 'help-input-method data)))
+                           ((or (match-string 5) (match-string 6)) ; charset
+                            (and sym (charsetp sym)
+                                 (help-xref-button 7 'help-character-set sym)))
+                           ((assoc data input-method-alist)
+                            (help-xref-button 7 'help-character-set data))
+                           ((and sym (coding-system-p sym))
+                            (help-xref-button 7 'help-coding-system sym))
+                           ((and sym (charsetp sym))
+                            (help-xref-button 7 'help-character-set sym)))))))
+                ;; Quoted symbols
+                (save-excursion
+                  (while (re-search-forward help-xref-symbol-regexp nil t)
+                    (let* ((data (match-string 8))
+                           (sym (intern-soft data)))
+                      (if sym
+                          (cond
+                           ((match-string 3) ; `variable' &c
+                            (and (or (boundp sym) ; `variable' doesn't ensure
                                         ; it's actually bound
-				   (get sym 'variable-documentation))
-                               (help-xref-button 8 'help-variable sym)))
-                         ((match-string 4)   ; `function' &c
-                          (and (fboundp sym) ; similarly
-                               (help-xref-button 8 'help-function sym)))
-			 ((match-string 5) ; `face'
-			  (and (facep sym)
-			       (help-xref-button 8 'help-face sym)))
-                         ((match-string 6)) ; nothing for `symbol'
-			 ((match-string 7)
-;;;  this used:
-;;; 			  #'(lambda (arg)
-;;; 			      (let ((location
-;;; 				     (find-function-noselect arg)))
-;;; 				(pop-to-buffer (car location))
-;;; 				(goto-char (cdr location))))
-			  (help-xref-button 8 'help-function-def sym))
-			 ((and
-                           (facep sym)
-                           (save-match-data (looking-at "[ \t\n]+face\\W")))
-                          (help-xref-button 8 'help-face sym))
-                         ((and (or (boundp sym)
-				   (get sym 'variable-documentation))
-			       (fboundp sym))
-                          ;; We can't intuit whether to use the
-                          ;; variable or function doc -- supply both.
-                          (help-xref-button 8 'help-symbol sym))
-                         ((and
-			   (or (boundp sym)
-			       (get sym 'variable-documentation))
- 			   (or
- 			    (documentation-property
- 			     sym 'variable-documentation)
- 			    (condition-case nil
- 				(documentation-property
- 				 (indirect-variable sym)
- 				 'variable-documentation)
- 			      (cyclic-variable-indirection nil))))
-			  (help-xref-button 8 'help-variable sym))
-			 ((fboundp sym)
-			  (help-xref-button 8 'help-function sym)))))))
-              ;; An obvious case of a key substitution:
-              (save-excursion
-                (while (re-search-forward
-                        ;; Assume command name is only word and symbol
-                        ;; characters to get things like `use M-x foo->bar'.
-                        ;; Command required to end with word constituent
-                        ;; to avoid `.' at end of a sentence.
-                        "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
-                  (let ((sym (intern-soft (match-string 1))))
-                    (if (fboundp sym)
-                        (help-xref-button 1 'help-function sym)))))
-              ;; Look for commands in whole keymap substitutions:
-              (save-excursion
-		;; Make sure to find the first keymap.
-		(goto-char (point-min))
-                ;; Find a header and the column at which the command
-                ;; name will be found.
-
-		;; If the keymap substitution isn't the last thing in
-		;; the doc string, and if there is anything on the
-		;; same line after it, this code won't recognize the end of it.
-                (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
-                                          nil t)
-                  (let ((col (- (match-end 1) (match-beginning 1))))
-                    (while
-                        (and (not (eobp))
-			     ;; Stop at a pair of blank lines.
-			     (not (looking-at "\n\\s-*\n")))
-		      ;; Skip a single blank line.
-		      (and (eolp) (forward-line))
-		      (end-of-line)
-		      (skip-chars-backward "^ \t\n")
-		      (if (and (>= (current-column) col)
-			       (looking-at "\\(\\sw\\|\\s_\\)+$"))
-			  (let ((sym (intern-soft (match-string 0))))
-			    (if (fboundp sym)
-				(help-xref-button 0 'help-function sym))))
-		      (forward-line))))))
-	  (set-syntax-table stab))
-	;; Delete extraneous newlines at the end of the docstring
-	(goto-char (point-max))
-	(while (and (not (bobp)) (bolp))
-	  (delete-char -1))
-        (insert "\n")
-	(when (or help-xref-stack help-xref-forward-stack)
-          (insert "\n"))
-        ;; Make a back-reference in this buffer if appropriate.
-        (when help-xref-stack
-	  (help-insert-xref-button help-back-label 'help-back
-				   (current-buffer)))
-        ;; Make a forward-reference in this buffer if appropriate.
-        (when help-xref-forward-stack
-	  (when help-xref-stack
-	    (insert "\t"))
-	  (help-insert-xref-button help-forward-label 'help-forward
-				   (current-buffer)))
-	(when (or help-xref-stack help-xref-forward-stack)
-          (insert "\n")))
-      ;; View mode steals RET from us.
-      (set (make-local-variable 'minor-mode-overriding-map-alist)
-           (list (cons 'view-mode help-xref-override-view-map)))
-      (set-buffer-modified-p old-modified))))
+                                     (get sym 'variable-documentation))
+                                 (help-xref-button 8 'help-variable sym)))
+                           ((match-string 4) ; `function' &c
+                            (and (fboundp sym) ; similarly
+                                 (help-xref-button 8 'help-function sym)))
+                           ((match-string 5) ; `face'
+                            (and (facep sym)
+                                 (help-xref-button 8 'help-face sym)))
+                           ((match-string 6)) ; nothing for `symbol'
+                           ((match-string 7)
+                            ;; this used:
+                            ;; #'(lambda (arg)
+                            ;;     (let ((location
+                            ;;            (find-function-noselect arg)))
+                            ;;       (pop-to-buffer (car location))
+                            ;; 	(goto-char (cdr location))))
+                            (help-xref-button 8 'help-function-def sym))
+                           ((and
+                             (facep sym)
+                             (save-match-data (looking-at "[ \t\n]+face\\W")))
+                            (help-xref-button 8 'help-face sym))
+                           ((and (or (boundp sym)
+                                     (get sym 'variable-documentation))
+                                 (fboundp sym))
+                            ;; We can't intuit whether to use the
+                            ;; variable or function doc -- supply both.
+                            (help-xref-button 8 'help-symbol sym))
+                           ((and
+                             (or (boundp sym)
+                                 (get sym 'variable-documentation))
+                             (or
+                              (documentation-property
+                               sym 'variable-documentation)
+                              (condition-case nil
+                                  (documentation-property
+                                   (indirect-variable sym)
+                                   'variable-documentation)
+                                (cyclic-variable-indirection nil))))
+                            (help-xref-button 8 'help-variable sym))
+                           ((fboundp sym)
+                            (help-xref-button 8 'help-function sym)))))))
+                ;; An obvious case of a key substitution:
+                (save-excursion
+                  (while (re-search-forward
+                          ;; Assume command name is only word and symbol
+                          ;; characters to get things like `use M-x foo->bar'.
+                          ;; Command required to end with word constituent
+                          ;; to avoid `.' at end of a sentence.
+                          "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
+                    (let ((sym (intern-soft (match-string 1))))
+                      (if (fboundp sym)
+                          (help-xref-button 1 'help-function sym)))))
+                ;; Look for commands in whole keymap substitutions:
+                (save-excursion
+                  ;; Make sure to find the first keymap.
+                  (goto-char (point-min))
+                  ;; Find a header and the column at which the command
+                  ;; name will be found.
+
+                  ;; If the keymap substitution isn't the last thing in
+                  ;; the doc string, and if there is anything on the same
+                  ;; line after it, this code won't recognize the end of it.
+                  (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
+                                            nil t)
+                    (let ((col (- (match-end 1) (match-beginning 1))))
+                      (while
+                          (and (not (eobp))
+                               ;; Stop at a pair of blank lines.
+                               (not (looking-at "\n\\s-*\n")))
+                        ;; Skip a single blank line.
+                        (and (eolp) (forward-line))
+                        (end-of-line)
+                        (skip-chars-backward "^ \t\n")
+                        (if (and (>= (current-column) col)
+                                 (looking-at "\\(\\sw\\|\\s_\\)+$"))
+                            (let ((sym (intern-soft (match-string 0))))
+                              (if (fboundp sym)
+                                  (help-xref-button 0 'help-function sym))))
+                        (forward-line))))))
+            (set-syntax-table stab))
+          ;; Delete extraneous newlines at the end of the docstring
+          (goto-char (point-max))
+          (while (and (not (bobp)) (bolp))
+            (delete-char -1))
+          (insert "\n")
+          (when (or help-xref-stack help-xref-forward-stack)
+            (insert "\n"))
+          ;; Make a back-reference in this buffer if appropriate.
+          (when help-xref-stack
+            (help-insert-xref-button help-back-label 'help-back
+                                     (current-buffer)))
+          ;; Make a forward-reference in this buffer if appropriate.
+          (when help-xref-forward-stack
+            (when help-xref-stack
+              (insert "\t"))
+            (help-insert-xref-button help-forward-label 'help-forward
+                                     (current-buffer)))
+          (when (or help-xref-stack help-xref-forward-stack)
+            (insert "\n")))
+        ;; View mode steals RET from us.
+        (set (make-local-variable 'minor-mode-overriding-map-alist)
+             (list (cons 'view-mode help-xref-override-view-map)))
+        (set-buffer-modified-p old-modified)))))
 
 ;;;###autoload
 (defun help-xref-button (match-number type &rest args)
@@ -760,6 +797,17 @@ Show all docs for that symbol as either a variable, function or face."
 	      (fboundp sym) (facep sym))
       (help-do-xref pos #'help-xref-interned (list sym)))))
 
+(defun help-mode-revert-buffer (ignore-auto noconfirm)
+  (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
+    (let ((pos (point))
+	  (item help-xref-stack-item)
+	  ;; Pretend there is no current item to add to the history.
+	  (help-xref-stack-item nil)
+	  ;; Use the current buffer.
+	  (help-xref-following t))
+      (apply (car item) (cdr item))
+      (goto-char pos))))
+
 (defun help-insert-string (string)
   "Insert STRING to the help buffer and install xref info for it.
 This function can be used to restore the old contents of the help buffer