Fix for bugs #587, #669, and #690

[martin rudalics]

Attached find an attempt to fix bugs #587, #669, and #690.  Please try
it and report errors immediately.


Note for bug #669.  With Drew's recipe

> emacs -Q
>
> (defun foo (&optional predicate)
>   "" (interactive) (message "FOO"))
>
> (defalias 'lisp-complete-symbol (symbol-function 'foo))
>
> C-h k then shows this, which is 100% wrong:
>
> M-TAB (translated from <escape> <tab>) runs the command
> lisp-complete-symbol, which is an interactive Lisp function in
> `lisp.el'.
>
> It is bound to M-TAB.
>
> (lisp-complete-symbol &optional predicate)

the bug is fixed iff the defs come from a file you load before or you do
an `eval-buffer' before C-h k.  The bug is not fixed if you simply do
C-x C-e for the defs since this won't modify `load-history'.

Thank you, martin

*** help-fns.el.~1.123.~        2008-07-28 15:19:09.000000000 +0200
--- help-fns.el 2008-08-16 12:31:45.312500000 +0200
***************
*** 217,252 ****
    ;; Return value is like the one from help-split-fundoc, but highlighted
    (cons usage doc))
  
  ;;;###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)
!                                    "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)))
  
  (declare-function ad-get-advice-info "advice" (function))
  
--- 217,329 ----
    ;; 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-rationalize-file-name (object def)
