(elp-not-profilable): Replace interactive-p with called-interactively-p.

(elp-profilable-p): Rename from elp-not-profilable-p.
Invert result and take into account macros and autoloaded functions.
(elp-instrument-function): Update call.
(elp-instrument-package): Update call.  Add completion.
(elp-pack-number): Use match-string.
(elp-results-jump-to-definition-by-mouse): Merge into
elp-results-jump-to-definition and then remove.
(elp-output-insert-symname): Make help echo text single-line.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1ffbcb3c91fddbbd4c185d65486b8772647bb43f..ed546b62fa703ada3cde8bc87063f3ba6f5b680b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,16 @@
 2005-11-28  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * emacs-lisp/elp.el (elp-not-profilable): Replace interactive-p with
+       called-interactively-p.
+       (elp-profilable-p): Rename from elp-not-profilable-p.
+       Invert result and take into account macros and autoloaded functions.
+       (elp-instrument-function): Update call.
+       (elp-instrument-package): Update call.  Add completion.
+       (elp-pack-number): Use match-string.
+       (elp-results-jump-to-definition-by-mouse): Merge into
+       elp-results-jump-to-definition and then remove.
+       (elp-output-insert-symname): Make help echo text single-line.
+
        * replace.el (query-replace-map): Move initialization into declaration.
        (occur-engine): Use with-current-buffer.
        (occur-mode-goto-occurrence): Make it work for mouse-clicks as well.

diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 426c79e51c3173d4825d51167a46b2b8d6a65bc2..569847a0ea168d91a9062d356a0adc8b310c4ef9 100644 (file)
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -206,18 +206,28 @@ This variable is set by the master function.")
   "Master function symbol.")
 
 (defvar elp-not-profilable
-  '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p)
+  ;; 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-not-profilable-p (fun)
-  (or (memq fun elp-not-profilable)
-      (keymapp fun)
-      (condition-case nil
-         (when (subrp (symbol-function fun))
-           (eq 'unevalled (cdr (subr-arity (symbol-function fun)))))
-       (error nil))))
+(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))))))
 
 \f
 ;;;###autoload
@@ -237,9 +247,6 @@ FUNSYM must be a symbol of a defined function."
   (let* ((funguts (symbol-function funsym))
         (infovec (vector 0 0 funguts))
         (newguts '(lambda (&rest args))))
-    ;; We cannot profile functions used internally during profiling.
-    (when (elp-not-profilable-p funsym)
-      (error "ELP cannot profile the function: %s" funsym))
     ;; we cannot profile macros
     (and (eq (car-safe funguts) 'macro)
         (error "ELP cannot profile macro: %s" funsym))
@@ -252,6 +259,9 @@ 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)))))
@@ -344,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
-     (lambda (sym)
-       (and (fboundp sym)
-           (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
-                    (elp-not-profilable-p sym)))))))))
+    (all-completions prefix obarray 'elp-profilable-p))))
 
 (defun elp-restore-list (&optional list)
   "Restore the original definitions for all functions in `elp-function-list'.
@@ -488,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
@@ -528,20 +535,15 @@ 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-by-mouse)
+    (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-by-mouse (event)
-  "Jump to the definition of the function under the place specified by EVENT."
-  (interactive "e")
-  (posn-set-point (event-end event))
-  (elp-results-jump-to-definition))
-
-(defun elp-results-jump-to-definition ()
+(defun elp-results-jump-to-definition (&optional event)
   "Jump to the definition of the function under the point."
-  (interactive)
+  (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)
@@ -550,7 +552,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
                      'elp-symname (intern symname)
                      'keymap elp-results-symname-map
                      'mouse-face 'highlight
-                     'help-echo (substitute-command-keys "\\{elp-results-symname-map}"))))
+                     'help-echo "mouse-2 or RET jumps to definition")))
 
 ;;;###autoload
 (defun elp-results ()
@@ -630,5 +632,5 @@ displayed."
 \f
 (provide 'elp)
 
-;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
+;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
 ;;; elp.el ends here