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