code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/trace.el

   1 ;;; trace.el --- tracing facility for Emacs Lisp functions  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 1993, 1998, 2000-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
   6 ;; Maintainer: FSF
   7 ;; Created: 15 Dec 1992
   8 ;; Keywords: tools, lisp
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;; LCD Archive Entry:
  26 ;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
  27 ;; Tracing facility for Emacs Lisp functions|
  28 ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
  29
  30
  31 ;;; Commentary:
  32
  33 ;; Introduction:
  34 ;; =============
  35 ;; A simple trace package that utilizes advice.el. It generates trace
  36 ;; information in a Lisp-style fashion and inserts it into a trace output
  37 ;; buffer. Tracing can be done in the background (or silently) so that
  38 ;; generation of trace output won't interfere with what you are currently
  39 ;; doing.
  40
  41 ;; Requirement:
  42 ;; ============
  43 ;; trace.el needs advice.el version 2.0 or later which you can get from the
  44 ;; same place from where you got trace.el.
  45
  46 ;; Restrictions:
  47 ;; =============
  48 ;; - Traced subrs when called interactively will always show nil as the
  49 ;;   value of their arguments.
  50 ;; - Only functions/macros/subrs that are called via their function cell will
  51 ;;   generate trace output, hence, you won't get trace output for:
  52 ;;   + Subrs called directly from other subrs/C-code
  53 ;;   + Compiled calls to subrs that have special byte-codes associated
  54 ;;     with them (e.g., car, cdr, ...)
  55 ;;   + Macros that were expanded during compilation
  56 ;; - All the restrictions that apply to advice.el
  57
  58 ;; Installation:
  59 ;; =============
  60 ;; Put this file together with advice.el (version 2.0 or later) somewhere
  61 ;; into your Emacs `load-path', byte-compile it/them for efficiency, and
  62 ;; put the following autoload declarations into your .emacs
  63 ;;
  64 ;;    (autoload 'trace-function "trace" "Trace a function" t)
  65 ;;    (autoload 'trace-function-background "trace" "Trace a function" t)
  66 ;;
  67 ;; or explicitly load it with (require 'trace) or (load "trace").
  68
  69 ;; Usage:
  70 ;; ======
  71 ;; - To trace a function say `M-x trace-function' which will ask you for the
  72 ;;   name of the function/subr/macro to trace, as well as for the buffer
  73 ;;   into which trace output should go.
  74 ;; - If you want to trace a function that switches buffers or does other
  75 ;;   display oriented stuff use `M-x trace-function-background' which will
  76 ;;   generate the trace output silently in the background without popping
  77 ;;   up windows and doing other irritating stuff.
  78 ;; - To untrace a function say `M-x untrace-function'.
  79 ;; - To untrace all currently traced functions say `M-x untrace-all'.
  80
  81 ;; Examples:
  82 ;; =========
  83 ;;
  84 ;;  (defun fact (n)
  85 ;;    (if (= n 0) 1
  86 ;;      (* n (fact (1- n)))))
  87 ;;  fact
  88 ;;
  89 ;;  (trace-function 'fact)
  90 ;;  fact
  91 ;;
  92 ;;  Now, evaluating this...
  93 ;;
  94 ;;  (fact 4)
  95 ;;  24
  96 ;;
  97 ;;  ...will generate the following in *trace-buffer*:
  98 ;;
  99 ;;  1 -> fact: n=4
 100 ;;  | 2 -> fact: n=3
 101 ;;  | | 3 -> fact: n=2
 102 ;;  | | | 4 -> fact: n=1
 103 ;;  | | | | 5 -> fact: n=0
 104 ;;  | | | | 5 <- fact: 1
 105 ;;  | | | 4 <- fact: 1
 106 ;;  | | 3 <- fact: 2
 107 ;;  | 2 <- fact: 6
 108 ;;  1 <- fact: 24
 109 ;;
 110 ;;
 111 ;;  (defun ack (x y z)
 112 ;;    (if (= x 0)
 113 ;;        (+ y z)
 114 ;;      (if (and (<= x 2) (= z 0))
 115 ;;          (1- x)
 116 ;;        (if (and (> x 2) (= z 0))
 117 ;;            y
 118 ;;          (ack (1- x) y (ack x y (1- z)))))))
 119 ;;  ack
 120 ;;
 121 ;;  (trace-function 'ack)
 122 ;;  ack
 123 ;;
 124 ;;  Try this for some interesting trace output:
 125 ;;
 126 ;;  (ack 3 3 1)
 127 ;;  27
 128 ;;
 129 ;;
 130 ;; The following does something similar to the functionality of the package
 131 ;; log-message.el by Robert Potter, which is giving you a chance to look at
 132 ;; messages that might have whizzed by too quickly (you won't see subr
 133 ;; generated messages though):
 134 ;;
 135 ;; (trace-function-background 'message "*Message Log*")
 136
 137
 138 ;;; Change Log:
 139
 140 ;; Revision 2.0 1993/05/18 00:41:16 hans
 141 ;;      * Adapted for advice.el 2.0; it now also works
 142 ;;        for GNU Emacs-19 and Lemacs
 143 ;;      * Separate function `trace-function-background'
 144 ;;      * Separate pieces of advice for foreground and background tracing
 145 ;;      * Less insane handling of interactive trace buffer specification
 146 ;;      * String arguments and values are now printed properly
 147 ;;
 148 ;; Revision 1.1 1992/12/15 22:45:15 hans
 149 ;;      * Created, first public release
 150
 151
 152 ;;; Code:
 153
 154 (defgroup trace nil
 155   "Tracing facility for Emacs Lisp functions."
 156   :prefix "trace-"
 157   :group 'lisp)
 158
 159 ;;;###autoload
 160 (defcustom trace-buffer "*trace-output*"
 161   "Trace output will by default go to that buffer."
 162   :type 'string)
 163
 164 ;; Current level of traced function invocation:
 165 (defvar trace-level 0)
 166
 167 ;; Semi-cryptic name used for a piece of trace advice:
 168 (defvar trace-advice-name 'trace-function\ )
 169
 170 ;; Used to separate new trace output from previous traced runs:
 171 (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
 172
 173 (defvar inhibit-trace nil
 174   "If non-nil, all tracing is temporarily inhibited.")
 175
 176 (defun trace-entry-message (function level args context)
 177   "Generate a string that describes that FUNCTION has been entered.
 178 LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
 179 and CONTEXT is a string describing the dynamic context (e.g. values of
 180 some global variables)."
 181   (let ((print-circle t))
 182     (format "%s%s%d -> %S%s\n"
 183             (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 184             (if (> level 1) " " "")
 185             level
 186             (cons function args)
 187             context)))
 188
 189 (defun trace-exit-message (function level value context)
 190   "Generate a string that describes that FUNCTION has exited.
 191 LEVEL is the trace level, VALUE value returned by FUNCTION,
 192 and CONTEXT is a string describing the dynamic context (e.g. values of
 193 some global variables)."
 194   (let ((print-circle t))
 195     (format "%s%s%d <- %s: %S%s\n"
 196             (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
 197             (if (> level 1) " " "")
 198             level
 199             function
 200             ;; Do this so we'll see strings:
 201             value
 202             context)))
 203
 204 (defvar trace--timer nil)
 205
 206 (defun trace-make-advice (function buffer background context)
 207   "Build the piece of advice to be added to trace FUNCTION.
 208 FUNCTION is the name of the traced function.
 209 BUFFER is the buffer where the trace should be printed.
 210 BACKGROUND if nil means to display BUFFER.
 211 CONTEXT if non-nil should be a function that returns extra info that should
 212 be printed along with the arguments in the trace."
 213   (lambda (body &rest args)
 214     (let ((trace-level (1+ trace-level))
 215           (trace-buffer (get-buffer-create buffer))
 216           (ctx (funcall context)))
 217       (unless inhibit-trace
 218         (with-current-buffer trace-buffer
 219           (set (make-local-variable 'window-point-insertion-type) t)
 220           (unless (or background trace--timer
 221                       (get-buffer-window trace-buffer 'visible))
 222             (setq trace--timer
 223                   ;; Postpone the display to some later time, in case we
 224                   ;; can't actually do it now.
 225                   (run-with-timer 0 nil
 226                                   (lambda ()
 227                                     (setq trace--timer nil)
 228                                     (display-buffer trace-buffer)))))
 229           (goto-char (point-max))
 230           ;; Insert a separator from previous trace output:
 231           (if (= trace-level 1) (insert trace-separator))
 232           (insert
 233            (trace-entry-message
 234             function trace-level args ctx))))
 235       (let ((result))
 236         (unwind-protect
 237             (setq result (list (apply body args)))
 238           (unless inhibit-trace
 239             (let ((ctx (funcall context)))
 240               (with-current-buffer trace-buffer
 241                 (unless background (display-buffer trace-buffer))
 242                 (goto-char (point-max))
 243                 (insert
 244                  (trace-exit-message
 245                   function
 246                   trace-level
 247                   (if result (car result) '\!non-local\ exit\!)
 248                   ctx))))))
 249         (car result)))))
 250
 251 (defun trace-function-internal (function buffer background context)
 252   "Add trace advice for FUNCTION."
 253   (advice-add
 254    function :around
 255    (trace-make-advice function (or buffer trace-buffer) background
 256                       (or context (lambda () "")))
 257    `((name . ,trace-advice-name))))
 258
 259 (defun trace-is-traced (function)
 260   (advice-member-p trace-advice-name function))
 261
 262 (defun trace--read-args (prompt)
 263   (cons
 264    (intern (completing-read prompt obarray 'fboundp t))
 265    (when current-prefix-arg
 266      (list
 267       (read-buffer "Output to buffer: " trace-buffer)
 268       (let ((exp
 269              (let ((minibuffer-completing-symbol t))
 270                (read-from-minibuffer "Context expression: "
 271                                      nil read-expression-map t
 272                                      'read-expression-history))))
 273         `(lambda ()
 274            (let ((print-circle t))
 275              (concat " [" (prin1-to-string ,exp) "]"))))))))
 276
 277 ;;;###autoload
 278 (defun trace-function-foreground (function &optional buffer context)
 279   "Traces FUNCTION with trace output going to BUFFER.
 280 For every call of FUNCTION Lisp-style trace messages that display argument
 281 and return values will be inserted into BUFFER.  This function generates the
 282 trace advice for FUNCTION and activates it together with any other advice
 283 there might be!!  The trace BUFFER will popup whenever FUNCTION is called.
 284 Do not use this to trace functions that switch buffers or do any other
 285 display oriented stuff, use `trace-function-background' instead."
 286   (interactive (trace--read-args "Trace function: "))
 287   (trace-function-internal function buffer nil context))
 288
 289 ;;;###autoload
 290 (defun trace-function-background (function &optional buffer context)
 291   "Traces FUNCTION with trace output going quietly to BUFFER.
 292 When this tracing is enabled, every call to FUNCTION writes
 293 a Lisp-style trace message (showing the arguments and return value)
 294 into BUFFER.  This function generates advice to trace FUNCTION
 295 and activates it together with any other advice there might be.
 296 The trace output goes to BUFFER quietly, without changing
 297 the window or buffer configuration.
 298
 299 BUFFER defaults to `trace-buffer'."
 300   (interactive (trace--read-args "Trace function in background: "))
 301   (trace-function-internal function buffer t context))
 302
 303 ;;;###autoload
 304 (defalias 'trace-function 'trace-function-foreground)
 305
 306 (defun untrace-function (function)
 307   "Untraces FUNCTION and possibly activates all remaining advice.
 308 Activation is performed with `ad-update', hence remaining advice will get
 309 activated only if the advice of FUNCTION is currently active.  If FUNCTION
 310 was not traced this is a noop."
 311   (interactive
 312    (list (intern (completing-read "Untrace function: "
 313                                   obarray #'trace-is-traced t))))
 314   (advice-remove function trace-advice-name))
 315
 316 (defun untrace-all ()
 317   "Untraces all currently traced functions."
 318   (interactive)
 319   (mapatoms #'untrace-function))
 320
 321 (provide 'trace)
 322
 323 ;;; trace.el ends here