Mercurial > hg > xemacs-beta
diff lisp/prim/profile.el @ 203:850242ba4a81 r20-3b28
Import from CVS: tag r20-3b28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:02:21 +0200 |
parents | eb5470882647 |
children | e45d5e7c476e |
line wrap: on
line diff
--- a/lisp/prim/profile.el Mon Aug 13 10:01:24 2007 +0200 +++ b/lisp/prim/profile.el Mon Aug 13 10:02:21 2007 +0200 @@ -60,8 +60,14 @@ ;;; Code: +(defun profile-align (form width) + ;; Bletch! this is what (format "%-*s" width form) should do. + (let ((printed-form (format "%s" form))) + (concat printed-form + (make-string (max 0 (- width (length printed-form))) ?\ )))) + ;;;###autoload -(defun profiling-results (&optional info stream) +(defun profile-results (&optional info stream) "Print profiling info INFO to STREAM in a pretty format. If INFO is omitted, the current profiling info is retrieved using `get-profiling-info'. @@ -76,32 +82,32 @@ (interactive-p)) (pop-to-buffer (get-buffer-create "*Profiling Results*")) (erase-buffer)) - (let* ((standard-output (or stream (if (interactive-p) - (current-buffer) - standard-output))) - (maxfunlen (max (length "Function Name") - (apply 'max (mapcar (lambda (sym) - (length (symbol-name - (car sym)))) - info)))) - (formatstr (format "%%-%ds" maxfunlen))) - (setq info (nreverse (sort info #'cdr-less-than-cdr))) - (princ (format (concat formatstr " Ticks %%/Total\n") - "Function Name")) + (let ((standard-output (or stream (if (interactive-p) + (current-buffer) + standard-output))) + ;; Calculate the longest function + (maxfunlen (apply #'max + (length "Function Name") + (mapcar (lambda (el) + ;; Functions longer than 40 + ;; characters don't qualify + (let ((l (length (format "%s" (car el))))) + (if (< l 40) + l 0))) + info)))) + (princ (format "%s Ticks %%/Total\n" + (profile-align "Function Name" maxfunlen))) (princ (make-string maxfunlen ?=)) (princ " ===== =======\n") - (let ((sum 0.0)) - (dolist (info2 info) - (incf sum (cdr info2))) - (while info - (let ((f (caar info))) - (princ (format (concat formatstr " %-5d %-6.3f\n") - f (cdar info) (* 100 (/ (cdar info) sum))))) - (pop info)) + (let ((sum (float (apply #'+ (mapcar #'cdr info))))) + (dolist (entry (nreverse (sort info #'cdr-less-than-cdr))) + (princ (format "%s %-5d %-6.3f\n" + (profile-align (car entry) maxfunlen) + (cdr entry) (* 100 (/ (cdr entry) sum))))) (princ (make-string maxfunlen ?-)) (princ "--------------------\n") - (princ (format (concat formatstr " %-5d %-6.2f\n") - "Total" sum 100.0)) + (princ (format "%s %-5d %-6.2f\n" + (profile-align "Total" maxfunlen) sum 100.0)) (princ (format "\n\nOne tick = %g ms\n" (/ default-profiling-interval 1000.0))))) (when (and (not stream) @@ -120,14 +126,12 @@ Otherwise, profiling will be left running. Returns the profiling info, printable by `profiling-results'." - `(progn - (if (profiling-active-p) + `(let ((was-profiling (profiling-active-p))) + (unwind-protect (progn + (start-profiling) ,@forms) - (unwind-protect - (progn - (start-profiling) - ,@forms) + (unless was-profiling (stop-profiling))) (get-profiling-info)))