[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/interpreted-function 256ea7509b8: -
From: |
Stefan Monnier |
Subject: |
scratch/interpreted-function 256ea7509b8: - |
Date: |
Wed, 20 Mar 2024 19:09:58 -0400 (EDT) |
branch: scratch/interpreted-function
commit 256ea7509b8ba840cebe9537bb48afb1e22117cc
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
-
---
lisp/descr-text.el | 18 ++++++------------
lisp/help-fns.el | 19 +++++++++++-------
lisp/profiler.el | 56 ++++++++++++++++++------------------------------------
lisp/transient.el | 6 +-----
4 files changed, 37 insertions(+), 62 deletions(-)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index eeab995c37d..d8ff5f3406c 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -44,22 +44,16 @@
(defun describe-text-sexp (sexp)
"Insert a short description of SEXP in the current buffer."
- (let ((pp (condition-case signal
- (pp-to-string sexp)
- (error (prin1-to-string signal)))))
- (when (string-match-p "\n\\'" pp)
- (setq pp (substring pp 0 (1- (length pp)))))
-
- (if (and (not (string-search "\n" pp))
- (<= (length pp) (- (window-width) (current-column))))
- (insert pp)
+ (let ((printed (format "%S" sexp)))
+ (if (and (not (string-search "\n" printed))
+ (<= (length printed) (- (window-width) (current-column))))
+ (insert printed)
(insert-text-button
"[Show]"
'follow-link t
'action (lambda (&rest _ignore)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ pp)))
+ ;; FIXME: Why "eval output"?
+ (pp-display-expression sexp "*Pp Eval Output*"))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f14c65f766e..98c23f1dc55 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -2453,7 +2453,8 @@ one of them returns non-nil."
(cond
((subr-primitive-p function)
(describe-function function))
- ((and (compiled-function-p function) (not (kmacro-p function)))
+ ((and (compiled-function-p function)
+ (not (and (fboundp 'kmacro-p) (kmacro-p function))))
(disassemble function))
(t
;; FIXME: Use cl-print!
@@ -2465,10 +2466,14 @@ one of them returns non-nil."
;; FIXME: For kmacros, should we print the key-sequence?
(cond
((symbolp function)
- (let ((name (let ((print-gensym t)) (prin1-to-string function))))
- (make-text-button name nil
- 'type 'help-function
- 'help-args (list 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)))
@@ -2485,8 +2490,8 @@ one of them returns non-nil."
(if (consp function)
(car function) (cl-type-of function))))
(hash (sxhash-eq function))
- ;; Use 2 digits minimum.
- (mask #xff)
+ ;; Use 3 digits minimum.
+ (mask #xfff)
name)
(while
(let* ((hex (format (concat "%0"
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 016e33fdc77..921d73c6660 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -91,7 +91,8 @@
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)))
@@ -100,33 +101,11 @@
(right (concat padding str))))
into frags
finally return (apply #'concat frags)))
-
-
-;;; Entries
-
-(defun profiler-format-entry (entry)
- "Format ENTRY in human readable string.
-ENTRY would be a function name of a function itself."
- ;; FIXME: Use a `function-name' primitive?
- (cond ((eq (car-safe entry) 'lambda)
- (format "#<lambda %#x>" (sxhash entry)))
- ((closurep entry)
- (format "#<closure %#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)))
-
;;; Backtraces
(defun profiler-fixup-backtrace (backtrace)
- (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+ (apply #'vector (mapcar #'help-fns-function-name backtrace)))
;;; Logs
@@ -472,17 +451,15 @@ Do not touch this variable directly.")
(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)
+ '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)
@@ -717,10 +694,13 @@ point."
(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."
diff --git a/lisp/transient.el b/lisp/transient.el
index 90c42e9784a..0cd34df06e6 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -2503,11 +2503,7 @@ value. Otherwise return CHILDREN as is."
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
- (or (and (symbolp this-command) this-command)
- ;; FIXME: Use `function-name'?
- (if (byte-code-function-p this-command)
- "#[...]"
- this-command))
+ (help-fns-function-name this-command)
(key-description (this-command-keys-vector))
transient--exitp
(cond ((stringp (car args))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/interpreted-function 256ea7509b8: -,
Stefan Monnier <=