(find-source-lisp-file): New function.

(describe-function-1): Use find-source-lisp-file to find source
file in compile tree.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2ec6ae659e9b035dcf73c849f12e026de630be93..e36fed254138f1d8fdc20951779a2c8f2f160741 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2007-05-22  Jan Dj\e,Ad\e(Brv  <jan.h.d@swipnet.se>
+
+       * help-fns.el (find-source-lisp-file): New function.
+       (describe-function-1): Use find-source-lisp-file to find source
+       file in compile tree.
+
 2007-05-22  Eli Zaretskii  <eliz@gnu.org>
 
        * dos-w32.el (find-buffer-file-type-coding-system): Doc fix.

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index dab6bdb157c194ce785bb5ef4e87ef2ba8ba81e3..92354624d885b5c69dbacb20ff4e3412898c7d2b 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -232,6 +232,23 @@ face (according to `face-differs-from-default-p')."
              libname)
          file))))
 
+(defun find-source-lisp-file (file-name)
+  (let* ((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))
+                 (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)))
+
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((def (if (symbolp function)
@@ -309,6 +326,10 @@ face (according to `face-differs-from-default-p')."
       ;; 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