[Emacs-diffs] Changes to emacs/lisp/help-fns.el,v

[Martin Rudalics]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Martin Rudalics <m061211>       08/09/01 08:04:41

Index: help-fns.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/help-fns.el,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -b -r1.124 -r1.125
--- help-fns.el 30 Aug 2008 03:26:03 -0000      1.124
+++ help-fns.el 1 Sep 2008 08:04:40 -0000       1.125
@@ -217,36 +217,111 @@
   ;; Return value is like the one from help-split-fundoc, but highlighted
   (cons usage doc))
 
+;; The following function was compiled from the former functions
+;; `describe-simplify-lib-file-name' and `find-source-lisp-file' with
+;; some excerpts from `describe-function-1' and `describe-variable'.
+;; The only additional twists provided are (1) locate the defining file
+;; for autoloaded functions, and (2) give preference to files in the
+;; "install directory" (directories found via `load-path') rather than
+;; to files in the "compile directory" (directories found by searching
+;; the loaddefs.el file).  We autoload it because it's also used by
+;; `describe-face' (instead of `describe-simplify-lib-file-name').
+
 ;;;###autoload
-(defun describe-simplify-lib-file-name (file)
-  "Simplify a library name FILE to a relative name, and make it a source file."
-  (if file
-      ;; Try converting the absolute file name to a library name.
-      (let ((libname (file-name-nondirectory file)))
-       ;; Now convert that back to a file name and see if we get
-       ;; the original one.  If so, they are equivalent.
-       (if (equal file (locate-file libname load-path '("")))
-           (if (string-match "[.]elc\\'" libname)
-               (substring libname 0 -1)
-             libname)
-         file))))
-
-(defun find-source-lisp-file (file-name)
-  (let* ((elc-file (locate-file (concat file-name
-                                (if (string-match "\\.el" file-name)
+(defun find-lisp-object-file-name (object type)
+  "Guess the file that defined the Lisp object OBJECT, of type TYPE.
+OBJECT should be a symbol associated with a function, variable, or face;
+  alternatively, it can be a function definition.
+If TYPE is `variable', search for a variable definition.
+If TYPE is `face', search for a face definition.
+If TYPE is the value returned by `symbol-function' for a function symbol,
+ search for a function definition.
+
+The return value is the absolute name of a readable file where OBJECT is
+defined.  If several such files exist, preference is given to a file
+found via `load-path'.  The return value can also be `C-source', which
+means that OBJECT is a function or variable defined in C.  If no
+suitable file is found, return nil."
+  (let* ((autoloaded (eq (car-safe type) 'autoload))
+        (file-name (or (and autoloaded (nth 1 type))
+                       (symbol-file
+                        object (if (memq type (list 'defvar 'defface))
+                                   type
+                                 'defun)))))
+    (cond
+     (autoloaded
+      ;; An autoloaded function: Locate the file since `symbol-function'
+      ;; has only returned a bare string here.
+      (setq file-name
+           (locate-file file-name load-path '(".el" ".elc") 'readable)))
+     ((and (stringp file-name)
+          (string-match "[.]*loaddefs.el\\'" file-name))
+      ;; An autoloaded variable or face.  Visit loaddefs.el in a buffer
+      ;; and try to extract the defining file.  The following form is
+      ;; from `describe-function-1' and `describe-variable'.
+      (let ((location
+            (condition-case nil
+                (find-function-search-for-symbol object nil file-name)
+              (error nil))))
+       (when location
+         (with-current-buffer (car location)
+           (goto-char (cdr location))
+           (when (re-search-backward
+                  "^;;; Generated autoloads from \\(.*\\)" nil t)
+             (setq file-name
+                   (locate-file
+                    (match-string-no-properties 1)
+                    load-path nil 'readable))))))))
+
+    (cond
+     ((and (not file-name) (subrp type))
+      ;; A built-in function.  The form is from `describe-function-1'.
+      (if (get-buffer " *DOC*")
+         (help-C-file-name type 'subr)
+       'C-source))
+     ((and (not file-name) (symbolp object)
+          (integerp (get object 'variable-documentation)))
+      ;; A variable defined in C.  The form is from `describe-variable'.
+      (if (get-buffer " *DOC*")
+         (help-C-file-name object 'var)
+       'C-source))
+     ((not (stringp file-name))
+      ;; If we don't have a file-name string by now, we lost.
+      nil)
+     ((let ((lib-name
+            (if (string-match "[.]elc\\'" file-name)
+                (substring-no-properties file-name 0 -1)
+              file-name)))
+       ;; When the Elisp source file can be found in the install
+       ;; directory return the name of that file - `file-name' should
+       ;; have become an absolute file name ny now.
+       (and (file-readable-p lib-name) lib-name)))
+     ((let* ((lib-name (file-name-nondirectory file-name))
+            ;; The next form is from `describe-simplify-lib-file-name'.
+            (file-name
+             ;; Try converting the absolute file name to a library
+             ;; name, convert that back to a file name and see if we
+             ;; get the original one.  If so, they are equivalent.
+             (if (equal file-name (locate-file lib-name load-path '("")))
+                 (if (string-match "[.]elc\\'" lib-name)
+                     (substring-no-properties lib-name 0 -1)
+                   lib-name)
+               file-name))
+            ;; The next three forms are from `find-source-lisp-file'.
+            (elc-file (locate-file
+                       (concat file-name
+                               (if (string-match "\\.el\\'" file-name)
                                     "c"
                                   ".elc"))
-                                load-path))
-        (str (if (and elc-file (file-readable-p elc-file))
+                       load-path nil 'readable))
+            (str (when elc-file
                  (with-temp-buffer
                    (insert-file-contents-literally elc-file nil 0 256)
                    (buffer-string))))
         (src-file (and str
                        (string-match ";;; from file \\(.*\\.el\\)" str)
                        (match-string 1 str))))
-    (if (and src-file (file-readable-p src-file))
-       src-file
-      file-name)))
+       (and src-file (file-readable-p src-file) src-file))))))
 
 (declare-function ad-get-advice-info "advice" (function))
 
@@ -258,9 +333,8 @@
         ;; real definition, if that symbol is already set up.
         (real-function
          (or (and advised
-                  (cdr (assq 'origname advised))
-                  (fboundp (cdr (assq 'origname advised)))
-                  (cdr (assq 'origname advised)))
+                  (let ((origname (cdr (assq 'origname advised))))
+                    (and (fboundp origname) origname)))
              function))
         ;; Get the real definition.
         (def (if (symbolp real-function)
@@ -292,12 +366,10 @@
                ((eq (car-safe def) 'macro)
                 "a Lisp macro")
                ((eq (car-safe def) 'autoload)
-                (setq file-name (nth 1 def))
                 (format "%s autoloaded %s"
                         (if (commandp def) "an interactive" "an")
                         (if (eq (nth 4 def) 'keymap) "keymap"
-                          (if (nth 4 def) "Lisp macro" "Lisp function"))
-                        ))
+                          (if (nth 4 def) "Lisp macro" "Lisp function"))))
                 ((keymapp def)
                  (let ((is-full nil)
                        (elts (cdr-safe def)))
@@ -316,39 +388,16 @@
       (with-current-buffer standard-output
        (save-excursion
          (save-match-data
-           (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
+           (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
                (help-xref-button 1 'help-function def)))))
-      (or file-name
-         (setq file-name (symbol-file function 'defun)))
-      (setq file-name (describe-simplify-lib-file-name file-name))
-      (when (equal file-name "loaddefs.el")
-       ;; Find the real def site of the preloaded function.
-       ;; This is necessary only for defaliases.
-       (let ((location
-              (condition-case nil
-                  (find-function-search-for-symbol function nil "loaddefs.el")
-                (error nil))))
-         (when location
-           (with-current-buffer (car location)
-             (goto-char (cdr location))
-             (when (re-search-backward
-                    "^;;; Generated autoloads from \\(.*\\)" nil t)
-               (setq file-name (match-string 1)))))))
-      (when (and (null file-name) (subrp def))
-       ;; Find the C source file name.
-       (setq file-name (if (get-buffer " *DOC*")
-                           (help-C-file-name def 'subr)
-                         'C-source)))
+
+      (setq file-name (find-lisp-object-file-name function def))
       (when file-name
        (princ " in `")
        ;; We used to add .el to the file name,
        ;; but that's completely wrong when the user used load-file.
        (princ (if (eq file-name 'C-source) "C source code" file-name))
        (princ "'")
-       ;; See if lisp files are present where they where installed from.
-       (if (not (eq file-name 'C-source))
-           (setq file-name (find-source-lisp-file file-name)))
-
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
          (save-excursion
@@ -519,6 +568,7 @@
                                (if (symbolp v) (symbol-name v))))
      (list (if (equal val "")
               v (intern val)))))
+  (let (file-name)
   (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
   (unless (frame-live-p frame) (setq frame (selected-frame)))
   (if (not (symbolp variable))
@@ -538,31 +588,8 @@
        (with-help-window (help-buffer)
          (with-current-buffer buffer
            (prin1 variable)
-           ;; Make a hyperlink to the library if appropriate.  (Don't
-           ;; change the format of the buffer's initial line in case
-           ;; anything expects the current format.)
-           (let ((file-name (symbol-file variable 'defvar)))
-             (setq file-name (describe-simplify-lib-file-name file-name))
-             (when (equal file-name "loaddefs.el")
-               ;; Find the real def site of the preloaded variable.
-               (let ((location
-                      (condition-case nil
-                          (find-variable-noselect variable file-name)
-                        (error nil))))
-                 (when location
-                   (with-current-buffer (car location)
-                     (when (cdr location)
-                       (goto-char (cdr location)))
-                     (when (re-search-backward
-                            "^;;; Generated autoloads from \\(.*\\)" nil t)
-                       (setq file-name (match-string 1)))))))
-             (when (and (null file-name)
-                        (integerp (get variable 'variable-documentation)))
-               ;; It's a variable not defined in Elisp but in C.
-               (setq file-name
-                     (if (get-buffer " *DOC*")
-                         (help-C-file-name variable 'var)
-                       'C-source)))
+             (setq file-name (find-lisp-object-file-name variable 'defvar))
+
              (if file-name
                  (progn
                    (princ " is a variable defined in `")