]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / help-fns.el
index 0643b85672ca4564e960079ca2c14528d7b01e6f..d251ab0e3496b904a9c342a93ee10a99be57138f 100644 (file)
@@ -1,17 +1,17 @@
 ;;; help-fns.el --- Complex help functions
 
 ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001,
-;;   2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -19,9 +19,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -151,9 +149,11 @@ KIND should be `var' for a variable or `subr' for a subroutine."
                          (if (member file build-files)
                              (throw 'loop file)
                            (goto-char pnt))))))))
-       (if (string-match "\\.\\(o\\|obj\\)\\'" file)
-           (setq file (replace-match ".c" t t file)))
-       (if (string-match "\\.c\\'" file)
+       (if (string-match "^ns.*\\(\\.o\\|obj\\)\\'" file)
+           (setq file (replace-match ".m" t t file 1))
+         (if (string-match "\\.\\(o\\|obj\\)\\'" file)
+             (setq file (replace-match ".c" t t file))))
+       (if (string-match "\\.\\(c\\|m\\)\\'" file)
            (concat "src/" file)
          file)))))
 
@@ -248,11 +248,12 @@ face (according to `face-differs-from-default-p')."
        src-file
       file-name)))
 
-(declare-function ad-get-advice-info "emacs-lisp/advice" (function))
+(declare-function ad-get-advice-info "advice" (function))
 
 ;;;###autoload
 (defun describe-function-1 (function)
-  (let* ((advised (and (featurep 'advice) (ad-get-advice-info function)))
+  (let* ((advised (and (symbolp function) (featurep 'advice)
+                      (ad-get-advice-info function)))
         ;; If the function is advised, use the symbol that has the
         ;; real definition, if that symbol is already set up.
         (real-function
@@ -266,7 +267,8 @@ face (according to `face-differs-from-default-p')."
                  (symbol-function real-function)
                function))
         file-name string
