changeset 67188:25c21897d6a9

(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.

--- a/lisp/ChangeLog	Mon Nov 28 21:46:51 2005 +0000
+++ b/lisp/ChangeLog	Mon Nov 28 21:55:15 2005 +0000
@@ -1,5 +1,16 @@
 2005-11-28  Stefan Monnier  <[e-mail]>
 
+	* 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.

--- a/lisp/emacs-lisp/elp.el	Mon Nov 28 21:46:51 2005 +0000
+++ b/lisp/emacs-lisp/elp.el	Mon Nov 28 21:55:15 2005 +0000
@@ -206,18 +206,28 @@
   "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))))))
 
 
 ;;;###autoload
@@ -237,9 +247,6 @@
   (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 @@
     ;; 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 @@
 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 @@
     ;; 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 @@
 
 (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 @@
 		      '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 @@
 
 (provide 'elp)
 
-;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
+;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
 ;;; elp.el ends here