diff options
| author | Stefan Monnier | 2005-11-28 21:55:15 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2005-11-28 21:55:15 +0000 |
| commit | d95324034b2f5fd737c1f7c24fb5e00533b9b3cc (patch) | |
| tree | 436d6e571b4db3d8016f7bfc174a2dffd942af31 | |
| parent | cedbd3f084c41036b82ade1f7c45eaf1d8e5dfd3 (diff) | |
| download | emacs-d95324034b2f5fd737c1f7c24fb5e00533b9b3cc.tar.gz emacs-d95324034b2f5fd737c1f7c24fb5e00533b9b3cc.zip | |
(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.
| -rw-r--r-- | lisp/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/emacs-lisp/elp.el | 66 |
2 files changed, 45 insertions, 32 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1ffbcb3c91f..ed546b62fa7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,16 @@ | |||
| 1 | 2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * emacs-lisp/elp.el (elp-not-profilable): Replace interactive-p with | ||
| 4 | called-interactively-p. | ||
| 5 | (elp-profilable-p): Rename from elp-not-profilable-p. | ||
| 6 | Invert result and take into account macros and autoloaded functions. | ||
| 7 | (elp-instrument-function): Update call. | ||
| 8 | (elp-instrument-package): Update call. Add completion. | ||
| 9 | (elp-pack-number): Use match-string. | ||
| 10 | (elp-results-jump-to-definition-by-mouse): Merge into | ||
| 11 | elp-results-jump-to-definition and then remove. | ||
| 12 | (elp-output-insert-symname): Make help echo text single-line. | ||
| 13 | |||
| 3 | * replace.el (query-replace-map): Move initialization into declaration. | 14 | * replace.el (query-replace-map): Move initialization into declaration. |
| 4 | (occur-engine): Use with-current-buffer. | 15 | (occur-engine): Use with-current-buffer. |
| 5 | (occur-mode-goto-occurrence): Make it work for mouse-clicks as well. | 16 | (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 426c79e51c3..569847a0ea1 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el | |||
| @@ -206,18 +206,28 @@ This variable is set by the master function.") | |||
| 206 | "Master function symbol.") | 206 | "Master function symbol.") |
| 207 | 207 | ||
| 208 | (defvar elp-not-profilable | 208 | (defvar elp-not-profilable |
| 209 | '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p) | 209 | ;; First, the functions used inside each instrumented function: |
| 210 | '(elp-wrapper called-interactively-p | ||
| 211 | ;; Then the functions used by the above functions. I used | ||
| 212 | ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) | ||
| 213 | ;; (aref (symbol-function 'elp-wrapper) 2))) | ||
| 214 | ;; to help me find this list. | ||
| 215 | error call-interactively apply current-time) | ||
| 210 | "List of functions that cannot be profiled. | 216 | "List of functions that cannot be profiled. |
| 211 | Those functions are used internally by the profiling code and profiling | 217 | Those functions are used internally by the profiling code and profiling |
| 212 | them would thus lead to infinite recursion.") | 218 | them would thus lead to infinite recursion.") |
| 213 | 219 | ||
| 214 | (defun elp-not-profilable-p (fun) | 220 | (defun elp-profilable-p (fun) |
| 215 | (or (memq fun elp-not-profilable) | 221 | (and (symbolp fun) |
| 216 | (keymapp fun) | 222 | (fboundp fun) |
| 217 | (condition-case nil | 223 | (not (or (memq fun elp-not-profilable) |
| 218 | (when (subrp (symbol-function fun)) | 224 | (keymapp fun) |
| 219 | (eq 'unevalled (cdr (subr-arity (symbol-function fun))))) | 225 | (memq (car-safe (symbol-function fun)) '(autoload macro)) |
| 220 | (error nil)))) | 226 | (condition-case nil |
| 227 | (when (subrp (indirect-function fun)) | ||
| 228 | (eq 'unevalled | ||
| 229 | (cdr (subr-arity (indirect-function fun))))) | ||
| 230 | (error nil)))))) | ||
| 221 | 231 | ||
| 222 | 232 | ||
| 223 | ;;;###autoload | 233 | ;;;###autoload |
| @@ -237,9 +247,6 @@ FUNSYM must be a symbol of a defined function." | |||
| 237 | (let* ((funguts (symbol-function funsym)) | 247 | (let* ((funguts (symbol-function funsym)) |
| 238 | (infovec (vector 0 0 funguts)) | 248 | (infovec (vector 0 0 funguts)) |
| 239 | (newguts '(lambda (&rest args)))) | 249 | (newguts '(lambda (&rest args)))) |
| 240 | ;; We cannot profile functions used internally during profiling. | ||
| 241 | (when (elp-not-profilable-p funsym) | ||
| 242 | (error "ELP cannot profile the function: %s" funsym)) | ||
| 243 | ;; we cannot profile macros | 250 | ;; we cannot profile macros |
| 244 | (and (eq (car-safe funguts) 'macro) | 251 | (and (eq (car-safe funguts) 'macro) |
| 245 | (error "ELP cannot profile macro: %s" funsym)) | 252 | (error "ELP cannot profile macro: %s" funsym)) |
| @@ -252,6 +259,9 @@ FUNSYM must be a symbol of a defined function." | |||
| 252 | ;; type functionality (i.e. it shouldn't execute the function). | 259 | ;; type functionality (i.e. it shouldn't execute the function). |
| 253 | (and (eq (car-safe funguts) 'autoload) | 260 | (and (eq (car-safe funguts) 'autoload) |
| 254 | (error "ELP cannot profile autoloaded function: %s" funsym)) | 261 | (error "ELP cannot profile autoloaded function: %s" funsym)) |
| 262 | ;; We cannot profile functions used internally during profiling. | ||
| 263 | (unless (elp-profilable-p funsym) | ||
| 264 | (error "ELP cannot profile the function: %s" funsym)) | ||
| 255 | ;; put rest of newguts together | 265 | ;; put rest of newguts together |
| 256 | (if (commandp funsym) | 266 | (if (commandp funsym) |
| 257 | (setq newguts (append newguts '((interactive))))) | 267 | (setq newguts (append newguts '((interactive))))) |
| @@ -344,18 +354,15 @@ Use optional LIST if provided instead." | |||
| 344 | For example, to instrument all ELP functions, do the following: | 354 | For example, to instrument all ELP functions, do the following: |
| 345 | 355 | ||
| 346 | \\[elp-instrument-package] RET elp- RET" | 356 | \\[elp-instrument-package] RET elp- RET" |
| 347 | (interactive "sPrefix of package to instrument: ") | 357 | (interactive |
| 358 | (list (completing-read "Prefix of package to instrument: " | ||
| 359 | obarray 'elp-profilable-p))) | ||
| 348 | (if (zerop (length prefix)) | 360 | (if (zerop (length prefix)) |
| 349 | (error "Instrumenting all Emacs functions would render Emacs unusable")) | 361 | (error "Instrumenting all Emacs functions would render Emacs unusable")) |
| 350 | (elp-instrument-list | 362 | (elp-instrument-list |
| 351 | (mapcar | 363 | (mapcar |
| 352 | 'intern | 364 | 'intern |
| 353 | (all-completions | 365 | (all-completions prefix obarray 'elp-profilable-p)))) |
| 354 | prefix obarray | ||
| 355 | (lambda (sym) | ||
| 356 | (and (fboundp sym) | ||
| 357 | (not (or (memq (car-safe (symbol-function sym)) '(autoload macro)) | ||
| 358 | (elp-not-profilable-p sym))))))))) | ||
| 359 | 366 | ||
| 360 | (defun elp-restore-list (&optional list) | 367 | (defun elp-restore-list (&optional list) |
| 361 | "Restore the original definitions for all functions in `elp-function-list'. | 368 | "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]." | |||
| 488 | ;; check for very large or small numbers | 495 | ;; check for very large or small numbers |
| 489 | (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) | 496 | (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) |
| 490 | (concat (substring | 497 | (concat (substring |
| 491 | (substring number (match-beginning 1) (match-end 1)) | 498 | (match-string 1 number) |
| 492 | 0 | 499 | 0 |
| 493 | (- width (match-end 2) (- (match-beginning 2)) 3)) | 500 | (- width (match-end 2) (- (match-beginning 2)) 3)) |
| 494 | "..." | 501 | "..." |
| 495 | (substring number (match-beginning 2) (match-end 2))) | 502 | (match-string 2 number)) |
| 496 | (concat (substring number 0 width))))) | 503 | (substring number 0 width)))) |
| 497 | 504 | ||
| 498 | (defun elp-output-result (resultvec) | 505 | (defun elp-output-result (resultvec) |
| 499 | ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or | 506 | ;; 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]." | |||
| 528 | 535 | ||
| 529 | (defvar elp-results-symname-map | 536 | (defvar elp-results-symname-map |
| 530 | (let ((map (make-sparse-keymap))) | 537 | (let ((map (make-sparse-keymap))) |
| 531 | (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse) | 538 | (define-key map [mouse-2] 'elp-results-jump-to-definition) |
| 532 | (define-key map "\C-m" 'elp-results-jump-to-definition) | 539 | (define-key map "\C-m" 'elp-results-jump-to-definition) |
| 533 | map) | 540 | map) |
| 534 | "Keymap used on the function name column." ) | 541 | "Keymap used on the function name column." ) |
| 535 | 542 | ||
| 536 | (defun elp-results-jump-to-definition-by-mouse (event) | 543 | (defun elp-results-jump-to-definition (&optional event) |
| 537 | "Jump to the definition of the function under the place specified by EVENT." | ||
| 538 | (interactive "e") | ||
| 539 | (posn-set-point (event-end event)) | ||
| 540 | (elp-results-jump-to-definition)) | ||
| 541 | |||
| 542 | (defun elp-results-jump-to-definition () | ||
| 543 | "Jump to the definition of the function under the point." | 544 | "Jump to the definition of the function under the point." |
| 544 | (interactive) | 545 | (interactive (list last-nonmenu-event)) |
| 546 | (if event (posn-set-point (event-end event))) | ||
| 545 | (find-function (get-text-property (point) 'elp-symname))) | 547 | (find-function (get-text-property (point) 'elp-symname))) |
| 546 | 548 | ||
| 547 | (defun elp-output-insert-symname (symname) | 549 | (defun elp-output-insert-symname (symname) |
| @@ -550,7 +552,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." | |||
| 550 | 'elp-symname (intern symname) | 552 | 'elp-symname (intern symname) |
| 551 | 'keymap elp-results-symname-map | 553 | 'keymap elp-results-symname-map |
| 552 | 'mouse-face 'highlight | 554 | 'mouse-face 'highlight |
| 553 | 'help-echo (substitute-command-keys "\\{elp-results-symname-map}")))) | 555 | 'help-echo "mouse-2 or RET jumps to definition"))) |
| 554 | 556 | ||
| 555 | ;;;###autoload | 557 | ;;;###autoload |
| 556 | (defun elp-results () | 558 | (defun elp-results () |
| @@ -630,5 +632,5 @@ displayed." | |||
| 630 | 632 | ||
| 631 | (provide 'elp) | 633 | (provide 'elp) |
| 632 | 634 | ||
| 633 | ;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 | 635 | ;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 |
| 634 | ;;; elp.el ends here | 636 | ;;; elp.el ends here |