User: adrian
Date: 05/02/28 08:43:19
Modified: xemacs/lisp ChangeLog diagnose.el
Log:
[PATCH] xemacs-21.5-clean: show-memory-usage to sort sections by
<fyzlbidk.fsf(a)smtprelay.t-online.de>
Revision Changes Path
1.647 +5 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.646
retrieving revision 1.647
diff -u -r1.646 -r1.647
--- ChangeLog 2005/02/23 22:25:15 1.646
+++ ChangeLog 2005/02/28 07:43:17 1.647
@@ -1,3 +1,8 @@
+2005-02-25 Adrian Aichner <adrian(a)xemacs.org>
+
+ * diagnose.el: Fix typo.
+ * diagnose.el (show-memory-usage): Sort sections by total usage.
+
2005-02-23 Adrian Aichner <adrian(a)xemacs.org>
* cmdloop.el (keyboard-quit): Remove workaround for
1.2 +75 -35 XEmacs/xemacs/lisp/diagnose.el
Index: diagnose.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/diagnose.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- diagnose.el 2002/03/20 10:20:50 1.1
+++ diagnose.el 2005/02/28 07:43:18 1.2
@@ -1,4 +1,4 @@
-;;; debug.el --- routines for debugging problems in XEmacs
+;;; diagnose.el --- routines for debugging problems in XEmacs
;; Copyright (C) 2002 Ben Wing.
@@ -62,7 +62,7 @@
(incf linelen fieldlen)
(format "%%%ds" fieldlen)))
types "")
- (progn (incf linelen 8) "%8s\n")))
+ (progn (incf linelen 9) "%9s\n")))
(princ "\n")
(princ (apply 'format fmt objtypename
(append types (list 'total))))
@@ -85,41 +85,81 @@
(list totaltotal))))
totaltotal)))
- (let ((grandtotal 0))
- (with-output-to-temp-buffer "*memory usage*"
- (when-fboundp 'charset-list
+ (let ((grandtotal 0)
+ (buffer "*memory usage*")
+ begin)
+ (with-output-to-temp-buffer buffer
+ (save-excursion
+ (set-buffer buffer)
+ (when-fboundp 'charset-list
+ (setq begin (point))
+ (incf grandtotal
+ (show-foo-stats 'charset (charset-list)
+ #'charset-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 2)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
+ (princ "\n"))
+ (setq begin (point))
(incf grandtotal
- (show-foo-stats 'charset (charset-list)
- #'charset-memory-usage))
- (princ "\n"))
- (incf grandtotal
- (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage))
- (princ "\n")
- (incf grandtotal
- (show-foo-stats 'window (mapcan #'(lambda (fr)
- (window-list fr t))
- (frame-list))
- #'window-memory-usage))
- (princ "\n")
- (let ((total 0)
- (fmt "%-30s%10s\n"))
- (princ (format fmt "object" "storage"))
- (princ (make-string 40 ?-))
+ (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 3)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
(princ "\n")
- (map-plist #'(lambda (stat num)
- (when (string-match "\\(.*\\)-storage$"
- (symbol-name stat))
- (incf total num)
- (princ (format fmt
- (match-string 1 (symbol-name stat))
- num)))
- (when (eq stat 'long-strings-total-length)
- (incf total num)
- (princ (format fmt stat num))))
- (sixth (garbage-collect)))
+ (setq begin (point))
+ (incf grandtotal
+ (show-foo-stats 'window (mapcan #'(lambda (fr)
+ (window-list fr t))
+ (frame-list))
+ #'window-memory-usage))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 3)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
(princ "\n")
- (princ (format fmt "total" total))
- (incf grandtotal total))
+ (let ((total 0)
+ (fmt "%-30s%10s\n"))
+ (setq begin (point))
+ (princ (format fmt "object" "storage"))
+ (princ (make-string 40 ?-))
+ (princ "\n")
+ (map-plist #'(lambda (stat num)
+ (when (string-match "\\(.*\\)-storage$"
+ (symbol-name stat))
+ (incf total num)
+ (princ (format fmt
+ (match-string 1 (symbol-name stat))
+ num)))
+ (when (eq stat 'long-strings-total-length)
+ (incf total num)
+ (princ (format fmt stat num))))
+ (sixth (garbage-collect)))
+ (princ "\n")
+ (princ (format fmt "total" total))
+ (incf grandtotal total))
+ (sort-numeric-fields -1
+ (save-excursion
+ (goto-char begin)
+ (forward-line 2)
+ (point))
+ (save-excursion
+ (forward-line -2)
+ (point)))
- (princ (format "\n\ngrand total: %s\n" grandtotal))
+ (princ (format "\n\ngrand total: %s\n" grandtotal)))
grandtotal))))