206 |
"Master function symbol.") |
"Master function symbol.") |
207 |
|
|
208 |
(defvar elp-not-profilable |
(defvar elp-not-profilable |
209 |
'(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p) |
;; 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) |
216 |
"List of functions that cannot be profiled. |
"List of functions that cannot be profiled. |
217 |
Those functions are used internally by the profiling code and profiling |
Those functions are used internally by the profiling code and profiling |
218 |
them would thus lead to infinite recursion.") |
them would thus lead to infinite recursion.") |
219 |
|
|
220 |
(defun elp-not-profilable-p (fun) |
(defun elp-profilable-p (fun) |
221 |
(or (memq fun elp-not-profilable) |
(and (symbolp fun) |
222 |
(keymapp fun) |
(fboundp fun) |
223 |
(condition-case nil |
(not (or (memq fun elp-not-profilable) |
224 |
(when (subrp (symbol-function fun)) |
(keymapp fun) |
225 |
(eq 'unevalled (cdr (subr-arity (symbol-function fun))))) |
(memq (car-safe (symbol-function fun)) '(autoload macro)) |
226 |
(error nil)))) |
(condition-case nil |
227 |
|
(when (subrp (indirect-function fun)) |
228 |
|
(eq 'unevalled |
229 |
|
(cdr (subr-arity (indirect-function fun))))) |
230 |
|
(error nil)))))) |
231 |
|
|
232 |
|
|
233 |
;;;###autoload |
;;;###autoload |
247 |
(let* ((funguts (symbol-function funsym)) |
(let* ((funguts (symbol-function funsym)) |
248 |
(infovec (vector 0 0 funguts)) |
(infovec (vector 0 0 funguts)) |
249 |
(newguts '(lambda (&rest args)))) |
(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)) |
|
250 |
;; we cannot profile macros |
;; we cannot profile macros |
251 |
(and (eq (car-safe funguts) 'macro) |
(and (eq (car-safe funguts) 'macro) |
252 |
(error "ELP cannot profile macro: %s" funsym)) |
(error "ELP cannot profile macro: %s" funsym)) |
259 |
;; type functionality (i.e. it shouldn't execute the function). |
;; type functionality (i.e. it shouldn't execute the function). |
260 |
(and (eq (car-safe funguts) 'autoload) |
(and (eq (car-safe funguts) 'autoload) |
261 |
(error "ELP cannot profile autoloaded function: %s" funsym)) |
(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)) |
265 |
;; put rest of newguts together |
;; put rest of newguts together |
266 |
(if (commandp funsym) |
(if (commandp funsym) |
267 |
(setq newguts (append newguts '((interactive))))) |
(setq newguts (append newguts '((interactive))))) |
354 |
For example, to instrument all ELP functions, do the following: |
For example, to instrument all ELP functions, do the following: |
355 |
|
|
356 |
\\[elp-instrument-package] RET elp- RET" |
\\[elp-instrument-package] RET elp- RET" |
357 |
(interactive "sPrefix of package to instrument: ") |
(interactive |
358 |
|
(list (completing-read "Prefix of package to instrument: " |
359 |
|
obarray 'elp-profilable-p))) |
360 |
(if (zerop (length prefix)) |
(if (zerop (length prefix)) |
361 |
(error "Instrumenting all Emacs functions would render Emacs unusable")) |
(error "Instrumenting all Emacs functions would render Emacs unusable")) |
362 |
(elp-instrument-list |
(elp-instrument-list |
363 |
(mapcar |
(mapcar |
364 |
'intern |
'intern |
365 |
(all-completions |
(all-completions prefix obarray 'elp-profilable-p)))) |
|
prefix obarray |
|
|
(lambda (sym) |
|
|
(and (fboundp sym) |
|
|
(not (or (memq (car-safe (symbol-function sym)) '(autoload macro)) |
|
|
(elp-not-profilable-p sym))))))))) |
|
366 |
|
|
367 |
(defun elp-restore-list (&optional list) |
(defun elp-restore-list (&optional list) |
368 |
"Restore the original definitions for all functions in `elp-function-list'. |
"Restore the original definitions for all functions in `elp-function-list'. |
495 |
;; check for very large or small numbers |
;; check for very large or small numbers |
496 |
(if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) |
(if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) |
497 |
(concat (substring |
(concat (substring |
498 |
(substring number (match-beginning 1) (match-end 1)) |
(match-string 1 number) |
499 |
0 |
0 |
500 |
(- width (match-end 2) (- (match-beginning 2)) 3)) |
(- width (match-end 2) (- (match-beginning 2)) 3)) |
501 |
"..." |
"..." |
502 |
(substring number (match-beginning 2) (match-end 2))) |
(match-string 2 number)) |
503 |
(concat (substring number 0 width))))) |
(substring number 0 width)))) |
504 |
|
|
505 |
(defun elp-output-result (resultvec) |
(defun elp-output-result (resultvec) |
506 |
;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or |
;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or |
535 |
|
|
536 |
(defvar elp-results-symname-map |
(defvar elp-results-symname-map |
537 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
538 |
(define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse) |
(define-key map [mouse-2] 'elp-results-jump-to-definition) |
539 |
(define-key map "\C-m" 'elp-results-jump-to-definition) |
(define-key map "\C-m" 'elp-results-jump-to-definition) |
540 |
map) |
map) |
541 |
"Keymap used on the function name column." ) |
"Keymap used on the function name column." ) |
542 |
|
|
543 |
(defun elp-results-jump-to-definition-by-mouse (event) |
(defun elp-results-jump-to-definition (&optional 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 () |
|
544 |
"Jump to the definition of the function under the point." |
"Jump to the definition of the function under the point." |
545 |
(interactive) |
(interactive (list last-nonmenu-event)) |
546 |
|
(if event (posn-set-point (event-end event))) |
547 |
(find-function (get-text-property (point) 'elp-symname))) |
(find-function (get-text-property (point) 'elp-symname))) |
548 |
|
|
549 |
(defun elp-output-insert-symname (symname) |
(defun elp-output-insert-symname (symname) |
552 |
'elp-symname (intern symname) |
'elp-symname (intern symname) |
553 |
'keymap elp-results-symname-map |
'keymap elp-results-symname-map |
554 |
'mouse-face 'highlight |
'mouse-face 'highlight |
555 |
'help-echo (substitute-command-keys "\\{elp-results-symname-map}")))) |
'help-echo "mouse-2 or RET jumps to definition"))) |
556 |
|
|
557 |
;;;###autoload |
;;;###autoload |
558 |
(defun elp-results () |
(defun elp-results () |
632 |
|
|
633 |
(provide 'elp) |
(provide 'elp) |
634 |
|
|
635 |
;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 |
;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 |
636 |
;;; elp.el ends here |
;;; elp.el ends here |