# HG changeset patch # User Stefan Monnier # Date 1133214915 0 # Node ID 25c21897d6a92b45f971a1cb423947b1ce41189c # Parent 805356939662ae49cdaa7ed1afd9c7163c88196a (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 -r 805356939662 -r 25c21897d6a9 lisp/ChangeLog --- 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 + * 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 -r 805356939662 -r 25c21897d6a9 lisp/emacs-lisp/elp.el --- 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