Merge from emacs-23

[bpt/emacs.git] / lisp / emacs-lisp / elp.el

diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index a39b154..9a66527 100644 (file)
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,7 +1,7 @@
 ;;; elp.el --- Emacs Lisp Profiler
 
 ;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
 ;;; elp.el --- Emacs Lisp Profiler
 
 ;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,

-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.

 
 ;; Author: Barry A. Warsaw
 ;; Maintainer: FSF
 
 ;; Author: Barry A. Warsaw
 ;; Maintainer: FSF


@@ -10,10 +10,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; 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
 ;; 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 Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -21,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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:
 ;;
 
 ;;; Commentary:
 ;;


@@ -135,19 +133,19 @@
   :group 'lisp)
 
 (defcustom elp-function-list nil
   :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
 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
 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
 These functions are currently available:
 
   elp-sort-by-call-count   -- sort by the highest call count


@@ -164,7 +162,7 @@ the symbol's name string."
   :group 'elp)
 
 (defcustom elp-report-limit 1
   :group 'elp)
 
 (defcustom elp-report-limit 1

-  "*Prevent 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."
 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."


@@ -173,12 +171,12 @@ functions will be displayed."
   :group 'elp)
 
 (defcustom elp-use-standard-output nil
   :group 'elp)
 
 (defcustom elp-use-standard-output nil

-  "*If non-nil, 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
   :type 'boolean
   :group 'elp)
 
 (defcustom elp-recycle-buffers-p t

-  "*If nil, don't 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
 In other words, a new unique buffer is create every time you run
 \\[elp-results]."
   :type 'boolean


@@ -212,7 +210,10 @@ This variable is set by the master function.")
     ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
     ;;                   (aref (symbol-function 'elp-wrapper) 2)))
     ;; to help me find this list.
     ;; (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.")
   "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.")


@@ -268,7 +269,7 @@ FUNSYM must be a symbol of a defined function."
     (setq newguts (append newguts `((elp-wrapper
                                     (quote ,funsym)
                                     ,(when (commandp funsym)
     (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
                                     args))))
     ;; to record profiling times, we set the symbol's function
     ;; definition so that it runs the elp-wrapper function with the


@@ -342,9 +343,12 @@ Argument FUNSYM is the symbol of a defined function."
 
 ;;;###autoload
 (defun elp-instrument-list (&optional list)
 
 ;;;###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: ")
   (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)))
 
   (let ((list (or list elp-function-list)))
     (mapcar 'elp-instrument-function list)))
 


@@ -536,6 +540,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
 (defvar elp-results-symname-map
   (let ((map (make-sparse-keymap)))
     (define-key map [mouse-2] 'elp-results-jump-to-definition)
 (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." )
     (define-key map "\C-m" 'elp-results-jump-to-definition)
     map)
   "Keymap used on the function name column." )


@@ -552,6 +557,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
                      'elp-symname (intern symname)
                      'keymap elp-results-symname-map
                      'mouse-face 'highlight
                      'elp-symname (intern symname)
                      'keymap elp-results-symname-map
                      'mouse-face 'highlight

+                     'face 'link

                      'help-echo "mouse-2 or RET jumps to definition")))
 
 ;;;###autoload
                      'help-echo "mouse-2 or RET jumps to definition")))
 
 ;;;###autoload