-        (beg (if (commandp def) "an interactive " "a ")))
+        (beg (if (commandp def) "an interactive " "a "))
+         (pt1 (with-current-buffer (help-buffer) (point))))
     (setq string
          (cond ((or (stringp def)
                     (vectorp def))
@@ -347,8 +349,12 @@ face (according to `face-differs-from-default-p')."
          (re-search-backward "`\\([^`']+\\)'" nil t)
          (help-xref-button 1 'help-function-def real-function file-name))))
     (princ ".")
-    (terpri)
+    (with-current-buffer (help-buffer)
+      (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
+                                (point)))
+    (terpri)(terpri)
     (when (commandp function)
+      (let ((pt2 (with-current-buffer (help-buffer) (point))))
       (if (and (eq function 'self-insert-command)
               (eq (key-binding "a") 'self-insert-command)
               (eq (key-binding "b") 'self-insert-command)
@@ -368,7 +374,7 @@ face (according to `face-differs-from-default-p')."
            (princ "'"))
 
          (when keys
-           (princ (if remapped " which is bound to " "It is bound to "))
+              (princ (if remapped ", which is bound to " "It is bound to "))
            ;; If lots of ordinary text characters run this command,
            ;; don't mention them one by one.
            (if (< (length non-modified-keys) 10)
@@ -382,13 +388,15 @@ face (according to `face-differs-from-default-p')."
                (princ "many ordinary text characters"))))
          (when (or remapped keys non-modified-keys)
            (princ ".")
-           (terpri)))))
+              (terpri))))
+        (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 (point)))
+        (terpri)))
     (let* ((arglist (help-function-arglist def))
           (doc (documentation function))
           (usage (help-split-fundoc doc function)))
       (with-current-buffer standard-output
         ;; If definition is a keymap, skip arglist note.
-        (unless (keymapp def)
+        (unless (keymapp function)
           (let* ((use (cond
                         (usage (setq doc (cdr usage)) (car usage))
                         ((listp arglist)
@@ -413,18 +421,19 @@ face (according to `face-differs-from-default-p')."
              (insert (car high) "\n")
              (fill-region fill-begin (point)))
             (setq doc (cdr high))))
-        (let ((obsolete (and
-                         ;; function might be a lambda construct.
-                         (symbolp function)
-                         (get function 'byte-obsolete-info))))
+        (let* ((obsolete (and
+                         ;; function might be a lambda construct.
+                         (symbolp function)
+                         (get function 'byte-obsolete-info)))
+              (use (car obsolete)))
           (when obsolete
             (princ "\nThis function is obsolete")
             (when (nth 2 obsolete)
               (insert (format " since %s" (nth 2 obsolete))))
-            (insert ";\n"
-                    (if (stringp (car obsolete)) (car obsolete)
-                      (format "use `%s' instead." (car obsolete)))
-                    "\n"))
+           (insert (cond ((stringp use) (concat ";\n" use))
+                         (use (format ";\nuse `%s' instead." use))
+                         (t "."))
+                   "\n"))
           (insert "\n"
                   (or doc "Not documented.")))))))
 
@@ -436,8 +445,8 @@ face (according to `face-differs-from-default-p')."
   "Return the bound variable symbol found at or before point.
 Return 0 if there is no such symbol.
 If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
-  (or (condition-case ()
-         (with-syntax-table emacs-lisp-mode-syntax-table
+  (with-syntax-table emacs-lisp-mode-syntax-table
+    (or (condition-case ()
            (save-excursion
              (or (not (zerop (skip-syntax-backward "_w")))
                  (eq (char-syntax (following-char)) ?w)
@@ -445,17 +454,17 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
                  (forward-sexp -1))
              (skip-chars-forward "'")
              (let ((obj (read (current-buffer))))
-               (and (symbolp obj) (boundp obj) obj))))
-       (error nil))
-      (let* ((str (find-tag-default))
-            (sym (if str (intern-soft str))))
-       (if (and sym (or any-symbol (boundp sym)))
-           sym
-         (save-match-data
-           (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
-             (setq sym (intern-soft (match-string 1 str)))
-             (and (or any-symbol (boundp sym)) sym)))))
-      0))
+               (and (symbolp obj) (boundp obj) obj)))
+          (error nil))
+        (let* ((str (find-tag-default))
+               (sym (if str (intern-soft str))))
+          (if (and sym (or any-symbol (boundp sym)))
+              sym
+            (save-match-data
+              (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
+                (setq sym (intern-soft (match-string 1 str)))
+                (and (or any-symbol (boundp sym)) sym)))))
+        0)))
 
 (defun describe-variable-custom-version-info (variable)
   (let ((custom-version (get variable 'custom-version))
@@ -467,7 +476,9 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
                      custom-version))
       (when cpv
        (let* ((package (car-safe cpv))
-              (version (car (cdr-safe cpv)))
+              (version (if (listp (cdr-safe cpv))
+                           (car (cdr-safe cpv))
+                         (cdr-safe cpv)))
               (pkg-versions (assq package customize-package-emacs-version-alist))
               (emacsv (cdr (assoc version pkg-versions))))
          (if (and package version)
@@ -628,9 +639,10 @@ it is displayed along with the global value."
             (terpri)
 
             (let* ((alias (condition-case nil
-                             (indirect-variable variable)
-                           (error variable)))
+                              (indirect-variable variable)
+                            (error variable)))
                    (obsolete (get variable 'byte-obsolete-variable))
+                  (use (car obsolete))
                   (safe-var (get variable 'safe-local-variable))
                    (doc (or (documentation-property variable 'variable-documentation)
                             (documentation-property alias 'variable-documentation)))
@@ -652,9 +664,9 @@ it is displayed along with the global value."
                 (setq extra-line t)
                 (princ "  This variable is obsolete")
                 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
-                (princ ";\n  ")
-                (princ (if (stringp (car obsolete)) (car obsolete)
-                         (format "use `%s' instead." (car obsolete))))
+               (princ (cond ((stringp use) (concat ";\n  " use))
+                            (use (format ";\n  use `%s' instead." (car obsolete)))
+                            (t ".")))
                 (terpri))
              (when safe-var
                 (setq extra-line t)
@@ -668,6 +680,7 @@ it is displayed along with the global value."
              (princ "Documentation:\n")
              (with-current-buffer standard-output
                (insert (or doc "Not documented as a variable."))))
+
            ;; Make a link to customize if this variable can be customized.
            (when (custom-variable-p variable)
              (let ((customize-label "customize"))