* bug#25226: Describe compiled function values in a friendlier way
@ 2016-12-18 22:41 npostavs
2016-12-21 17:57 ` Eli Zaretskii
2017-06-13 3:01 ` npostavs
0 siblings, 2 replies; 3+ messages in thread
From: npostavs @ 2016-12-18 22:41 UTC (permalink / raw)
To: 25226
[-- Attachment #1: Type: text/plain, Size: 310 bytes --]
Severity: wishlist
tags: patch
There was some discussion on emacs-devel [1] about the value of
eldoc-documentation-function being unreadable. Here is a patch that
produces a more human-friendly display for compiled function values:
[1]: https://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00138.html
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 7198 bytes --]
From d0327009f0dc63ca007efa2aa8a0a9b9189b6cb9 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 18 Dec 2016 12:12:33 -0500
Subject: [PATCH v1] Describe compiled function values in a friendlier way
* lisp/emacs-lisp/nadvice.el (advice--where): New function, finds
"where" a function was added.
(advice-function-mapc-with-location): New function, like
`advice-function-mapc', but additionally passes where to the iterating
function, and returns the final non-advice function.
* lisp/help-fns.el (help-byte-code): New button type, whose action call
`disassemble'.
(describe-function-value): New function, produces descriptive string,
hiding byte code behind a `help-byte-code' button.
(describe-variable): Use it to describe byte code function values.
---
lisp/emacs-lisp/nadvice.el | 20 ++++++++++
lisp/help-fns.el | 94 ++++++++++++++++++++++++++++++++--------------
2 files changed, 86 insertions(+), 28 deletions(-)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 1b30499..ed871e5 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -66,6 +66,11 @@ advice--p
(defsubst advice--car (f) (aref (aref f 2) 1))
(defsubst advice--cdr (f) (aref (aref f 2) 2))
(defsubst advice--props (f) (aref (aref f 2) 3))
+(defun advice--where (f)
+ (require 'cl-lib)
+ (caar (cl-member (aref f 1)
+ advice--where-alist
+ :key (lambda (e) (nth 1 e)))))
(defun advice--cd*r (f)
(while (advice--p f)
@@ -331,6 +336,21 @@ advice-function-mapc
(funcall f (advice--car function-def) (advice--props function-def))
(setq function-def (advice--cdr function-def))))
+(defun advice-function-mapc-with-location (f function-def)
+ "Apply F to every advice function in FUNCTION-DEF.
+F is called with three arguments: the function that was added,
+the 'location' it was added at (similar to the first argument of
+`add-function'), and the properties alist that was specified when
+it was added.
+Returns the final non-advice function found."
+ (while (advice--p function-def)
+ (funcall f
+ (advice--car function-def)
+ (advice--where function-def)
+ (advice--props function-def))
+ (setq function-def (advice--cdr function-def)))
+ function-def)
+
(defun advice-function-member-p (advice function-def)
"Return non-nil if ADVICE is already in FUNCTION-DEF.
Instead of ADVICE being the actual function, it can also be the `name'
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 23dec89..605edb7 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -753,6 +753,42 @@ describe-variable-custom-version-info
version package))))))
output))
+(define-button-type 'help-byte-code
+ 'follow-link t
+ 'action (lambda (button)
+ (disassemble (button-get button 'byte-code-function)))
+ 'help-echo (purecopy "mouse-2, RET: disassemble this function"))
+
+(defun describe-function-value (fun &optional indent-level)
+ (cond
+ ((byte-code-function-p fun)
+ (setq indent-level (+ (or indent-level 0) 2))
+ (let* ((indent-str (concat "\n" (make-string indent-level ?\s)))
+ (components nil)
+ (final-fun (advice-function-mapc-with-location
+ (lambda (subfun where _props)
+ (push `(,where ,subfun) components))
+ fun)))
+ (concat
+ (make-text-button "a compiled function" nil
+ :type 'help-byte-code 'byte-code-function fun)
+ (when components
+ (concat ", composed of subfunctions:"
+ (mapconcat (pcase-lambda (`(,where ,fun))
+ (concat indent-str (symbol-name where) " "
+ (describe-function-value fun indent-level)
+ ","))
+ (nreverse components) " ")
+ indent-str "and finally: "
+ (describe-function-value final-fun indent-level) ".")))))
+ ((symbolp fun)
+ (format-message "`%s'"
+ (make-text-button
+ (copy-sequence (symbol-name fun)) nil
+ :type 'help-function
+ 'help-args (list fun))))
+ (t (prin1-to-string fun))))
+
;;;###autoload
(defun describe-variable (variable &optional buffer frame)
"Display the full documentation of VARIABLE (a symbol).
@@ -829,34 +865,36 @@ describe-variable
(with-current-buffer standard-output
(setq val-start-pos (point))
(princ "value is")
- (let ((line-beg (line-beginning-position))
- (print-rep
- (let ((rep
- (let ((print-quoted t))
- (prin1-to-string val))))
- (if (and (symbolp val) (not (booleanp val)))
- (format-message "`%s'" rep)
- rep))))
- (if (< (+ (length print-rep) (point) (- line-beg)) 68)
- (insert " " print-rep)
- (terpri)
- (pp val)
- ;; Remove trailing newline.
- (delete-char -1))
- (let* ((sv (get variable 'standard-value))
- (origval (and (consp sv)
- (condition-case nil
- (eval (car sv))
- (error :help-eval-error))))
- from)
- (when (and (consp sv)
- (not (equal origval val))
- (not (equal origval :help-eval-error)))
- (princ "\nOriginal value was \n")
- (setq from (point))
- (pp origval)
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
+ (if (byte-code-function-p val)
+ (insert " " (describe-function-value val))
+ (let ((line-beg (line-beginning-position))
+ (print-rep
+ (let ((rep
+ (let ((print-quoted t))
+ (prin1-to-string val))))
+ (if (and (symbolp val) (not (booleanp val)))
+ (format-message "`%s'" rep)
+ rep))))
+ (if (< (+ (length print-rep) (point) (- line-beg)) 68)
+ (insert " " print-rep)
+ (terpri)
+ (pp val)
+ ;; Remove trailing newline.
+ (delete-char -1))))
+ (let* ((sv (get variable 'standard-value))
+ (origval (and (consp sv)
+ (condition-case nil
+ (eval (car sv))
+ (error :help-eval-error))))
+ from)
+ (when (and (consp sv)
+ (not (equal origval val))
+ (not (equal origval :help-eval-error)))
+ (princ "\nOriginal value was \n")
+ (setq from (point))
+ (pp origval)
+ (if (< (point) (+ from 20))
+ (delete-region (1- from) from))))))
(terpri)
(when locus
(cond
--
2.9.3
[-- Attachment #3: Type: text/plain, Size: 37 bytes --]
Here's a screenshot of the result:
[-- Attachment #4: screenshot with patch applied --]
[-- Type: image/png, Size: 52928 bytes --]
^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#25226: Describe compiled function values in a friendlier way
2016-12-18 22:41 bug#25226: Describe compiled function values in a friendlier way npostavs
@ 2016-12-21 17:57 ` Eli Zaretskii
2017-06-13 3:01 ` npostavs
1 sibling, 0 replies; 3+ messages in thread
From: Eli Zaretskii @ 2016-12-21 17:57 UTC (permalink / raw)
To: npostavs; +Cc: 25226
> From: npostavs@users.sourceforge.net
> Date: Sun, 18 Dec 2016 17:41:07 -0500
>
> There was some discussion on emacs-devel [1] about the value of
> eldoc-documentation-function being unreadable. Here is a patch that
> produces a more human-friendly display for compiled function values:
I like the result, thanks.
^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#25226: Describe compiled function values in a friendlier way
2016-12-18 22:41 bug#25226: Describe compiled function values in a friendlier way npostavs
2016-12-21 17:57 ` Eli Zaretskii
@ 2017-06-13 3:01 ` npostavs
1 sibling, 0 replies; 3+ messages in thread
From: npostavs @ 2017-06-13 3:01 UTC (permalink / raw)
To: 25226
close 25226
quit
npostavs@users.sourceforge.net writes:
> There was some discussion on emacs-devel about the value of
> eldoc-documentation-function being unreadable. Here is a patch that
> produces a more human-friendly display for compiled function values:
I pushed a patch to add the disassembly button to the existing cl-print
output [9b0f52a86e]. It might not be quite as friendly as my original,
but it extends more gracefully to more complex values that contain
function values inside them, so let's just see how this goes.
[2: 9b0f52a86e]: 2017-06-12 22:52:37 -0400
Buttonize #<bytecode> part of printed functions (Bug#25226)
http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=9b0f52a86e8e3767d7fcf3ef2adf7aa1f58e0e93
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2017-06-13 3:01 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-12-18 22:41 bug#25226: Describe compiled function values in a friendlier way npostavs
2016-12-21 17:57 ` Eli Zaretskii
2017-06-13 3:01 ` npostavs
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).