aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2005-11-28 21:55:15 +0000
committerStefan Monnier2005-11-28 21:55:15 +0000
commitd95324034b2f5fd737c1f7c24fb5e00533b9b3cc (patch)
tree436d6e571b4db3d8016f7bfc174a2dffd942af31
parentcedbd3f084c41036b82ade1f7c45eaf1d8e5dfd3 (diff)
downloademacs-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/ChangeLog11
-rw-r--r--lisp/emacs-lisp/elp.el66
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 @@
12005-11-28 Stefan Monnier <monnier@iro.umontreal.ca> 12005-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.
211Those functions are used internally by the profiling code and profiling 217Those functions are used internally by the profiling code and profiling
212them would thus lead to infinite recursion.") 218them 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."
344For example, to instrument all ELP functions, do the following: 354For 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