X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c2641e5f2d2159832b96addb8d6d0bcd9efa4311..b3843c61858aa78d450bdaaa2e597f0a1f7b39e4:/lisp/emacs-lisp/elp.el diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 308ab51ff6..ade2a23608 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -1,17 +1,18 @@ ;;; elp.el --- Emacs Lisp Profiler -;; Copyright (C) 1994,1995,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. -;; Author: 1994-1998 Barry A. Warsaw -;; Maintainer: FSF -;; Created: 26-Feb-1994 -;; Keywords: debugging lisp tools +;; Author: Barry A. Warsaw +;; Maintainer: FSF +;; Created: 26-Feb-1994 +;; Keywords: debugging lisp tools ;; This file is part of GNU Emacs. ;; 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 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -21,8 +22,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; @@ -38,7 +39,7 @@ ;; elp-reset-all. ;; ;; You can also instrument all functions in a package, provided that -;; the package follows the GNU coding standard of a common textural +;; the package follows the GNU coding standard of a common textual ;; prefix. Use M-x elp-instrument-package for this. ;; ;; If you want to sort the results, set elp-sort-by-function to some @@ -130,7 +131,7 @@ ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv (defgroup elp nil - "Emacs Lisp Profiler" + "Emacs Lisp Profiler." :group 'lisp) (defcustom elp-function-list nil @@ -177,7 +178,7 @@ functions will be displayed." :group 'elp) (defcustom elp-recycle-buffers-p t - "*Nil says to not recycle the `elp-results-buffer'. + "*nil says to not recycle the `elp-results-buffer'. In other words, a new unique buffer is create every time you run \\[elp-results]." :type 'boolean @@ -204,6 +205,30 @@ This variable is set by the master function.") (defvar elp-master nil "Master function symbol.") +(defvar elp-not-profilable + ;; First, the functions used inside each instrumented function: + '(elp-wrapper called-interactively-p + ;; Then the functions used by the above functions. I used + ;; (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) + "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.") + +(defun elp-profilable-p (fun) + (and (symbolp fun) + (fboundp fun) + (not (or (memq fun elp-not-profilable) + (keymapp fun) + (memq (car-safe (symbol-function fun)) '(autoload macro)) + (condition-case nil + (when (subrp (indirect-function fun)) + (eq 'unevalled + (cdr (subr-arity (indirect-function fun))))) + (error nil)))))) + ;;;###autoload (defun elp-instrument-function (funsym) @@ -234,16 +259,17 @@ FUNSYM must be a symbol of a defined function." ;; type functionality (i.e. it shouldn't execute the function). (and (eq (car-safe funguts) 'autoload) (error "ELP cannot profile autoloaded function: %s" funsym)) + ;; We cannot profile functions used internally during profiling. + (unless (elp-profilable-p funsym) + (error "ELP cannot profile the function: %s" funsym)) ;; put rest of newguts together (if (commandp funsym) (setq newguts (append newguts '((interactive))))) - (setq newguts (append newguts (list - (list 'elp-wrapper - (list 'quote funsym) - (list 'and - '(interactive-p) - (not (not (commandp funsym)))) - 'args)))) + (setq newguts (append newguts `((elp-wrapper + (quote ,funsym) + ,(when (commandp funsym) + '(called-interactively-p)) + args)))) ;; to record profiling times, we set the symbol's function ;; definition so that it runs the elp-wrapper function with the ;; function symbol as an argument. We place the old function @@ -266,17 +292,22 @@ FUNSYM must be a symbol of a defined function." ;; put the info vector on the property list (put funsym elp-timer-info-property infovec) - ;; set the symbol's new profiling function definition to run - ;; elp-wrapper - (fset funsym newguts) + ;; Set the symbol's new profiling function definition to run + ;; elp-wrapper. + (let ((advice-info (get funsym 'ad-advice-info))) + (if advice-info + (progn + ;; If function is advised, don't let Advice change + ;; its definition from under us during the `fset'. + (put funsym 'ad-advice-info nil) + (fset funsym newguts) + (put funsym 'ad-advice-info advice-info)) + (fset funsym newguts))) ;; add this function to the instrumentation list - (or (memq funsym elp-all-instrumented-list) - (setq elp-all-instrumented-list - (cons funsym elp-all-instrumented-list))) - )) + (unless (memq funsym elp-all-instrumented-list) + (push funsym elp-all-instrumented-list)))) -;;;###autoload (defun elp-restore-function (funsym) "Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function." @@ -323,18 +354,15 @@ Use optional LIST if provided instead." For example, to instrument all ELP functions, do the following: \\[elp-instrument-package] RET elp- RET" - (interactive "sPrefix of package to instrument: ") + (interactive + (list (completing-read "Prefix of package to instrument: " + obarray 'elp-profilable-p))) + (if (zerop (length prefix)) + (error "Instrumenting all Emacs functions would render Emacs unusable")) (elp-instrument-list (mapcar 'intern - (all-completions - prefix obarray - (function - (lambda (sym) - (and (fboundp sym) - (not (memq (car-safe (symbol-function sym)) '(autoload macro)))) - )) - )))) + (all-completions prefix obarray 'elp-profilable-p)))) (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. @@ -354,7 +382,7 @@ Use optional LIST if provided instead." (interactive "aFunction to reset: ") (let ((info (get funsym elp-timer-info-property))) (or info - (error "%s is not instrumented for profiling." funsym)) + (error "%s is not instrumented for profiling" funsym)) (aset info 0 0) ;reset call counter (aset info 1 0.0) ;reset total time ;; don't muck with aref 2 as that is the old symbol definition @@ -409,7 +437,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (func (aref info 2)) result) (or func - (error "%s is not instrumented for profiling." funsym)) + (error "%s is not instrumented for profiling" funsym)) (if (not elp-record-p) ;; when not recording, just call the original function symbol ;; and return the results. @@ -467,12 +495,12 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." ;; check for very large or small numbers (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) (concat (substring - (substring number (match-beginning 1) (match-end 1)) + (match-string 1 number) 0 (- width (match-end 2) (- (match-beginning 2)) 3)) "..." - (substring number (match-beginning 2) (match-end 2))) - (concat (substring number 0 width))))) + (match-string 2 number)) + (substring number 0 width)))) (defun elp-output-result (resultvec) ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or @@ -493,7 +521,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (numberp elp-report-limit) (< cc elp-report-limit)) nil - (insert symname) + (elp-output-insert-symname symname) (insert-char 32 (+ elp-field-len (- (length symname)) 2)) ;; print stuff out, formatting it nicely (insert callcnt) @@ -505,6 +533,27 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (insert atstr)) (insert "\n")))) +(defvar elp-results-symname-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'elp-results-jump-to-definition) + (define-key map "\C-m" 'elp-results-jump-to-definition) + map) + "Keymap used on the function name column." ) + +(defun elp-results-jump-to-definition (&optional event) + "Jump to the definition of the function under the point." + (interactive (list last-nonmenu-event)) + (if event (posn-set-point (event-end event))) + (find-function (get-text-property (point) 'elp-symname))) + +(defun elp-output-insert-symname (symname) + ;; Insert SYMNAME with text properties. + (insert (propertize symname + 'elp-symname (intern symname) + 'keymap elp-results-symname-map + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jumps to definition"))) + ;;;###autoload (defun elp-results () "Display current profiling results. @@ -518,7 +567,6 @@ displayed." (generate-new-buffer elp-results-buffer)))) (set-buffer resultsbuf) (erase-buffer) - (beginning-of-buffer) ;; get the length of the longest function name being profiled (let* ((longest 0) (title "Function Name") @@ -567,7 +615,7 @@ displayed." ;; 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) @@ -577,7 +625,12 @@ displayed." ;; 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) (provide 'elp) -;; elp.el ends here +;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 +;;; elp.el ends here