;;; elp.el --- Emacs Lisp Profiler
-;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-1998, 2001-2011
+;; Free Software Foundation, Inc.
;; Author: Barry A. Warsaw
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
:group 'lisp)
(defcustom elp-function-list nil
- "*List of functions to profile.
+ "List of functions to profile.
Used by the command `elp-instrument-list'."
:type '(repeat function)
:group 'elp)
(defcustom elp-reset-after-results t
- "*Non-nil means reset all profiling info after results are displayed.
+ "Non-nil means reset all profiling info after results are displayed.
Results are displayed with the `elp-results' command."
:type 'boolean
:group 'elp)
(defcustom elp-sort-by-function 'elp-sort-by-total-time
- "*Non-nil specifies elp results sorting function.
+ "Non-nil specifies ELP results sorting function.
These functions are currently available:
elp-sort-by-call-count -- sort by the highest call count
elp-sort-by-total-time -- sort by the highest total time
elp-sort-by-average-time -- sort by the highest average times
-You can write you're own sort function. It should adhere to the
-interface specified by the PRED argument for the `sort' defun. Each
-\"element of LIST\" is really a 4 element vector where element 0 is
+You can write your own sort function. It should adhere to the
+interface specified by the PREDICATE argument for `sort'.
+Each \"element of LIST\" is really a 4 element vector where element 0 is
the call count, element 1 is the total time spent in the function,
element 2 is the average time spent in the function, and element 3 is
the symbol's name string."
:group 'elp)
(defcustom elp-report-limit 1
- "*Prevents some functions from being displayed in the results buffer.
+ "Prevent some functions from being displayed in the results buffer.
If a number, no function that has been called fewer than that number
of times will be displayed in the output buffer. If nil, all
functions will be displayed."
:group 'elp)
(defcustom elp-use-standard-output nil
- "*Non-nil says to output to `standard-output' instead of a buffer."
+ "If non-nil, output to `standard-output' instead of a buffer."
:type 'boolean
:group 'elp)
(defcustom elp-recycle-buffers-p t
- "*nil says to not recycle the `elp-results-buffer'.
+ "If nil, don't recycle the `elp-results-buffer'.
In other words, a new unique buffer is create every time you run
\\[elp-results]."
:type 'boolean
;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
;; (aref (symbol-function 'elp-wrapper) 2)))
;; to help me find this list.
- error call-interactively apply current-time)
+ error call-interactively apply current-time
+ ;; Andreas Politz reports problems profiling these (Bug#4233):
+ + byte-code-function-p functionp byte-code subrp
+ indirect-function fboundp)
"List of functions that cannot be profiled.
Those functions are used internally by the profiling code and profiling
them would thus lead to infinite recursion.")
(setq newguts (append newguts `((elp-wrapper
(quote ,funsym)
,(when (commandp funsym)
- '(called-interactively-p))
+ '(called-interactively-p 'any))
args))))
;; to record profiling times, we set the symbol's function
;; definition so that it runs the elp-wrapper function with the
;;;###autoload
(defun elp-instrument-list (&optional list)
- "Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead."
+ "Instrument, for profiling, all functions in `elp-function-list'.
+Use optional LIST if provided instead.
+If called interactively, read LIST using the minibuffer."
(interactive "PList of functions to instrument: ")
+ (unless (listp list)
+ (signal 'wrong-type-argument (list 'listp list)))
(let ((list (or list elp-function-list)))
(mapcar 'elp-instrument-function list)))
(mapcar 'elp-restore-function list)))
(defun elp-restore-all ()
- "Restores the original definitions of all functions being profiled."
+ "Restore the original definitions of all functions being profiled."
(interactive)
(elp-restore-list elp-all-instrumented-list))
(elp-instrument-function funsym)))
(defun elp-unset-master ()
- "Unsets the master function."
+ "Unset the master function."
(interactive)
;; when there's no master function, recording is turned on by default.
(setq elp-master nil
(defvar elp-results-symname-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'elp-results-jump-to-definition)
+ (define-key map [follow-link] 'mouse-face)
(define-key map "\C-m" 'elp-results-jump-to-definition)
map)
"Keymap used on the function name column." )
'elp-symname (intern symname)
'keymap elp-results-symname-map
'mouse-face 'highlight
+ 'face 'link
'help-echo "mouse-2 or RET jumps to definition")))
;;;###autoload
(defun elp-results ()
"Display current profiling results.
If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
+information for all instrumented functions is reset after results are
displayed."
(interactive)
(let ((curbuf (current-buffer))
symname)))))
elp-all-instrumented-list))
) ; end let*
- (insert title)
- (if (> longest titlelen)
- (progn
- (insert-char 32 (- longest titlelen))
- (setq elp-field-len longest)))
- (insert " " cc-header " " et-header " " at-header "\n")
- (insert-char ?= elp-field-len)
- (insert " ")
- (insert-char ?= elp-cc-len)
- (insert " ")
- (insert-char ?= elp-et-len)
- (insert " ")
- (insert-char ?= elp-at-len)
- (insert "\n")
+ ;; If printing to stdout, insert the header so it will print.
+ ;; Otherwise use header-line-format.
+ (setq elp-field-len (max titlelen longest))
+ (if (or elp-use-standard-output noninteractive)
+ (progn
+ (insert title)
+ (if (> longest titlelen)
+ (progn
+ (insert-char 32 (- longest titlelen))))
+ (insert " " cc-header " " et-header " " at-header "\n")
+ (insert-char ?= elp-field-len)
+ (insert " ")
+ (insert-char ?= elp-cc-len)
+ (insert " ")
+ (insert-char ?= elp-et-len)
+ (insert " ")
+ (insert-char ?= elp-at-len)
+ (insert "\n"))
+ (let ((column 0))
+ (setq header-line-format
+ (mapconcat
+ (lambda (title)
+ (prog1
+ (concat
+ (propertize " "
+ 'display (list 'space :align-to column)
+ 'face 'fixed-pitch)
+ title)
+ (setq column (+ column 2
+ (if (= column 0)
+ elp-field-len
+ (length title))))))
+ (list title cc-header et-header at-header) ""))))
;; if sorting is enabled, then sort the results list. in either
;; case, call elp-output-result to output the result in the
;; buffer
(if elp-sort-by-function
(setq resvec (sort resvec elp-sort-by-function)))
- (mapcar 'elp-output-result resvec))
+ (mapc 'elp-output-result resvec))
;; now pop up results buffer
(set-buffer curbuf)
(pop-to-buffer resultsbuf)
;; copy results to standard-output?
(if (or elp-use-standard-output noninteractive)
- (princ (buffer-substring (point-min) (point-max))))
+ (princ (buffer-substring (point-min) (point-max)))
+ (goto-char (point-min)))
;; reset profiling info if desired
(and elp-reset-after-results
(elp-reset-all))))
-(defun elp-unload-hook ()
- (elp-restore-all))
-(add-hook 'elp-unload-hook 'elp-unload-hook)
+(defun elp-unload-function ()
+ "Unload the Emacs Lisp Profiler."
+ (elp-restore-all)
+ ;; continue standard unloading
+ nil)
\f
(provide 'elp)
-;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
;;; elp.el ends here