Mercurial > hg > xemacs-beta

comparison lisp/prim/profile.el @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents 5a88923fcbfe
children 8eaf7971accc
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
24 24
25 ;;; Synched up with: Not in FSF. 25 ;;; Synched up with: Not in FSF.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; `profile' macro and `profile-key-sequence' added in June 1997 by
30 ;; hniksic.
31
32
29 ;;; Code: 33 ;;; Code:
30 34
31 ;;;###autoload 35 ;;;###autoload
32 (defun pretty-print-profiling-info (&optional info) 36 (defun pretty-print-profiling-info (&optional info stream)
33 "Print profiling info INFO to standard output in a pretty format. 37 "Print profiling info INFO to STREAM in a pretty format.
34 If INFO is omitted, the current profiling info is retrieved using 38 If INFO is omitted, the current profiling info is retrieved using
35 `get-profiling-info'." 39 `get-profiling-info'.
36 (if info (setq info (copy-alist info)) 40 If STREAM is omitted, either current buffer or standard output are used,
41 depending on whether the function was called interactively or not."
42 (interactive)
43 (if info
44 (setq info (copy-alist info))
37 (setq info (get-profiling-info))) 45 (setq info (get-profiling-info)))
38 (setq info (nreverse (sort info #'cdr-less-than-cdr))) 46 (let ((standard-output (or stream (if (interactive-p)
39 (princ "Function Count %\n") 47 (current-buffer)
40 (princ "---------------------------------------------------------------------\n") 48 standard-output))))
41 (let ((sum 0.0)) 49 (setq info (nreverse (sort info #'cdr-less-than-cdr)))
42 (dolist (info2 info) 50 (princ "Function Count %\n")
43 (incf sum (cdr info2))) 51 (princ "---------------------------------------------------------------------\n")
44 (while info 52 (let ((sum 0.0))
45 (let ((f (caar info))) 53 (dolist (info2 info)
46 (princ (format "%-50s%10d %6.3f\n" f (cdar info) 54 (incf sum (cdr info2)))
47 (* 100 (/ (cdar info) sum))))) 55 (while info
48 (setq info (cdr info))))) 56 (let ((f (caar info)))
57 (princ (format "%-50s%10d %6.3f\n" f (cdar info)
58 (* 100 (/ (cdar info) sum)))))
59 (pop info)))))
49 60
50 ;;;###autoload 61 ;;;###autoload
51 (defmacro profile (&rest forms) 62 (defmacro profile (&rest forms)
52 "Turn on profiling, execute FORMS and stop profiling. 63 "Turn on profiling, execute FORMS and stop profiling.
53 Returns the profiling info, printable by `pretty-print-profiling-info'." 64 Returns the profiling info, printable by `pretty-print-profiling-info'."
59 (stop-profiling)) 70 (stop-profiling))
60 (get-profiling-info))) 71 (get-profiling-info)))
61 72
62 (put 'profile 'lisp-indent-function 0) 73 (put 'profile 'lisp-indent-function 0)
63 74
75 ;;;###autoload
76 (defun profile-key-sequence (keys)
77 "Dispatch the key sequence KEYS and profile the execution.
78 KEYS can be a vector of keypress events, a keypress event, or a character.
79 The function returns the profiling info."
80 (interactive "kProfile keystroke: ")
81 (and (characterp keys)
82 (setq keys (character-to-event keys)))
83 (or (vectorp keys)
84 (setq keys (vector keys)))
85 (profile
86 (mapc 'dispatch-event keys)))
87
64 ;;; profile.el ends here 88 ;;; profile.el ends here