* Fix for bugs #587, #669, and #690
@ 2008-08-16 12:18 martin rudalics
0 siblings, 0 replies; only message in thread
From: martin rudalics @ 2008-08-16 12:18 UTC (permalink / raw)
To: emacs-devel; +Cc: LENNART BORGMAN, Markus Triska, Drew Adams
[-- Attachment #1: Type: text/plain, Size: 792 bytes --]
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
[-- Attachment #2: 587-669-690.diff --]
[-- Type: text/plain, Size: 19345 bytes --]
*** 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)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2008-08-16 12:18 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2008-08-16 12:18 Fix for bugs #587, #669, and #690 martin rudalics
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).