1;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*- 2 3;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2021 Free 4;; Software Foundation, Inc. 5 6;; Author: Eric M. Ludlam <zappo@gnu.org> 7;; Old-Version: 0.2 8;; Keywords: OO, chart, graph 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software: you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation, either version 3 of the License, or 15;; (at your option) any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25;;; Commentary: 26;; 27;; This package is an experiment of mine aiding in the debugging of 28;; eieio, and proved to be neat enough that others may like to use 29;; it. To quickly see what you can do with chart, run the command 30;; `chart-test-it-all'. 31;; 32;; Chart current can display bar-charts in either of two 33;; directions. It also supports ranged (integer) axis, and axis 34;; defined by some set of strings or names. These name can be 35;; automatically derived from data sequences, which are just lists of 36;; anything encapsulated in a nice eieio object. 37;; 38;; Current example apps for chart can be accessed via these commands: 39;; `chart-file-count' - count files w/ matching extensions 40;; `chart-space-usage' - display space used by files/directories 41;; `chart-emacs-storage' - Emacs storage units used/free (garbage-collect) 42;; `chart-emacs-lists' - length of Emacs lists 43;; `chart-rmail-from' - who sends you the most mail (in -summary only) 44;; 45;; Customization: 46;; 47;; If you find the default colors and pixmaps unpleasant, or too 48;; short, you can change them. The variable `chart-face-color-list' 49;; contains a list of colors, and `chart-face-pixmap-list' contains 50;; all the pixmaps to use. The current pixmaps are those found on 51;; several systems I found. The two lists should be the same length, 52;; as the long list will just be truncated. 53;; 54;; If you would like to draw your own stipples, simply create some 55;; xbm's and put them in a directory, then you can add: 56;; 57;; (setq x-bitmap-file-path (cons "~/mybitmaps" x-bitmap-file-path)) 58;; 59;; to your .emacs (or wherever) and load the `chart-face-pixmap-list' 60;; with all the bitmaps you want to use. 61 62(require 'eieio) 63(eval-when-compile (require 'cl-lib)) 64(eval-when-compile (require 'cl-generic)) 65 66;;; Code: 67(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1") 68(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.") 69 70(defvar-local chart-local-object nil 71 "Local variable containing the locally displayed chart object.") 72 73(defvar chart-face-color-list '("red" "green" "blue" 74 "cyan" "yellow" "purple") 75 "Colors to use when generating `chart-face-list'. 76Colors will be the background color.") 77 78(defvar chart-face-pixmap-list 79 (if (and (fboundp 'display-graphic-p) 80 (display-graphic-p)) 81 '("dimple1" "scales" "dot" "cross_weave" "boxes" "dimple3")) 82 "If pixmaps are allowed, display these background pixmaps. 83Useful if new Emacs is used on B&W display.") 84 85(defcustom chart-face-use-pixmaps nil 86 "Non-nil to use fancy pixmaps in the background of chart face colors." 87 :group 'eieio 88 :type 'boolean) 89 90(declare-function x-display-color-cells "xfns.c" (&optional terminal)) 91 92(defvar chart-face-list #'chart--face-list 93 "Faces used to colorize charts. 94This should either be a list of faces, or a function that returns 95a list of faces. 96 97List is limited currently, which is ok since you really can't display 98too much in text characters anyways.") 99 100(defun chart--face-list () 101 (and 102 (display-color-p) 103 (let ((cl chart-face-color-list) 104 (pl chart-face-pixmap-list) 105 (faces ()) 106 nf) 107 (while cl 108 (setq nf (make-face 109 (intern (concat "chart-" (car cl) "-" (car pl))))) 110 (set-face-background nf (if (condition-case nil 111 (> (x-display-color-cells) 4) 112 (error t)) 113 (car cl) 114 "white")) 115 (set-face-foreground nf "black") 116 (if (and chart-face-use-pixmaps pl) 117 (condition-case nil 118 (set-face-background-pixmap nf (car pl)) 119 (error (message "Cannot set background pixmap %s" (car pl))))) 120 (push nf faces) 121 (setq cl (cdr cl) 122 pl (cdr pl))) 123 faces))) 124 125(define-derived-mode chart-mode special-mode "Chart" 126 "Define a mode in Emacs for displaying a chart." 127 (buffer-disable-undo) 128 (setq-local font-lock-global-modes nil) 129 (font-lock-mode -1) ;Isn't it off already? --Stef 130 ) 131 132(defclass chart () 133 ((title :initarg :title 134 :initform "Emacs Chart") 135 (title-face :initarg :title-face 136 :initform 'bold-italic) 137 (x-axis :initarg :x-axis 138 :initform nil ) 139 (x-margin :initarg :x-margin 140 :initform 5) 141 (x-width :initarg :x-width 142 ) 143 (y-axis :initarg :y-axis 144 :initform nil) 145 (y-margin :initarg :y-margin 146 :initform 5) 147 (y-width :initarg :y-width 148 ) 149 (key-label :initarg :key-label 150 :initform "Key") 151 (sequences :initarg :sequences 152 :initform nil) 153 ) 154 "Superclass for all charts to be displayed in an Emacs buffer.") 155 156(defun chart-new-buffer (obj) 157 "Create a new buffer NAME in which the chart OBJ is displayed. 158Returns the newly created buffer." 159 (with-current-buffer (get-buffer-create (format "*%s*" (oref obj title))) 160 (chart-mode) 161 (setq chart-local-object obj) 162 (current-buffer))) 163 164(cl-defmethod initialize-instance :after ((obj chart) &rest _fields) 165 "Initialize the chart OBJ being created with FIELDS. 166Make sure the width/height is correct." 167 (oset obj x-width (- (window-width) 10)) 168 (oset obj y-width (- (window-height) 12))) 169 170(defclass chart-axis () 171 ((name :initarg :name 172 :initform "Generic Axis") 173 (loweredge :initarg :loweredge 174 :initform t) 175 (name-face :initarg :name-face 176 :initform 'bold) 177 (labels-face :initarg :labels-face 178 :initform 'italic) 179 (chart :initarg :chart 180 :initform nil) 181 ) 182 "Superclass used for display of an axis.") 183 184(defclass chart-axis-range (chart-axis) 185 ((bounds :initarg :bounds 186 :initform '(0.0 . 50.0)) 187 ) 188 "Class used to display an axis defined by a range of values.") 189 190(defclass chart-axis-names (chart-axis) 191 ((items :initarg :items 192 :initform nil) 193 ) 194 "Class used to display an axis which represents different named items.") 195 196(defclass chart-sequence () 197 ((data :initarg :data 198 :initform nil) 199 (name :initarg :name 200 :initform "Data") 201 ) 202 "Class used for all data in different charts.") 203 204(defclass chart-bar (chart) 205 ((direction :initarg :direction 206 :initform 'vertical)) 207 "Subclass for bar charts (vertical or horizontal).") 208 209(cl-defmethod chart-draw ((c chart) &optional buff) 210 "Start drawing a chart object C in optional BUFF. 211Erases current contents of buffer." 212 (with-silent-modifications 213 (save-excursion 214 (if buff (set-buffer buff)) 215 (erase-buffer) 216 (insert (make-string (window-height (selected-window)) ?\n)) 217 ;; Start by displaying the axis 218 (chart-draw-axis c) 219 ;; Display title 220 (chart-draw-title c) 221 ;; Display data 222 (message "Rendering chart...") 223 (sit-for 0) 224 (chart-draw-data c) 225 ;; Display key 226 ; (chart-draw-key c) 227 (message "Rendering chart...done") 228 ))) 229 230(cl-defmethod chart-draw-title ((c chart)) 231 "Draw a title upon the chart. 232Argument C is the chart object." 233 (chart-display-label (oref c title) 'horizontal 0 0 (window-width) 234 (oref c title-face))) 235 236(cl-defmethod chart-size-in-dir ((c chart) dir) 237 "Return the physical size of chart C in direction DIR." 238 (if (eq dir 'vertical) 239 (oref c y-width) 240 (oref c x-width))) 241 242(cl-defmethod chart-draw-axis ((c chart)) 243 "Draw axis into the current buffer defined by chart C." 244 (let ((ymarg (oref c y-margin)) 245 (xmarg (oref c x-margin)) 246 (ylen (oref c y-width)) 247 (xlen (oref c x-width))) 248 (chart-axis-draw (oref c y-axis) 'vertical ymarg 249 (if (oref (oref c y-axis) loweredge) nil xlen) 250 xmarg (+ xmarg ylen)) 251 (chart-axis-draw (oref c x-axis) 'horizontal xmarg 252 (if (oref (oref c x-axis) loweredge) nil ylen) 253 ymarg (+ ymarg xlen))) 254 ) 255 256(cl-defmethod chart-axis-draw ((a chart-axis) &optional dir margin zone start end) 257 "Draw some axis for A in direction DIR with MARGIN in boundary. 258ZONE is a zone specification. 259START and END represent the boundary." 260 (chart-draw-line dir (+ margin (if zone zone 0)) start end) 261 (chart-display-label (oref a name) dir (if zone (+ zone margin 3) 262 (if (eq dir 'horizontal) 263 1 0)) 264 start end (oref a name-face))) 265 266(cl-defmethod chart-translate-xpos ((c chart) x) 267 "Translate in chart C the coordinate X into a screen column." 268 (let ((range (oref (oref c x-axis) bounds))) 269 (+ (oref c x-margin) 270 (round (* (float (- x (car range))) 271 (/ (float (oref c x-width)) 272 (float (- (cdr range) (car range)))))))) 273 ) 274 275(cl-defmethod chart-translate-ypos ((c chart) y) 276 "Translate in chart C the coordinate Y into a screen row." 277 (let ((range (oref (oref c y-axis) bounds))) 278 (+ (oref c x-margin) 279 (- (oref c y-width) 280 (round (* (float (- y (car range))) 281 (/ (float (oref c y-width)) 282 (float (- (cdr range) (car range))))))))) 283 ) 284 285(cl-defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end) 286 "Draw axis information based upon a range to be spread along the edge. 287A is the chart to draw. DIR is the direction. 288MARGIN, ZONE, START, and END specify restrictions in chart space." 289 (cl-call-next-method) 290 ;; We prefer about 5 spaces between each value 291 (let* ((i (car (oref a bounds))) 292 (e (cdr (oref a bounds))) 293 (z (if zone zone 0)) 294 (s nil) 295 (rng (- e i)) 296 ;; want to jump by units of 5 spaces or so 297 (j (/ rng (/ (chart-size-in-dir (oref a chart) dir) 4))) 298 p1) 299 (if (= j 0) (setq j 1)) 300 (while (<= i e) 301 (setq s 302 (cond ((> i 999999) 303 (format "%dM" (/ i 1000000))) 304 ((> i 999) 305 (format "%dK" (/ i 1000))) 306 (t 307 (format "%d" i)))) 308 (if (eq dir 'vertical) 309 (let ((x (+ (+ margin z) (if (oref a loweredge) 310 (- (length s)) 1)))) 311 (if (< x 1) (setq x 1)) 312 (chart-goto-xy x (chart-translate-ypos (oref a chart) i))) 313 (chart-goto-xy (chart-translate-xpos (oref a chart) i) 314 (+ margin z (if (oref a loweredge) -1 1)))) 315 (setq p1 (point)) 316 (insert s) 317 (chart-zap-chars (length s)) 318 (put-text-property p1 (point) 'face (oref a labels-face)) 319 (setq i (+ i j)))) 320) 321 322(cl-defmethod chart-translate-namezone ((c chart) n) 323 "Return a dot-pair representing a positional range for a name. 324The name in chart C of the Nth name resides. 325Automatically compensates for direction." 326 (let* ((dir (oref c direction)) 327 (w (if (eq dir 'vertical) (oref c x-width) (oref c y-width))) 328 (m (if (eq dir 'vertical) (oref c y-margin) (oref c x-margin))) 329 (ns (length 330 (oref (if (eq dir 'vertical) (oref c x-axis) (oref c y-axis)) 331 items))) 332 (lpn (/ (+ 1.0 (float w)) (float ns))) 333 ) 334 (cons (+ m (round (* lpn (float n)))) 335 (+ m -1 (round (* lpn (+ 1.0 (float n)))))) 336 )) 337 338(cl-defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end) 339 "Draw axis information based upon A range to be spread along the edge. 340Optional argument DIR is the direction of the chart. 341Optional arguments MARGIN, ZONE, START and END specify boundaries 342of the drawing." 343 (cl-call-next-method) 344 ;; We prefer about 5 spaces between each value 345 (let* ((i 0) 346 (s (oref a items)) 347 (z (if zone zone 0)) 348 (r nil) 349 (p nil) 350 (odd nil) 351 p1) 352 (while s 353 (setq odd (= (% (length s) 2) 1)) 354 (setq r (chart-translate-namezone (oref a chart) i)) 355 (if (eq dir 'vertical) 356 (setq p (/ (+ (car r) (cdr r)) 2)) 357 (setq p (- (+ (car r) (/ (- (cdr r) (car r)) 2)) 358 (/ (length (car s)) 2)))) 359 (if (eq dir 'vertical) 360 (let ((x (+ (+ margin z) (if (oref a loweredge) 361 (- (length (car s))) 362 (length (car s)))))) 363 (if (< x 1) (setq x 1)) 364 (if (> (length (car s)) (1- margin)) 365 (setq x (+ x margin))) 366 (chart-goto-xy x p)) 367 (chart-goto-xy p (+ (+ margin z) (if (oref a loweredge) 368 (if odd -2 -1) 369 (if odd 2 1))))) 370 (setq p1 (point)) 371 (insert (car s)) 372 (chart-zap-chars (length (car s))) 373 (put-text-property p1 (point) 'face (oref a labels-face)) 374 (setq i (+ i 1) 375 s (cdr s)))) 376) 377 378(cl-defmethod chart-draw-data ((c chart-bar)) 379 "Display the data available in a bar chart C." 380 (let* ((data (oref c sequences)) 381 (dir (oref c direction)) 382 (odir (if (eq dir 'vertical) 'horizontal 'vertical)) 383 (faces 384 (if (functionp chart-face-list) 385 (funcall chart-face-list) 386 chart-face-list))) 387 (while data 388 (if (stringp (car (oref (car data) data))) 389 ;; skip string lists... 390 nil 391 ;; display number lists... 392 (let ((i 0) 393 (seq (oref (car data) data))) 394 (while seq 395 (let* ((rng (chart-translate-namezone c i)) 396 (dp (if (eq dir 'vertical) 397 (chart-translate-ypos c (car seq)) 398 (chart-translate-xpos c (car seq)))) 399 (zp (if (eq dir 'vertical) 400 (chart-translate-ypos c 0) 401 (chart-translate-xpos c 0))) 402 (fc (if faces 403 (nth (% i (length faces)) faces) 404 'default))) 405 (if (< dp zp) 406 (progn 407 (chart-draw-line dir (car rng) dp zp) 408 (chart-draw-line dir (cdr rng) dp zp)) 409 (chart-draw-line dir (car rng) zp (1+ dp)) 410 (chart-draw-line dir (cdr rng) zp (1+ dp))) 411 (if (= (car rng) (cdr rng)) nil 412 (chart-draw-line odir dp (1+ (car rng)) (cdr rng)) 413 (chart-draw-line odir zp (car rng) (1+ (cdr rng)))) 414 (if (< dp zp) 415 (chart-deface-rectangle dir rng (cons dp zp) fc) 416 (chart-deface-rectangle dir rng (cons zp dp) fc)) 417 ) 418 ;; find the bounds, and chart it! 419 ;; for now, only do one! 420 (setq i (1+ i) 421 seq (cdr seq))))) 422 (setq data (cdr data)))) 423 ) 424 425(cl-defmethod chart-add-sequence ((c chart) &optional seq axis-label) 426 "Add to chart object C the sequence object SEQ. 427If AXIS-LABEL, then the axis stored in C is updated with the bounds of SEQ, 428or is created with the bounds of SEQ." 429 (if axis-label 430 (let ((axis (eieio-oref c axis-label))) 431 (if (stringp (car (oref seq data))) 432 (let ((labels (oref seq data))) 433 (if (not axis) 434 (setq axis (make-instance 'chart-axis-names 435 :name (oref seq name) 436 :items labels 437 :chart c)) 438 (oset axis items labels))) 439 (let ((range (cons 0 1)) 440 (l (oref seq data))) 441 (if (not axis) 442 (setq axis (make-instance 'chart-axis-range 443 :name (oref seq name) 444 :chart c))) 445 (dolist (x l) 446 (if (< x (car range)) (setcar range x)) 447 (if (> x (cdr range)) (setcdr range x))) 448 (oset axis bounds range))) 449 (if (eq axis-label 'x-axis) (oset axis loweredge nil)) 450 (eieio-oset c axis-label axis) 451 )) 452 (oset c sequences (append (oref c sequences) (list seq)))) 453 454;;; Charting optimizers 455 456(cl-defmethod chart-trim ((c chart) max) 457 "Trim all sequences in chart C to be at most MAX elements long." 458 (let ((s (oref c sequences))) 459 (dolist (x s) 460 (let ((sl (oref x data))) 461 (if (> (length sl) max) 462 (setcdr (nthcdr (1- max) sl) nil))))) 463 ) 464 465(cl-defmethod chart-sort ((c chart) pred) 466 "Sort the data in chart C using predicate PRED. 467See `chart-sort-matchlist' for more details." 468 (let* ((sl (oref c sequences)) 469 (s1 (car sl)) 470 (s2 (car (cdr sl))) 471 (s nil)) 472 (if (stringp (car (oref s1 data))) 473 (progn 474 (chart-sort-matchlist s1 s2 pred) 475 (setq s (oref s1 data))) 476 (if (stringp (car (oref s2 data))) 477 (progn 478 (chart-sort-matchlist s2 s1 pred) 479 (setq s (oref s2 data))) 480 (error "Sorting of chart %s not supported" (eieio-object-name c)))) 481 (if (eq (oref c direction) 'horizontal) 482 (oset (oref c y-axis) items s) 483 (oset (oref c x-axis) items s) 484 )) 485 ) 486 487(defun chart-sort-matchlist (namelst numlst pred) 488 "Sort NAMELST and NUMLST (both sequence objects) based on predicate PRED. 489PRED should be the equivalent of `<', except it must expect two 490cons cells of the form (NAME . NUM). See `sort' for more details." 491 ;; 1 - create 1 list of cons cells 492 (let ((newlist nil) 493 (alst (oref namelst data)) 494 (ulst (oref numlst data))) 495 (while alst 496 ;; this is reversed, but were are sorting anyway 497 (setq newlist (cons (cons (car alst) (car ulst)) newlist)) 498 (setq alst (cdr alst) 499 ulst (cdr ulst))) 500 ;; 2 - Run sort routine on it 501 (setq newlist (sort newlist pred) 502 alst nil 503 ulst nil) 504 ;; 3 - Separate the lists 505 (while newlist 506 (setq alst (cons (car (car newlist)) alst) 507 ulst (cons (cdr (car newlist)) ulst)) 508 (setq newlist (cdr newlist))) 509 ;; 4 - Store them back 510 (oset namelst data (reverse alst)) 511 (oset numlst data (reverse ulst)))) 512 513;;; Utilities 514 515(defun chart-goto-xy (x y) 516 "Move cursor to position X Y in buffer, and add spaces and CRs if needed." 517 (let ((indent-tabs-mode nil) 518 (num (progn (goto-char (point-min)) (forward-line y)))) 519 (if (and (= 0 num) (/= 0 (current-column))) (newline 1)) 520 (if (eobp) (newline num)) 521 (if (< x 0) (setq x 0)) 522 (if (< y 0) (setq y 0)) 523 ;; Now, a quicky column moveto/forceto method. 524 (or (= (move-to-column x) x) 525 (let ((p (point))) 526 (indent-to x) 527 (remove-text-properties p (point) '(face nil)))))) 528 529(defun chart-zap-chars (n) 530 "Zap up to N chars without deleting EOLs." 531 (if (not (eobp)) 532 (if (< n (- (point-at-eol) (point))) 533 (delete-char n) 534 (delete-region (point) (point-at-eol))))) 535 536(defun chart-display-label (label dir zone start end &optional face) 537 "Display LABEL in direction DIR in column/row ZONE between START and END. 538Optional argument FACE is the property we wish to place on this text." 539 (if (eq dir 'horizontal) 540 (let (p1) 541 (chart-goto-xy (+ start (- (/ (- end start) 2) (/ (length label) 2))) 542 zone) 543 (setq p1 (point)) 544 (insert label) 545 (chart-zap-chars (length label)) 546 (put-text-property p1 (point) 'face face) 547 ) 548 (let ((i 0) 549 (stz (+ start (- (/ (- end start) 2) (/ (length label) 2))))) 550 (while (< i (length label)) 551 (chart-goto-xy zone (+ stz i)) 552 (insert (aref label i)) 553 (chart-zap-chars 1) 554 (put-text-property (1- (point)) (point) 'face face) 555 (setq i (1+ i)))))) 556 557(defun chart-draw-line (dir zone start end) 558 "Draw a line using line-drawing characters in direction DIR. 559Use column or row ZONE between START and END." 560 (chart-display-label 561 (make-string (- end start) (if (eq dir 'vertical) ?| ?\-)) 562 dir zone start end)) 563 564(defun chart-deface-rectangle (dir r1 r2 face) 565 "Colorize a rectangle in direction DIR across range R1 by range R2. 566R1 and R2 are dotted pairs. Colorize it with FACE." 567 (let* ((range1 (if (eq dir 'vertical) r1 r2)) 568 (range2 (if (eq dir 'vertical) r2 r1)) 569 (y (car range2))) 570 (while (<= y (cdr range2)) 571 (chart-goto-xy (car range1) y) 572 (put-text-property (point) (+ (point) (1+ (- (cdr range1) (car range1)))) 573 'face face) 574 (setq y (1+ y))))) 575 576;;; Helpful `I don't want to learn eieio just now' washover functions 577 578(defun chart-bar-quickie (dir title namelst nametitle numlst numtitle 579 &optional max sort-pred) 580 "Wash over the complex EIEIO stuff and create a nice bar chart. 581Create it going in direction DIR [`horizontal' `vertical'] with TITLE 582using a name sequence NAMELST labeled NAMETITLE with values NUMLST 583labeled NUMTITLE. 584Optional arguments: 585Set the chart's max element display to MAX, and sort lists with 586SORT-PRED if desired." 587 (let ((nc (make-instance 'chart-bar 588 :title title 589 :key-label "8-m" ; This is a text key pic 590 :direction dir 591 )) 592 (iv (eq dir 'vertical))) 593 (chart-add-sequence nc 594 (make-instance 'chart-sequence 595 :data namelst 596 :name nametitle) 597 (if iv 'x-axis 'y-axis)) 598 (chart-add-sequence nc 599 (make-instance 'chart-sequence 600 :data numlst 601 :name numtitle) 602 (if iv 'y-axis 'x-axis)) 603 (if sort-pred (chart-sort nc sort-pred)) 604 (if (integerp max) (chart-trim nc max)) 605 (switch-to-buffer (chart-new-buffer nc)) 606 (chart-draw nc))) 607 608;;; Test code 609 610(defun chart-test-it-all () 611 "Test out various charting features." 612 (interactive) 613 (chart-bar-quickie 'vertical "Test Bar Chart" 614 '( "U1" "ME2" "C3" "B4" "QT" "EZ") "Items" 615 '( 5 -10 23 20 30 -3) "Values") 616 (if (not (called-interactively-p 'any)) 617 (kill-buffer "*Test Bar Chart*")) 618 ) 619 620;;; Sample utility function 621 622(defun chart-file-count (dir) 623 "Draw a chart displaying the number of different file extensions in DIR." 624 (interactive "DDirectory: ") 625 (message "Collecting statistics...") 626 (let ((flst (directory-files dir nil nil t)) 627 (extlst (list "<dir>")) 628 (cntlst (list 0))) 629 (dolist (f flst) 630 (let* ((x (file-name-extension f)) 631 (s (if (file-accessible-directory-p (expand-file-name f dir)) 632 "<dir>" x)) 633 (m (member s extlst))) 634 (unless (null s) 635 (if m 636 (cl-incf (car (nthcdr (- (length extlst) (length m)) cntlst))) 637 (setq extlst (cons s extlst) 638 cntlst (cons 1 cntlst)))))) 639 ;; Let's create the chart! 640 (chart-bar-quickie 'vertical "Files Extension Distribution" 641 extlst "File Extensions" 642 cntlst "# of occurrences" 643 10 644 (lambda (a b) (> (cdr a) (cdr b)))) 645 )) 646 647(defun chart-space-usage (d) 648 "Display a top usage chart for directory D." 649 (interactive "DDirectory: ") 650 (message "Collecting statistics...") 651 (let ((nmlst nil) 652 (cntlst nil) 653 (b (get-buffer-create " *du-tmp*"))) 654 (set-buffer b) 655 (erase-buffer) 656 (insert "cd " d ";du -sk * \n") 657 (message "Running `cd %s;du -sk *'..." d) 658 (call-process-region (point-min) (point-max) shell-file-name t 659 (current-buffer) nil) 660 (goto-char (point-min)) 661 (message "Scanning output ...") 662 (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t) 663 (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) 664 (num (buffer-substring (match-beginning 1) (match-end 1)))) 665 (setq nmlst (cons nam nmlst) 666 ;; * 1000 to put it into bytes 667 cntlst (cons (* (string-to-number num) 1000) cntlst)))) 668 (if (not nmlst) 669 (error "No files found!")) 670 (chart-bar-quickie 'vertical (format "Largest files in %s" d) 671 nmlst "File Name" 672 cntlst "File Size" 673 10 674 (lambda (a b) (> (cdr a) (cdr b)))) 675 )) 676 677(defun chart-emacs-storage () 678 "Chart the current storage requirements of Emacs." 679 (interactive) 680 (let* ((data (garbage-collect))) 681 ;; Let's create the chart! 682 (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" 683 (mapcar (lambda (x) (symbol-name (car x))) data) 684 "Storage Items" 685 (mapcar (lambda (x) (* (nth 1 x) (nth 2 x))) 686 data) 687 "Bytes"))) 688 689(defun chart-emacs-lists () 690 "Chart out the size of various important lists." 691 (interactive) 692 (let* ((names '("buffers" "frames" "processes" "faces")) 693 (nums (list (length (buffer-list)) 694 (length (frame-list)) 695 (length (process-list)) 696 (length (face-list)) 697 ))) 698 (if (fboundp 'x-display-list) 699 (setq names (append names '("x-displays")) 700 nums (append nums (list (length (x-display-list)))))) 701 ;; Let's create the chart! 702 (chart-bar-quickie 'vertical "Emacs List Size Chart" 703 names "Various Lists" 704 nums "Objects"))) 705 706(defun chart-rmail-from () 707 "If we are in an rmail summary buffer, then chart out the froms." 708 (interactive) 709 (if (not (eq major-mode 'rmail-summary-mode)) 710 (error "You must invoke chart-rmail-from in an rmail summary buffer")) 711 (let ((nmlst nil) 712 (cntlst nil)) 713 (save-excursion 714 (goto-char (point-min)) 715 (while (re-search-forward "-[A-Z][a-z][a-z] +\\(\\w+\\)@\\w+" nil t) 716 (let* ((nam (buffer-substring (match-beginning 1) (match-end 1))) 717 (m (member nam nmlst))) 718 (message "Scanned username %s" nam) 719 (if m 720 (let ((cell (nthcdr (- (length nmlst) (length m)) cntlst))) 721 (setcar cell (1+ (car cell)))) 722 (setq nmlst (cons nam nmlst) 723 cntlst (cons 1 cntlst)))))) 724 (chart-bar-quickie 'vertical "Username Occurrence in RMAIL box" 725 nmlst "User Names" 726 cntlst "# of occurrences" 727 10 728 (lambda (a b) (> (cdr a) (cdr b)))) 729 )) 730 731 732(provide 'chart) 733 734;;; chart.el ends here 735