!   "Return rational file name for object OBJECT and def DEF.
! This function tries to guess the most rational file name where
! the argument of `describe-function', `describe-variable', or
! `describe-face' was defined.  OBJECT must be either the function
! argument of `describe-function', the variable argument of
! `describe-variable', or the face argument of `describe-face'.
! Accordingly, DEF must be the value for `def' calculated by
! `describe-function', 'defvar for `describe-variable', and
! 'defface for `describe-face'.
! 
! 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 may be
! the constant 'C-source when OBJECT is a function or variable
! defined in C.  The value is nil when no suitable file was found."
!   (let* ((autoloaded (eq (car-safe def) 'autoload))
!        (file-name (or (and autoloaded (nth 1 def))
!                       (symbol-file
!                        object (if (memq def (list 'defvar 'defface))
!                                   def
!                                 'defun)))))
!     (cond
!      (autoloaded
!       ;; An autoloaded function: Locate the file since `symbol-file' 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 def))
!       ;; A built-in function.  The form is from `describe-function-1'.
!       (if (get-buffer " *DOC*")
!         (help-C-file-name def '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 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))))
!       (and src-file (file-readable-p src-file) src-file))))))
  
  (declare-function ad-get-advice-info "advice" (function))
  
***************
*** 288,299 ****
                ((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"))
!                        ))
                  ((keymapp def)
                   (let ((is-full nil)
                         (elts (cdr-safe def)))
--- 365,374 ----
                ((eq (car-safe def) 'macro)
                 "a Lisp macro")
                ((eq (car-safe def) 'autoload)
                 (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"))))
                  ((keymapp def)
                   (let ((is-full nil)
                         (elts (cdr-safe def)))
***************
*** 310,348 ****
      (with-current-buffer standard-output
        (save-excursion
        (save-match-data
!         (if (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)))
      (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
--- 385,400 ----
      (with-current-buffer standard-output
        (save-excursion
        (save-match-data
!         (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
!           (help-xref-button 1 'help-function def)))))
! 
!     (setq file-name (describe-rationalize-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 "'")
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
          (save-excursion
***************
*** 355,393 ****
      (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)
!              (eq (key-binding "c") 'self-insert-command))
!         (princ "It is bound to many ordinary text characters.\n")
!       (let* ((remapped (command-remapping function))
!              (keys (where-is-internal
!                     (or remapped function) overriding-local-map nil nil))
!              non-modified-keys)
!         ;; Which non-control non-meta keys run this command?
!         (dolist (key keys)
!           (if (member (event-modifiers (aref key 0)) '(nil (shift)))
!               (push key non-modified-keys)))
!         (when remapped
!           (princ "It is remapped to `")
!           (princ (symbol-name remapped))
!           (princ "'"))
  
!         (when keys
                (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)
!               (princ (mapconcat 'key-description keys ", "))
!             (dolist (key non-modified-keys)
!               (setq keys (delq key keys)))
!             (if keys
!                 (progn
!                   (princ (mapconcat 'key-description keys ", "))
!                   (princ ", and many ordinary text characters"))
!               (princ "many ordinary text characters"))))
!         (when (or remapped keys non-modified-keys)
!           (princ ".")
                (terpri))))
          (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 
(point)))
          (terpri)))
--- 407,445 ----
      (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)
!                (eq (key-binding "c") 'self-insert-command))
!           (princ "It is bound to many ordinary text characters.\n")
!         (let* ((remapped (command-remapping function))
!                (keys (where-is-internal
!                       (or remapped function) overriding-local-map nil nil))
!                non-modified-keys)
!           ;; Which non-control non-meta keys run this command?
!           (dolist (key keys)
!             (if (member (event-modifiers (aref key 0)) '(nil (shift)))
!                 (push key non-modified-keys)))
!           (when remapped
!             (princ "It is remapped to `")
!             (princ (symbol-name remapped))
!             (princ "'"))
  
!           (when keys
                (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)
!                 (princ (mapconcat 'key-description keys ", "))
!               (dolist (key non-modified-keys)
!                 (setq keys (delq key keys)))
!               (if keys
!                   (progn
!                     (princ (mapconcat 'key-description keys ", "))
!                     (princ ", and many ordinary text characters"))
!                 (princ "many ordinary text characters"))))
!           (when (or remapped keys non-modified-keys)
!             (princ ".")
                (terpri))))
          (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 
(point)))
          (terpri)))
***************
*** 398,421 ****
          ;; If definition is a keymap, skip arglist note.
          (unless (keymapp function)
            (let* ((use (cond
!                         (usage (setq doc (cdr usage)) (car usage))
!                         ((listp arglist)
!                          (format "%S" (help-make-usage function arglist)))
!                         ((stringp arglist) arglist)
!                         ;; Maybe the arglist is in the docstring of a symbol
!                       ;; this one is aliased to.
!                         ((let ((fun real-function))
!                            (while (and (symbolp fun)
!                                        (setq fun (symbol-function fun))
!                                        (not (setq usage (help-split-fundoc
!                                                          (documentation fun)
!                                                          function)))))
!                            usage)
!                          (car usage))
!                         ((or (stringp def)
!                              (vectorp def))
!                          (format "\nMacro: %s" (format-kbd-macro def)))
!                         (t "[Missing arglist.  Please make a bug report.]")))
                   (high (help-highlight-arguments use doc)))
              (let ((fill-begin (point)))
              (insert (car high) "\n")
--- 450,473 ----
          ;; If definition is a keymap, skip arglist note.
          (unless (keymapp function)
            (let* ((use (cond
!                      (usage (setq doc (cdr usage)) (car usage))
!                      ((listp arglist)
!                       (format "%S" (help-make-usage function arglist)))
!                      ((stringp arglist) arglist)
!                      ;; Maybe the arglist is in the docstring of a symbol
!                      ;; this one is aliased to.
!                      ((let ((fun real-function))
!                         (while (and (symbolp fun)
!                                     (setq fun (symbol-function fun))
!                                     (not (setq usage (help-split-fundoc
!                                                       (documentation fun)
!                                                       function)))))
!                         usage)
!                       (car usage))
!                      ((or (stringp def)
!                           (vectorp def))
!                       (format "\nMacro: %s" (format-kbd-macro def)))
!                      (t "[Missing arglist.  Please make a bug report.]")))
                   (high (help-highlight-arguments use doc)))
              (let ((fill-begin (point)))
              (insert (car high) "\n")
***************
*** 513,562 ****
                                (if (symbolp v) (symbol-name v))))
       (list (if (equal val "")
               v (intern val)))))
!   (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
!   (unless (frame-live-p frame) (setq frame (selected-frame)))
!   (if (not (symbolp variable))
!       (message "You did not specify a variable")
!     (save-excursion
!       (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
!           val val-start-pos locus)
!       ;; Extract the value before setting up the output buffer,
!       ;; in case `buffer' *is* the output buffer.
!       (unless valvoid
!         (with-selected-frame frame
            (with-current-buffer buffer
!             (setq val (symbol-value variable)
!                   locus (variable-binding-locus variable)))))
!       (help-setup-xref (list #'describe-variable variable buffer)
!                        (interactive-p))
!       (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)))
              (if file-name
                  (progn
                    (princ " is a variable defined in `")
--- 565,592 ----
                                (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))
!       (message "You did not specify a variable")
!       (save-excursion
!       (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
!             val val-start-pos locus)
!         ;; Extract the value before setting up the output buffer,
!         ;; in case `buffer' *is* the output buffer.
!         (unless valvoid
!           (with-selected-frame frame
!             (with-current-buffer buffer
!               (setq val (symbol-value variable)
!                     locus (variable-binding-locus variable)))))
!         (help-setup-xref (list #'describe-variable variable buffer)
!                          (interactive-p))
!         (with-help-window (help-buffer)
            (with-current-buffer buffer
!             (prin1 variable)
!             (setq file-name (describe-rationalize-file-name variable 'defvar))
! 
              (if file-name
                  (progn
                    (princ " is a variable defined in `")

*** faces.el.~1.423.~   2008-08-06 14:19:24.000000000 +0200
--- faces.el    2008-08-16 13:45:45.859375000 +0200
***************
*** 1363,1372 ****
                  (re-search-backward
                   (concat "\\(" customize-label "\\)") nil t)
                  (help-xref-button 1 'help-customize-face f)))
!             ;; The next 4 sexps are copied from describe-function-1
!             ;; and simplified.
!             (setq file-name (symbol-file f 'defface))
!             (setq file-name (describe-simplify-lib-file-name file-name))
              (when file-name
                (princ "Defined in `")
                (princ file-name)
--- 1363,1369 ----
                  (re-search-backward
                   (concat "\\(" customize-label "\\)") nil t)
                  (help-xref-button 1 'help-customize-face f)))
!             (setq file-name (describe-rationalize-file-name f 'defface))
              (when file-name
                (princ "Defined in `")
                (princ file-name)