annotate lisp/prim/profile.el @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 85ec50267440
children 169c0442b401
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; profile.el --- basic profiling commands for XEmacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Copyright (C) 1996 Ben Wing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4
155
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
5 ;; Maintainer: XEmacs Development Team
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
6 ;; Keywords: internal
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
7
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;; General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
16
0293115a14e9 Import from CVS: tag r19-15b91
cvs
parents: 0
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 16
diff changeset
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
16
0293115a14e9 Import from CVS: tag r19-15b91
cvs
parents: 0
diff changeset
23 ;; Boston, MA 02111-1307, USA.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26
155
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
27 ;;; Commentary:
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
28
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
29 ;; `profile' macro and `profile-key-sequence' added in June 1997 by
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
30 ;; hniksic.
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
31
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
32
155
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
33 ;;; Code:
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
34
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
35 ;;;###autoload
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
36 (defun pretty-print-profiling-info (&optional info stream)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
37 "Print profiling info INFO to STREAM in a pretty format.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 If INFO is omitted, the current profiling info is retrieved using
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
39 `get-profiling-info'.
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
40 If STREAM is omitted, either current buffer or standard output are used,
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
41 depending on whether the function was called interactively or not."
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
42 (interactive)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
43 (if info
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
44 (setq info (copy-alist info))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 (setq info (get-profiling-info)))
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
46 (let ((standard-output (or stream (if (interactive-p)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
47 (current-buffer)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
48 standard-output))))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
49 (setq info (nreverse (sort info #'cdr-less-than-cdr)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
50 (princ "Function Count %\n")
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
51 (princ "---------------------------------------------------------------------\n")
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
52 (let ((sum 0.0))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
53 (dolist (info2 info)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
54 (incf sum (cdr info2)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
55 (while info
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
56 (let ((f (caar info)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
57 (princ (format "%-50s%10d %6.3f\n" f (cdar info)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
58 (* 100 (/ (cdar info) sum)))))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
59 (pop info)))))
155
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
60
165
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
61 ;;;###autoload
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
62 (defmacro profile (&rest forms)
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
63 "Turn on profiling, execute FORMS and restore profiling state.
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
64 Profiling state here means that if profiling was not in effect when
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
65 PROFILE was called, it will be turned off after FORMS are evaluated.
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
66 Otherwise, profiling will be left running.
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
67
165
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
68 Returns the profiling info, printable by `pretty-print-profiling-info'."
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
69 `(progn
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
70 (if (profiling-active-p)
165
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
71 (progn
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
72 ,@forms)
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
73 (unwind-protect
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
74 (progn
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
75 (start-profiling)
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
76 ,@forms)
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 167
diff changeset
77 (stop-profiling)))
165
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
78 (get-profiling-info)))
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
79
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
80 (put 'profile 'lisp-indent-function 0)
5a88923fcbfe Import from CVS: tag r20-3b9
cvs
parents: 155
diff changeset
81
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
82 ;;;###autoload
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
83 (defun profile-key-sequence (keys)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
84 "Dispatch the key sequence KEYS and profile the execution.
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
85 KEYS can be a vector of keypress events, a keypress event, or a character.
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
86 The function returns the profiling info."
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
87 (interactive "kProfile keystroke: ")
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
88 (and (characterp keys)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
89 (setq keys (character-to-event keys)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
90 (or (vectorp keys)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
91 (setq keys (vector keys)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
92 (profile
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
93 (mapc 'dispatch-event keys)))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 165
diff changeset
94
155
43dd3413c7c7 Import from CVS: tag r20-3b4
cvs
parents: 70
diff changeset
95 ;;; profile.el ends here