mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Try and avoid hardcoding lists of function types
* lisp/bind-key.el (bind-key--get-binding-description): Show docstrings for compiled functions also. Don't hardcode knowledge about various particular kinds of functions. * lisp/emacs-lisp/bytecomp.el (display-call-tree): Remove special support for functions with a `byte-code` body since we never generate that nowadays. Don't hardcode knowledge about various particular kinds of functions.
This commit is contained in:
parent
8df6739077
commit
4afafa0370
2 changed files with 22 additions and 35 deletions
|
|
@ -453,31 +453,27 @@ other modes. See `override-global-mode'."
|
||||||
(macroexp-progn (bind-keys-form args 'override-global-map)))
|
(macroexp-progn (bind-keys-form args 'override-global-map)))
|
||||||
|
|
||||||
(defun bind-key--get-binding-description (elem)
|
(defun bind-key--get-binding-description (elem)
|
||||||
|
(let (doc)
|
||||||
(cond
|
(cond
|
||||||
((listp elem)
|
|
||||||
(cond
|
|
||||||
((memq (car elem) '(lambda function))
|
|
||||||
(if (and bind-key-describe-special-forms
|
|
||||||
(stringp (nth 2 elem)))
|
|
||||||
(nth 2 elem)
|
|
||||||
"#<lambda>"))
|
|
||||||
((eq 'closure (car elem))
|
|
||||||
(if (and bind-key-describe-special-forms
|
|
||||||
(stringp (nth 3 elem)))
|
|
||||||
(nth 3 elem)
|
|
||||||
"#<closure>"))
|
|
||||||
((eq 'keymap (car elem))
|
|
||||||
"#<keymap>")
|
|
||||||
(t
|
|
||||||
elem)))
|
|
||||||
;; must be a symbol, non-symbol keymap case covered above
|
|
||||||
((and bind-key-describe-special-forms (keymapp elem))
|
|
||||||
(let ((doc (get elem 'variable-documentation)))
|
|
||||||
(if (stringp doc) doc elem)))
|
|
||||||
((symbolp elem)
|
((symbolp elem)
|
||||||
elem)
|
(cond
|
||||||
|
((and bind-key-describe-special-forms (keymapp elem)
|
||||||
|
;; FIXME: Is this really ever better than the symbol-name?
|
||||||
|
;; FIXME: `variable-documentation' describe what's in
|
||||||
|
;; elem's `symbol-value', whereas `elem' here stands for
|
||||||
|
;; its `symbol-function'.
|
||||||
|
(stringp (setq doc (get elem 'variable-documentation))))
|
||||||
|
doc)
|
||||||
|
(t elem)))
|
||||||
|
((and bind-key-describe-special-forms (functionp elem)
|
||||||
|
(stringp (setq doc (documentation elem))))
|
||||||
|
doc) ;;FIXME: Keep only the first line?
|
||||||
|
((consp elem)
|
||||||
|
(if (symbolp (car elem))
|
||||||
|
(format "#<%s>" (car elem))
|
||||||
|
elem))
|
||||||
(t
|
(t
|
||||||
"#<byte-compiled lambda>")))
|
(format "#<%s>" (type-of elem))))))
|
||||||
|
|
||||||
(defun bind-key--compare-keybindings (l r)
|
(defun bind-key--compare-keybindings (l r)
|
||||||
(let* ((regex bind-key-segregation-regexp)
|
(let* ((regex bind-key-segregation-regexp)
|
||||||
|
|
|
||||||
|
|
@ -5536,23 +5536,14 @@ invoked interactively."
|
||||||
(if (null f)
|
(if (null f)
|
||||||
" <top level>";; shouldn't insert nil then, actually -sk
|
" <top level>";; shouldn't insert nil then, actually -sk
|
||||||
" <not defined>"))
|
" <not defined>"))
|
||||||
((subrp (setq f (symbol-function f)))
|
((symbolp (setq f (symbol-function f))) ;; An alias.
|
||||||
" <subr>")
|
|
||||||
((symbolp f)
|
|
||||||
(format " ==> %s" f))
|
(format " ==> %s" f))
|
||||||
((byte-code-function-p f)
|
|
||||||
"<compiled function>")
|
|
||||||
((not (consp f))
|
((not (consp f))
|
||||||
"<malformed function>")
|
(format " <%s>" (type-of f)))
|
||||||
((eq 'macro (car f))
|
((eq 'macro (car f))
|
||||||
(if (or (compiled-function-p (cdr f))
|
(if (compiled-function-p (cdr f))
|
||||||
;; FIXME: Can this still happen?
|
|
||||||
(assq 'byte-code (cdr (cdr (cdr f)))))
|
|
||||||
" <compiled macro>"
|
" <compiled macro>"
|
||||||
" <macro>"))
|
" <macro>"))
|
||||||
((assq 'byte-code (cdr (cdr f)))
|
|
||||||
;; FIXME: Can this still happen?
|
|
||||||
"<compiled lambda>")
|
|
||||||
((eq 'lambda (car f))
|
((eq 'lambda (car f))
|
||||||
"<function>")
|
"<function>")
|
||||||
(t "???"))
|
(t "???"))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue