GNU logs - #26470, boring messages

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#26470: Feature Request:  Autoload tracing function.
Resent-From: Keith David Bershatsky <esq@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 13 Apr 2017 03:56:01 +0000
Resent-Message-ID: <handler.26470.B.14920557381898 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 26470 <at> debbugs.gnu.org
Date: Wed, 12 Apr 2017 20:55:06 -0700
Message-ID: <m2shldufl1.wl%esq@HIDDEN>
From: Keith David Bershatsky <esq@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=US-ASCII
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

I like to see when an autoloaded function is requiring or loading a library; however, I did not find any built-in facility to accomplish that goal.  I also could not find a function to show me the initial constants vector of a byte-code function that had been autoloaded.  The disassemble library does not show the initial constants vector -- instead, the disassemble library goes to work in earnest after the function has already been fully loaded and the constants vector has already changed -- i.e., it no longer begins with [require ...].  The only way I found to see the initial byte-code constants vector of an autoloaded function before it was fully loaded was to use the following tracing function.

The Emacs team may wish to consider adding a function that can show a user all six (6) possible elements of a byte-code function without necessarily fully loading it if has been autoloaded.  And, the Emacs team may wish to offer a tracing mechanism to let a user know when a particular autoloaded function is loading a library.

(require 'help-fns)

(defun require--tracing-function (orig-fun &rest args)
  (message "`require' called with args %S" args)
  (with-current-buffer (get-buffer-create "*TRACE*")
    (let* ((standard-output (current-buffer))
           (print-escape-newlines t)
           (print-level 8)
           (print-length 50)
           beg end)
        (goto-char (point-max))
        (setq beg (point))
        (setq truncate-lines t)
        (set-buffer-multibyte t)
        (setq buffer-undo-list t)
        (backtrace)
        (insert "===============================\n")
        (setq end (point))
        (narrow-to-region beg end)
        (let ((regex "^\s+byte-code\(\\(\\(?:.\\)*?\\)\s\\(\\[.*\\]\\)\s\\([0-9]+\\)\)"))
          (goto-char (point-max))
          (while (re-search-backward regex nil t)
            (replace-match "BYTESTR" nil nil nil 1)
            (replace-match "MAXDEPTH" nil nil nil 3)))
        (let ((regex
                (concat
                  "^\s+\(let\\*\s\(\(standard-output.*\(current-buffer\)\)\)$"
                  "\\|"
                  "^\s+\(let\s\(\(res\s.*res\)\sres\)$"
                  "\\|"
                  "^\s+\(save-current-buffer\s\(set-buffer.*\(current-buffer\)\)\)\)$"
                  "\\|"
                  "^\s+backtrace\(\)$"
                  "\\|"
                  "^\s+apply\(require--tracing-function .*\)$"
                  "\\|"
                  "^\s+require--tracing-function\(.*\)$")))
          (goto-char (point-max))
          (while (re-search-backward regex nil t)
            (delete-region (match-beginning 0) (1+ (match-end 0)))))
        (goto-char (point-min))
        ;;; slight variation of the built-in `debugger-make-xrefs`
        (while (progn
           (goto-char (+ (point) 2))
           (skip-syntax-forward "^w_")
           (not (eobp)))
          (let* ((beg (point))
                 (end (progn (skip-syntax-forward "w_") (point)))
                 (fn (function-called-at-point))
                 (sym (intern-soft (buffer-substring-no-properties beg end)))
                 (file
                   (if fn
                     (let* (
                          (function fn)
                          (advised (and (symbolp function)
                              (featurep 'nadvice)
                              (advice--p (advice--symbol-function function))))
                          ;; If the function is advised, use the symbol that has the
                          ;; real definition, if that symbol is already set up.
                          (real-function
                            (or (and advised
                                     (advice--cd*r (advice--symbol-function function)))
                               function))
                          ;; Get the real definition.
                         (def (if (symbolp real-function)
                                 (or (symbol-function real-function)
                                     (signal 'void-function (list real-function)))
                                 real-function))
                         (aliased (or (symbolp def)
                               ;; Advised & aliased function.
                               (and advised (symbolp real-function)
                              (not (eq 'autoload (car-safe def))))))
                         (file-name (find-lisp-object-file-name function
                                      (if aliased 'defun def))))
                      file-name)
                  (and sym (symbol-file sym 'defun)))))
            (when file
              (goto-char beg)
              ;; help-xref-button needs to operate on something matched
              ;; by a regexp, so set that up for it.
              (re-search-forward "\\(\\sw\\|\\s_\\)+")
              (help-xref-button 0 'help-function-def sym file)))
          (forward-line 1))
        (widen)
      (display-buffer (current-buffer))))
  (let ((res (apply orig-fun args)))
    (message "`require' returned %S" res)
    res))

(advice-add 'require :around #'require--tracing-function)

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: Keith David Bershatsky <esq@HIDDEN>
Subject: bug#26470: Acknowledgement (Feature Request:  Autoload tracing
 function.)
Message-ID: <handler.26470.B.14920557381898.ack <at> debbugs.gnu.org>
References: <m2shldufl1.wl%esq@HIDDEN>
X-Gnu-PR-Message: ack 26470
X-Gnu-PR-Package: emacs
Reply-To: 26470 <at> debbugs.gnu.org
Date: Thu, 13 Apr 2017 03:56:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

Your message has been sent to the package maintainer(s):
 bug-gnu-emacs@HIDDEN

If you wish to submit further information on this problem, please
send it to 26470 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
26470: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D26470
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#26470: Feature Request:  Autoload tracing function.
References: <m2shldufl1.wl%esq@HIDDEN>
In-Reply-To: <m2shldufl1.wl%esq@HIDDEN>
Resent-From: Keith David Bershatsky <esq@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 13 Apr 2017 19:59:01 +0000
Resent-Message-ID: <handler.26470.B26470.149211348623908 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 26470 <at> debbugs.gnu.org
Date: Thu, 13 Apr 2017 12:58:00 -0700
Message-ID: <m21ssw6px3.wl%esq@HIDDEN>
From: Keith David Bershatsky <esq@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=US-ASCII
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

Here is an updated version of an example tracing function that adds some regexp to redact and colorize both flavors of byte-code output from the `backtrace` function:

(require 'help-fns)

(defun require--tracing-function (orig-fun &rest args)
"When testing with `emacs -q`, start by requiring `help-fns.el`."
  (message "`require' called with args %S" args)
  (with-current-buffer (get-buffer-create "*TRACE*")
    (let* ((standard-output (current-buffer))
           (print-escape-newlines t)
           (print-level 8)
           (print-length 50)
           beg end)
        (goto-char (point-max))
        (setq beg (point))
        (setq truncate-lines t)
        (set-buffer-multibyte t)
        (setq buffer-undo-list t)
        (backtrace)
        (insert "===============================\n")
        (setq end (point))
        (narrow-to-region beg end)
        (let ((regex
                (concat
                  "^\s+byte-code\("
                  "\\(\\(?:.\\)*?\\)"
                  "\s"
                  "\\[\\(.*\\)\\]"
                  "\s"
                  "\\([0-9]+\\)"
                  "\)"))
              (bytestr (propertize "BYTESTR" 'face '(:foreground "RoyalBlue")))
              (maxdepth (propertize "MAXDEPTH" 'face '(:foreground "RoyalBlue"))))
          (goto-char (point-max))
          (while (re-search-backward regex nil t)
            (when (match-string 1)
              (replace-match bytestr nil nil nil 1))
            (when (match-string 2)
              (let ((constants
                     (propertize (match-string 2) 'face '(:foreground "purple"))))
                (replace-match constants nil 'literal nil 2)))
            (when (match-string 3)
              (replace-match maxdepth nil nil nil 3))))
        ;;; See the Emacs Lisp manual:  Byte-Code Function Objects
        (let ((regex
                (concat
                   "#\\["
                   ;;; argdesc
                   "\\([0-9]+\\)"
                   ;;; byte-code
                   "\\(?:\s\\(.*?\\)\\)?"
                   "\s"
                   ;;; constants
                   "\\[\\(.*\\)\\]"
                   "\s"
                   ;;; stacksize
                   "\\([0-9]+\\)"
                   ;;; docstring
                   "\\(?:\s\\(.*?\\)\\)?"
                   ;;; interactive
                   "\\(?:\s\\(.*?\\)\\)?"
                   "\\]"))
              (argdesc
                (propertize "ARGDESC" 'face '(:foreground "orange")))
              (byte-code
                (propertize "BYTE-CODE" 'face '(:foreground "orange")))
              (stacksize
                (propertize "STACKSIZE" 'face '(:foreground "orange")))
              (docstring
                (propertize "DOCSTRING" 'face '(:foreground "orange")))
              (interactive
                (propertize "INTERACTIVE" 'face '(:foreground "orange"))))
          (goto-char (point-max))
          (while (re-search-backward regex nil t)
            (when (match-string 1)
              (replace-match argdesc nil nil nil 1))
            (when (match-string 2)
              (replace-match byte-code nil nil nil 2))
            (when (match-string 3)
              (let ((constants
                      (propertize
                        (match-string 3) 'face '(:foreground "ForestGreen"))))
                (replace-match constants nil 'literal nil 3)))
            (when (match-string 4)
              (replace-match stacksize nil nil nil 4))
            (when (match-string 5)
              (replace-match docstring nil nil nil 5))
            (when (match-string 6)
              (replace-match interactive nil nil nil 6))))
        (let ((regex
                (concat
                  "^\s+\(let\\*\s\(\(standard-output.*\(current-buffer\)\)\)$"
                  "\\|"
                  "^\s+\(let\s\(\(res\s.*res\)\sres\)$"
                  "\\|"
                  (concat "^\s+\(save-current-buffer\s\(set-buffer.*"
                          "\(current-buffer\)\)\)\)$")
                  "\\|"
                  "^\s+backtrace\(\)$"
                  "\\|"
                  "^\s+apply\(require--tracing-function .*\)$"
                  "\\|"
                  "^\s+require--tracing-function\(.*\)$")))
          (goto-char (point-max))
          (while (re-search-backward regex nil t)
            (delete-region (match-beginning 0) (1+ (match-end 0)))))
        (goto-char (point-min))
        ;;; A slight variation of the built-in `debugger-make-xrefs'.
        (while (progn
           (goto-char (+ (point) 2))
           (skip-syntax-forward "^w_")
           (not (eobp)))
          (let* ((beg (point))
                 (end (progn (skip-syntax-forward "w_") (point)))
                 (fn (function-called-at-point))
                 (sym (intern-soft (buffer-substring-no-properties beg end)))
                 (file
                   (if fn
                     (let* (
                          (function fn)
                          (advised (and (symbolp function)
                              (featurep 'nadvice)
                              (advice--p (advice--symbol-function function))))
                          ;; If the function is advised, use the symbol that has the
                          ;; real definition, if that symbol is already set up.
                          (real-function
                            (or (and advised
                                     (advice--cd*r
                                       (advice--symbol-function function)))
                               function))
                          ;; Get the real definition.
                         (def (if (symbolp real-function)
                                 (or (symbol-function real-function)
                                     (signal 'void-function (list real-function)))
                                 real-function))
                         (aliased (or (symbolp def)
                               ;; Advised & aliased function.
                               (and advised (symbolp real-function)
                              (not (eq 'autoload (car-safe def))))))
                         (file-name
                           (find-lisp-object-file-name
                             function (if aliased 'defun def))))
                      file-name)
                  (and sym (symbol-file sym 'defun)))))
            (when file
              (goto-char beg)
              ;; help-xref-button needs to operate on something matched
              ;; by a regexp, so set that up for it.
              (re-search-forward "\\(\\sw\\|\\s_\\)+")
              (help-xref-button 0 'help-function-def sym file)))
          (forward-line 1))
        (widen)
      (display-buffer (current-buffer))))
  (let ((res (apply orig-fun args)))
    (message "`require' returned %S" res)
    res))

(advice-add 'require :around #'require--tracing-function)

Last modified: Mon, 25 Nov 2019 12:00:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.