Mercurial > hg > xemacs-beta

changeset 2618:6db7dbf7f88b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-02-28 07:43:17 by adrian] [PATCH] xemacs-21.5-clean: show-memory-usage to sort sections by <fyzlbidk.fsf@smtprelay.t-online.de>
author adrian
date Mon, 28 Feb 2005 07:43:18 +0000
parents dfc913af3408
children 935833be8506
files lisp/ChangeLog lisp/diagnose.el
diffstat 2 files changed, 81 insertions(+), 36 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Feb 27 22:51:19 2005 +0000
+++ b/lisp/ChangeLog	Mon Feb 28 07:43:18 2005 +0000
@@ -1,3 +1,8 @@
+2005-02-25  Adrian Aichner  <adrian@xemacs.org>
+
+	* diagnose.el: Fix typo.
+	* diagnose.el (show-memory-usage): Sort sections by total usage.
+
 2005-02-23  Adrian Aichner  <adrian@xemacs.org>
 
 	* cmdloop.el (keyboard-quit): Remove workaround for
--- a/lisp/diagnose.el	Sun Feb 27 22:51:19 2005 +0000
+++ b/lisp/diagnose.el	Mon Feb 28 07:43:18 2005 +0000
@@ -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 '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")
+	  (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 '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")
-	  (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))
+	  (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))))