preferable to use the existing 'undo-inhibit-region' symbol property
instead of this variable.
+** New function 'help-fns-function-name'.
+For named functions, it just returns the name and otherwise
+it returns a short "unique" string that identifies the function.
+In either case, the string is propertized so clicking on it gives
+further details.
+
** New function 'cl-type-of'.
This function is like 'type-of' except that it sometimes returns
a more precise type. For example, for nil and t it returns 'null'
((and bind-key-describe-special-forms (functionp elem)
(stringp (setq doc (documentation elem))))
doc) ;;FIXME: Keep only the first line?
+ ;; FIXME: Use `help-fns-function-name'?
((consp elem)
(if (symbolp (car elem))
(format "#<%s>" (car elem))
(setq buffer-undo-list nil)
(texinfo-mode)))
+(defconst help-fns--function-numbers
+ (make-hash-table :test 'equal :weakness 'value))
+(defconst help-fns--function-names (make-hash-table :weakness 'key))
+
+(defun help-fns--display-function (function)
+ (cond
+ ((subr-primitive-p function)
+ (describe-function function))
+ ((and (compiled-function-p function)
+ (not (and (fboundp 'kmacro-p) (kmacro-p function))))
+ (disassemble function))
+ (t
+ ;; FIXME: Use cl-print!
+ (pp-display-expression function "*Help Source*" (consp function)))))
+
+;;;###autoload
+(defun help-fns-function-name (function)
+ "Return a short string representing FUNCTION."
+ ;; FIXME: For kmacros, should we print the key-sequence?
+ (cond
+ ((symbolp function)
+ (let ((name (if (eq (intern-soft (symbol-name function)) function)
+ (symbol-name function)
+ (concat "#:" (symbol-name function)))))
+ (if (not (fboundp function))
+ name
+ (make-text-button name nil
+ 'type 'help-function
+ 'help-args (list function)))))
+ ((gethash function help-fns--function-names))
+ ((subrp function)
+ (let ((name (subr-name function)))
+ ;; FIXME: For native-elisp-functions, should we use `help-function'
+ ;; or `disassemble'?
+ (format "#<%s %s>"
+ (cl-type-of function)
+ (make-text-button name nil
+ 'type 'help-function
+ ;; Let's hope the subr hasn't been redefined!
+ 'help-args (list (intern name))))))
+ (t
+ (let ((type (or (oclosure-type function)
+ (if (consp function)
+ (car function) (cl-type-of function))))
+ (hash (sxhash-eq function))
+ ;; Use 3 digits minimum.
+ (mask #xfff)
+ name)
+ (while
+ (let* ((hex (format (concat "%0"
+ (number-to-string (1+ (/ (logb mask) 4)))
+ "X")
+ (logand mask hash)))
+ ;; FIXME: For kmacros, we don't want to `disassemble'!
+ (button (buttonize
+ hex #'help-fns--display-function function
+ ;; FIXME: Shouldn't `buttonize' add
+ ;; the "mouse-2, RET:" prefix?
+ "mouse-2, RET: Display the function's body")))
+ (setq name (format "#<%s %s>" type button))
+ (and (< mask (abs hash)) ; We can add more digits.
+ (gethash name help-fns--function-numbers)))
+ ;; Add a digit.
+ (setq mask (+ (ash mask 4) #x0f)))
+ (puthash name function help-fns--function-numbers)
+ (puthash function name help-fns--function-names)
+ name))))
+
(provide 'help-fns)
;;; help-fns.el ends here
(let ((first-message
(cond ((or
pop-up-frames
+ ;; FIXME: `special-display-p' is obsolete since
+ ;; the vars on which it depends are obsolete!
(special-display-p (buffer-name standard-output)))
(setq help-return-method (cons (selected-window) t))
;; If the help output buffer is a special display buffer,
(propertize title 'face 'help-for-help-header)
"\n\n"
(help--for-help-make-commands commands))))
- sections ""))
+ sections))
-(defalias 'help 'help-for-help)
+(defalias 'help #'help-for-help)
(make-help-screen help-for-help
(purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
(concat
(format "%s (translated from %s)" string otherstring))))))
(defun help--binding-undefined-p (defn)
- (or (null defn) (integerp defn) (equal defn 'undefined)))
+ (or (null defn) (integerp defn) (equal defn #'undefined)))
(defun help--analyze-key (key untranslated &optional buffer)
"Get information about KEY its corresponding UNTRANSLATED events.
(defun describe-minor-mode-completion-table-for-symbol ()
;; In order to list up all minor modes, minor-mode-list
;; is used here instead of minor-mode-alist.
- (delq nil (mapcar 'symbol-name minor-mode-list)))
+ (delq nil (mapcar #'symbol-name minor-mode-list)))
(defun describe-minor-mode-from-symbol (symbol)
"Display documentation of a minor mode given as a symbol, SYMBOL."
(t value))))
(defun help--describe-command (definition &optional translation)
- (cond ((symbolp definition)
- (if (and (fboundp definition)
- help-buffer-under-preparation)
- (insert-text-button (symbol-name definition)
- 'type 'help-function
- 'help-args (list definition))
- (insert (symbol-name definition)))
- (insert "\n"))
- ((or (stringp definition) (vectorp definition))
+ (cond ((or (stringp definition) (vectorp definition))
(if translation
(insert (key-description definition nil) "\n")
+ ;; These should be rare nowadays, replaced by `kmacro's.
(insert "Keyboard Macro\n")))
((keymapp definition)
(insert "Prefix Command\n"))
- ((byte-code-function-p definition)
- (insert (format "[%s]\n"
- (buttonize "byte-code" #'disassemble definition))))
- ((and (consp definition)
- (memq (car definition) '(closure lambda)))
- (insert (format "[%s]\n"
- (buttonize
- (symbol-name (car definition))
- (lambda (_)
- (pp-display-expression
- definition "*Help Source*" t))
- nil "View definition"))))
- (t
- (insert "??\n"))))
+ (t (insert (help-fns-function-name definition) "\n"))))
(define-obsolete-function-alias 'help--describe-translation
#'help--describe-command "29.1")
(if temp-buffer-resize-mode
;; `help-make-xrefs' may add a `back' button and thus increase the
;; text size, so `resize-temp-buffer-window' must be run *after* it.
- (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
- (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
+ (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append)
+ (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window)))
(defvar resize-temp-buffer-window-inhibit nil
"Non-nil means `resize-temp-buffer-window' should not resize.")
;; Don't print to *Help*; that would clobber Help history.
(defun help-form-show ()
"Display the output of a non-nil `help-form'."
- (let ((msg (eval help-form)))
+ (let ((msg (eval help-form t)))
(if (stringp msg)
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
(t arg)))
arglist)))
-(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1")
(defun help--make-usage-docstring (fn arglist)
(let ((print-escape-newlines t))
(defcustom profiler-sampling-interval 1000000
"Default sampling interval in nanoseconds."
- :type 'natnum
- :group 'profiler)
+ :type 'natnum)
\f
;;; Utilities
collect c into s
do (cl-decf i)
finally return
- (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+ (apply #'string (if (eq (car s) ?,) (cdr s) s)))
(profiler-ensure-string number)))
(defun profiler-format (fmt &rest args)
for arg in args
for str = (cond
((consp subfmt)
- (apply 'profiler-format subfmt arg))
+ (apply #'profiler-format subfmt arg))
((stringp subfmt)
(format subfmt arg))
((and (symbolp subfmt)
if (< width len)
collect (progn (put-text-property (max 0 (- width 2)) len
'invisible 'profiler str)
- str) into frags
+ str)
+ into frags
else
collect
(let ((padding (make-string (max 0 (- width len)) ?\s)))
(right (concat padding str))))
into frags
finally return (apply #'concat frags)))
-
-\f
-;;; Entries
-
-(defun profiler-format-entry (entry)
- "Format ENTRY in human readable string.
-ENTRY would be a function name of a function itself."
- (cond ((memq (car-safe entry) '(closure lambda))
- (format "#<lambda %#x>" (sxhash entry)))
- ((byte-code-function-p entry)
- (format "#<compiled %#x>" (sxhash entry)))
- ((or (subrp entry) (symbolp entry) (stringp entry))
- (format "%s" entry))
- (t
- (format "#<unknown %#x>" (sxhash entry)))))
-
-(defun profiler-fixup-entry (entry)
- (if (symbolp entry)
- entry
- (profiler-format-entry entry)))
-
\f
;;; Backtraces
(defun profiler-fixup-backtrace (backtrace)
- (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+ (apply #'vector (mapcar #'help-fns-function-name backtrace)))
\f
;;; Logs
(defcustom profiler-report-closed-mark "+"
"An indicator of closed calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-open-mark "-"
"An indicator of open calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-leaf-mark " "
"An indicator of calltree leaves."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defvar profiler-report-cpu-line-format
'((17 right ((12 right)
(let ((string (cond
((eq entry t)
"Others")
- ((and (symbolp entry)
- (fboundp entry))
- (propertize (symbol-name entry)
- 'face 'link
- 'follow-link "\r"
- 'mouse-face 'highlight
- 'help-echo "\
+ (t (propertize (help-fns-function-name entry)
+ ;; Override the `button-map' which
+ ;; otherwise adds RET, mouse-1, and TAB
+ ;; bindings we don't want. :-(
+ 'keymap '(make-sparse-keymap)
+ 'follow-link "\r"
+ ;; FIXME: The help-echo code gets confused
+ ;; by the `follow-link' property and rewrites
+ ;; `mouse-2' to `mouse-1' :-(
+ 'help-echo "\
mouse-2: jump to definition\n\
-RET: expand or collapse"))
- (t
- (profiler-format-entry entry)))))
+RET: expand or collapse")))))
(propertize string 'profiler-entry entry)))
(defun profiler-report-make-name-part (tree)
(current-buffer))
(and event (setq event (event-end event))
(posn-set-point event))
- (let ((tree (profiler-report-calltree-at-point)))
- (when tree
- (let ((entry (profiler-calltree-entry tree)))
- (find-function entry))))))
+ (save-excursion
+ (forward-line 0)
+ (let ((eol (pos-eol)))
+ (forward-button 1)
+ (if (> (point) eol)
+ (error "No entry found")
+ (push-button))))))
(defun profiler-report-describe-entry ()
"Describe entry at point."
(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1
(not read-extended-command-predicate))
(setq read-extended-command-predicate
- 'transient-command-completion-not-suffix-only-p))
+ #'transient-command-completion-not-suffix-only-p))
(defun transient-parse-suffix (prefix suffix)
"Parse SUFFIX, to be added to PREFIX.
the same forms as expected by `transient-define-prefix').
Intended for use in a group's `:setup-children' function."
(cl-assert (and prefix (symbolp prefix)))
- (eval (car (transient--parse-child prefix suffix))))
+ (eval (car (transient--parse-child prefix suffix)) t))
(defun transient-parse-suffixes (prefix suffixes)
"Parse SUFFIXES, to be added to PREFIX.
(string suffix)))
(mem (transient--layout-member loc prefix))
(elt (car mem)))
- (setq suf (eval suf))
+ (setq suf (eval suf t))
(cond
((not mem)
(message "Cannot insert %S into %s; %s not found"
"Hide common commands"
"Show common permanently")))
(list "C-x l" "Show/hide suffixes" #'transient-set-level)
- (list "C-x a" #'transient-toggle-level-limit))))))))
+ (list "C-x a" #'transient-toggle-level-limit)))))
+ t)))
(defvar-keymap transient-popup-navigation-map
:doc "One of the keymaps used when popup navigation is enabled.
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
- (or (and (symbolp this-command) this-command)
- (if (byte-code-function-p this-command)
- "#[...]"
- this-command))
+ (if (fboundp 'help-fns-function-name)
+ (help-fns-function-name this-command)
+ (if (byte-code-function-p this-command)
+ "#[...]"
+ this-command))
(key-description (this-command-keys-vector))
transient--exitp
(cond ((keywordp (car args))
(interactive)
(transient-set-value (transient-prefix-object)))
-(defalias 'transient-set-and-exit 'transient-set
+(defalias 'transient-set-and-exit #'transient-set
"Set active transient's value for this Emacs session and exit.")
(defun transient-save ()
(interactive)
(transient-save-value (transient-prefix-object)))
-(defalias 'transient-save-and-exit 'transient-save
+(defalias 'transient-save-and-exit #'transient-save
"Save active transient's value for this and future Emacs sessions and exit.")
(defun transient-reset ()
projects / emacs.git / commitdiff