Commit | Line | Data |
---|---|---|
6dd12ef2 CY |
1 | ;;; chart.el --- Draw charts (bar charts, etc) |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009, 2010 |
9ffe3f52 | 4 | ;; Free Software Foundation, Inc. |
6dd12ef2 CY |
5 | |
6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 | ;; 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 <http://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 | ||
64 | ;;; Code: | |
65 | (defvar chart-map nil "Keymap used in chart mode.") | |
66 | (if chart-map | |
67 | () | |
68 | (setq chart-map (make-sparse-keymap)) | |
69 | ) | |
70 | ||
71 | (defvar chart-local-object nil | |
72 | "Local variable containing the locally displayed chart object.") | |
73 | (make-variable-buffer-local 'chart-local-object) | |
74 | ||
75 | (defvar chart-face-list nil | |
76 | "Faces used to colorize charts. | |
77 | List is limited currently, which is ok since you really can't display | |
78 | too much in text characters anyways.") | |
79 | ||
80 | (defvar chart-face-color-list '("red" "green" "blue" | |
81 | "cyan" "yellow" "purple") | |
82 | "Colors to use when generating `chart-face-list'. | |
83 | Colors will be the background color.") | |
84 | ||
85 | (defvar chart-face-pixmap-list | |
86 | (if (and (fboundp 'display-graphic-p) | |
87 | (display-graphic-p)) | |
88 | '("dimple1" "scales" "dot" "cross_weave" "boxes" "dimple3")) | |
89 | "If pixmaps are allowed, display these background pixmaps. | |
a8f316ca | 90 | Useful if new Emacs is used on B&W display.") |
6dd12ef2 CY |
91 | |
92 | (defcustom chart-face-use-pixmaps nil | |
93 | "*Non-nil to use fancy pixmaps in the background of chart face colors." | |
94 | :group 'eieio | |
95 | :type 'boolean) | |
96 | ||
97 | (if (and (if (fboundp 'display-color-p) | |
98 | (display-color-p) | |
99 | window-system) | |
100 | (not chart-face-list)) | |
101 | (let ((cl chart-face-color-list) | |
102 | (pl chart-face-pixmap-list) | |
103 | nf) | |
104 | (while cl | |
105 | (setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl))))) | |
106 | (if (condition-case nil | |
107 | (> (x-display-color-cells) 4) | |
108 | (error t)) | |
109 | (set-face-background nf (car cl)) | |
110 | (set-face-background nf "white")) | |
111 | (set-face-foreground nf "black") | |
112 | (if (and chart-face-use-pixmaps | |
113 | pl | |
114 | (fboundp 'set-face-background-pixmap)) | |
115 | (condition-case nil | |
116 | (set-face-background-pixmap nf (car pl)) | |
117 | (error (message "Cannot set background pixmap %s" (car pl))))) | |
118 | (setq chart-face-list (cons nf chart-face-list)) | |
119 | (setq cl (cdr cl) | |
120 | pl (cdr pl))))) | |
121 | ||
122 | (defun chart-mode () | |
123 | "Define a mode in Emacs for displaying a chart." | |
124 | (kill-all-local-variables) | |
125 | (use-local-map chart-map) | |
126 | (setq major-mode 'chart-mode | |
127 | mode-name "CHART") | |
128 | (buffer-disable-undo) | |
129 | (set (make-local-variable 'font-lock-global-modes) nil) | |
130 | (font-lock-mode -1) | |
131 | (run-hooks 'chart-mode-hook) | |
132 | ) | |
133 | ||
134 | (defun chart-new-buffer (obj) | |
135 | "Create a new buffer NAME in which the chart OBJ is displayed. | |
a8f316ca | 136 | Returns the newly created buffer." |
9a529312 | 137 | (with-current-buffer (get-buffer-create (format "*%s*" (oref obj title))) |
6dd12ef2 CY |
138 | (chart-mode) |
139 | (setq chart-local-object obj) | |
140 | (current-buffer))) | |
141 | ||
142 | (defclass chart () | |
143 | ((title :initarg :title | |
144 | :initform "Emacs Chart") | |
145 | (title-face :initarg :title-face | |
146 | :initform 'bold-italic) | |
147 | (x-axis :initarg :x-axis | |
148 | :initform nil ) | |
149 | (x-margin :initarg :x-margin | |
150 | :initform 5) | |
151 | (x-width :initarg :x-width | |
152 | ) | |
153 | (y-axis :initarg :y-axis | |
154 | :initform nil) | |
155 | (y-margin :initarg :y-margin | |
156 | :initform 5) | |
157 | (y-width :initarg :y-width | |
158 | ) | |
159 | (key-label :initarg :key-label | |
160 | :initform "Key") | |
161 | (sequences :initarg :sequences | |
162 | :initform nil) | |
163 | ) | |
a8f316ca | 164 | "Superclass for all charts to be displayed in an Emacs buffer.") |
6dd12ef2 CY |
165 | |
166 | (defmethod initialize-instance :AFTER ((obj chart) &rest fields) | |
167 | "Initialize the chart OBJ being created with FIELDS. | |
168 | Make sure the width/height is correct." | |
169 | (oset obj x-width (- (window-width) 10)) | |
170 | (oset obj y-width (- (window-height) 12))) | |
171 | ||
172 | (defclass chart-axis () | |
173 | ((name :initarg :name | |
174 | :initform "Generic Axis") | |
175 | (loweredge :initarg :loweredge | |
176 | :initform t) | |
177 | (name-face :initarg :name-face | |
178 | :initform 'bold) | |
179 | (labels-face :initarg :lables-face | |
180 | :initform 'italic) | |
181 | (chart :initarg :chart | |
182 | :initform nil) | |
183 | ) | |
184 | "Superclass used for display of an axis.") | |
185 | ||
186 | (defclass chart-axis-range (chart-axis) | |
187 | ((bounds :initarg :bounds | |
188 | :initform '(0.0 . 50.0)) | |
189 | ) | |
a8f316ca | 190 | "Class used to display an axis defined by a range of values.") |
6dd12ef2 CY |
191 | |
192 | (defclass chart-axis-names (chart-axis) | |
193 | ((items :initarg :items | |
194 | :initform nil) | |
195 | ) | |
a8f316ca | 196 | "Class used to display an axis which represents different named items.") |
6dd12ef2 CY |
197 | |
198 | (defclass chart-sequece () | |
199 | ((data :initarg :data | |
200 | :initform nil) | |
201 | (name :initarg :name | |
202 | :initform "Data") | |
203 | ) | |
a8f316ca | 204 | "Class used for all data in different charts.") |
6dd12ef2 CY |
205 | |
206 | (defclass chart-bar (chart) | |
207 | ((direction :initarg :direction | |
208 | :initform vertical)) | |
a8f316ca | 209 | "Subclass for bar charts (vertical or horizontal).") |
6dd12ef2 CY |
210 | |
211 | (defmethod chart-draw ((c chart) &optional buff) | |
212 | "Start drawing a chart object C in optional BUFF. | |
a8f316ca | 213 | Erases current contents of buffer." |
6dd12ef2 CY |
214 | (save-excursion |
215 | (if buff (set-buffer buff)) | |
216 | (erase-buffer) | |
217 | (insert (make-string 100 ?\n)) | |
218 | ;; Start by displaying the axis | |
219 | (chart-draw-axis c) | |
220 | ;; Display title | |
221 | (chart-draw-title c) | |
222 | ;; Display data | |
223 | (message "Rendering chart...") | |
224 | (sit-for 0) | |
225 | (chart-draw-data c) | |
226 | ;; Display key | |
227 | ; (chart-draw-key c) | |
228 | (message "Rendering chart...done") | |
229 | )) | |
230 | ||
231 | (defmethod chart-draw-title ((c chart)) | |
232 | "Draw a title upon the chart. | |
233 | Argument C is the chart object." | |
234 | (chart-display-label (oref c title) 'horizontal 0 0 (window-width) | |
235 | (oref c title-face))) | |
236 | ||
237 | (defmethod chart-size-in-dir ((c chart) dir) | |
238 | "Return the physical size of chart C in direction DIR." | |
239 | (if (eq dir 'vertical) | |
240 | (oref c y-width) | |
241 | (oref c x-width))) | |
242 | ||
243 | (defmethod chart-draw-axis ((c chart)) | |
244 | "Draw axis into the current buffer defined by chart C." | |
245 | (let ((ymarg (oref c y-margin)) | |
246 | (xmarg (oref c x-margin)) | |
247 | (ylen (oref c y-width)) | |
248 | (xlen (oref c x-width))) | |
249 | (chart-axis-draw (oref c y-axis) 'vertical ymarg | |
250 | (if (oref (oref c y-axis) loweredge) nil xlen) | |
251 | xmarg (+ xmarg ylen)) | |
252 | (chart-axis-draw (oref c x-axis) 'horizontal xmarg | |
253 | (if (oref (oref c x-axis) loweredge) nil ylen) | |
254 | ymarg (+ ymarg xlen))) | |
255 | ) | |
256 | ||
257 | (defmethod chart-axis-draw ((a chart-axis) &optional dir margin zone start end) | |
a8f316ca | 258 | "Draw some axis for A in direction DIR with MARGIN in boundary. |
6dd12ef2 CY |
259 | ZONE is a zone specification. |
260 | START and END represent the boundary." | |
261 | (chart-draw-line dir (+ margin (if zone zone 0)) start end) | |
262 | (chart-display-label (oref a name) dir (if zone (+ zone margin 3) | |
263 | (if (eq dir 'horizontal) | |
264 | 1 0)) | |
265 | start end (oref a name-face))) | |
266 | ||
267 | (defmethod chart-translate-xpos ((c chart) x) | |
268 | "Translate in chart C the coordinate X into a screen column." | |
269 | (let ((range (oref (oref c x-axis) bounds))) | |
270 | (+ (oref c x-margin) | |
271 | (round (* (float (- x (car range))) | |
272 | (/ (float (oref c x-width)) | |
273 | (float (- (cdr range) (car range)))))))) | |
274 | ) | |
275 | ||
276 | (defmethod chart-translate-ypos ((c chart) y) | |
277 | "Translate in chart C the coordinate Y into a screen row." | |
278 | (let ((range (oref (oref c y-axis) bounds))) | |
279 | (+ (oref c x-margin) | |
280 | (- (oref c y-width) | |
281 | (round (* (float (- y (car range))) | |
282 | (/ (float (oref c y-width)) | |
283 | (float (- (cdr range) (car range))))))))) | |
284 | ) | |
285 | ||
286 | (defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end) | |
287 | "Draw axis information based upon a range to be spread along the edge. | |
288 | A is the chart to draw. DIR is the direction. | |
289 | MARGIN, ZONE, START, and END specify restrictions in chart space." | |
290 | (call-next-method) | |
291 | ;; We prefer about 5 spaces between each value | |
292 | (let* ((i (car (oref a bounds))) | |
293 | (e (cdr (oref a bounds))) | |
294 | (z (if zone zone 0)) | |
295 | (s nil) | |
296 | (rng (- e i)) | |
297 | ;; want to jump by units of 5 spaces or so | |
298 | (j (/ rng (/ (chart-size-in-dir (oref a chart) dir) 4))) | |
299 | p1) | |
300 | (if (= j 0) (setq j 1)) | |
301 | (while (<= i e) | |
302 | (setq s | |
303 | (cond ((> i 999999) | |
304 | (format "%dM" (/ i 1000000))) | |
305 | ((> i 999) | |
306 | (format "%dK" (/ i 1000))) | |
307 | (t | |
308 | (format "%d" i)))) | |
309 | (if (eq dir 'vertical) | |
310 | (let ((x (+ (+ margin z) (if (oref a loweredge) | |
311 | (- (length s)) 1)))) | |
312 | (if (< x 1) (setq x 1)) | |
313 | (chart-goto-xy x (chart-translate-ypos (oref a chart) i))) | |
314 | (chart-goto-xy (chart-translate-xpos (oref a chart) i) | |
315 | (+ margin z (if (oref a loweredge) -1 1)))) | |
316 | (setq p1 (point)) | |
317 | (insert s) | |
318 | (chart-zap-chars (length s)) | |
319 | (put-text-property p1 (point) 'face (oref a labels-face)) | |
320 | (setq i (+ i j)))) | |
321 | ) | |
322 | ||
323 | (defmethod chart-translate-namezone ((c chart) n) | |
324 | "Return a dot-pair representing a positional range for a name. | |
325 | The name in chart C of the Nth name resides. | |
045b9da7 | 326 | Automatically compensates for direction." |
6dd12ef2 CY |
327 | (let* ((dir (oref c direction)) |
328 | (w (if (eq dir 'vertical) (oref c x-width) (oref c y-width))) | |
329 | (m (if (eq dir 'vertical) (oref c y-margin) (oref c x-margin))) | |
330 | (ns (length | |
331 | (oref (if (eq dir 'vertical) (oref c x-axis) (oref c y-axis)) | |
332 | items))) | |
333 | (lpn (/ (+ 1.0 (float w)) (float ns))) | |
334 | ) | |
335 | (cons (+ m (round (* lpn (float n)))) | |
336 | (+ m -1 (round (* lpn (+ 1.0 (float n)))))) | |
337 | )) | |
338 | ||
339 | (defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end) | |
340 | "Draw axis information based upon A range to be spread along the edge. | |
a8f316ca JB |
341 | Optional argument DIR is the direction of the chart. |
342 | Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing." | |
6dd12ef2 CY |
343 | (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 | (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 | ) | |
384 | (while data | |
385 | (if (stringp (car (oref (car data) data))) | |
386 | ;; skip string lists... | |
387 | nil | |
388 | ;; display number lists... | |
389 | (let ((i 0) | |
390 | (seq (oref (car data) data))) | |
391 | (while seq | |
392 | (let* ((rng (chart-translate-namezone c i)) | |
393 | (dp (if (eq dir 'vertical) | |
394 | (chart-translate-ypos c (car seq)) | |
395 | (chart-translate-xpos c (car seq)))) | |
396 | (zp (if (eq dir 'vertical) | |
397 | (chart-translate-ypos c 0) | |
398 | (chart-translate-xpos c 0))) | |
399 | (fc (if chart-face-list | |
400 | (nth (% i (length chart-face-list)) chart-face-list) | |
401 | 'default)) | |
402 | ) | |
403 | (if (< dp zp) | |
404 | (progn | |
405 | (chart-draw-line dir (car rng) dp zp) | |
406 | (chart-draw-line dir (cdr rng) dp zp)) | |
407 | (chart-draw-line dir (car rng) zp (1+ dp)) | |
408 | (chart-draw-line dir (cdr rng) zp (1+ dp))) | |
409 | (if (= (car rng) (cdr rng)) nil | |
410 | (chart-draw-line odir dp (1+ (car rng)) (cdr rng)) | |
411 | (chart-draw-line odir zp (car rng) (1+ (cdr rng)))) | |
412 | (if (< dp zp) | |
413 | (chart-deface-rectangle dir rng (cons dp zp) fc) | |
414 | (chart-deface-rectangle dir rng (cons zp dp) fc)) | |
415 | ) | |
416 | ;; find the bounds, and chart it! | |
417 | ;; for now, only do one! | |
418 | (setq i (1+ i) | |
419 | seq (cdr seq))))) | |
420 | (setq data (cdr data)))) | |
421 | ) | |
422 | ||
423 | (defmethod chart-add-sequence ((c chart) &optional seq axis-label) | |
424 | "Add to chart object C the sequence object SEQ. | |
425 | If AXIS-LABEL, then the axis stored in C is updated with the bounds of SEQ, | |
426 | or is created with the bounds of SEQ." | |
427 | (if axis-label | |
428 | (let ((axis (eieio-oref c axis-label))) | |
429 | (if (stringp (car (oref seq data))) | |
430 | (let ((labels (oref seq data))) | |
431 | (if (not axis) | |
432 | (setq axis (make-instance chart-axis-names | |
433 | :name (oref seq name) | |
434 | :items labels | |
435 | :chart c)) | |
436 | (oset axis items labels))) | |
437 | (let ((range (cons 0 1)) | |
438 | (l (oref seq data))) | |
439 | (if (not axis) | |
440 | (setq axis (make-instance chart-axis-range | |
441 | :name (oref seq name) | |
442 | :chart c))) | |
443 | (while l | |
444 | (if (< (car l) (car range)) (setcar range (car l))) | |
445 | (if (> (car l) (cdr range)) (setcdr range (car l))) | |
446 | (setq l (cdr l))) | |
447 | (oset axis bounds range))) | |
448 | (if (eq axis-label 'x-axis) (oset axis loweredge nil)) | |
449 | (eieio-oset c axis-label axis) | |
450 | )) | |
451 | (oset c sequences (append (oref c sequences) (list seq)))) | |
452 | ||
453 | ;;; Charting optimizers | |
454 | ||
455 | (defmethod chart-trim ((c chart) max) | |
456 | "Trim all sequences in chart C to be at most MAX elements long." | |
457 | (let ((s (oref c sequences))) | |
458 | (while s | |
459 | (let ((sl (oref (car s) data))) | |
460 | (if (> (length sl) max) | |
461 | (setcdr (nthcdr (1- max) sl) nil))) | |
462 | (setq s (cdr s)))) | |
463 | ) | |
464 | ||
465 | (defmethod chart-sort ((c chart) pred) | |
466 | "Sort the data in chart C using predicate PRED. | |
a8f316ca | 467 | See `chart-sort-matchlist' for more details." |
6dd12ef2 CY |
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" (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) | |
a8f316ca | 488 | "Sort NAMELST and NUMLST (both sequence objects) based on predicate PRED. |
6dd12ef2 | 489 | PRED should be the equivalent of '<, except it must expect two |
a8f316ca | 490 | cons cells of the form (NAME . NUM). See `sort' for more details." |
6dd12ef2 CY |
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)))))) | |
528 | ||
529 | (defun chart-zap-chars (n) | |
9ffe3f52 | 530 | "Zap up to N chars without deleting EOLs." |
6dd12ef2 CY |
531 | (if (not (eobp)) |
532 | (if (< n (- (save-excursion (end-of-line) (point)) (point))) | |
533 | (delete-char n) | |
534 | (delete-region (point) (save-excursion (end-of-line) (point)))))) | |
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. | |
538 | Optional 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. | |
a8f316ca | 559 | Use column or row ZONE between START and END." |
6dd12ef2 CY |
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. | |
566 | R1 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) | |
a8f316ca | 580 | "Wash over the complex EIEIO stuff and create a nice bar chart. |
9ffe3f52 | 581 | Create it going in direction DIR ['horizontal 'vertical] with TITLE |
6dd12ef2 CY |
582 | using a name sequence NAMELST labeled NAMETITLE with values NUMLST |
583 | labeled NUMTITLE. | |
584 | Optional arguments: | |
a8f316ca | 585 | Set the chart's max element display to MAX, and sort lists with |
6dd12ef2 CY |
586 | SORT-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-sequece | |
595 | :data namelst | |
596 | :name nametitle) | |
597 | (if iv 'x-axis 'y-axis)) | |
598 | (chart-add-sequence nc | |
599 | (make-instance chart-sequece | |
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 | ) | |
617 | ||
618 | ;;; Sample utility function | |
619 | ||
620 | (defun chart-file-count (dir) | |
9ffe3f52 | 621 | "Draw a chart displaying the number of different file extensions in DIR." |
6dd12ef2 CY |
622 | (interactive "DDirectory: ") |
623 | (if (not (string-match "/$" dir)) | |
624 | (setq dir (concat dir "/"))) | |
625 | (message "Collecting statistics...") | |
626 | (let ((flst (directory-files dir nil nil t)) | |
627 | (extlst (list "<dir>")) | |
628 | (cntlst (list 0))) | |
629 | (while flst | |
630 | (let* ((j (string-match "[^\\.]\\(\\.[a-zA-Z]+\\|~\\|#\\)$" (car flst))) | |
631 | (s (if (file-accessible-directory-p (concat dir (car flst))) | |
632 | "<dir>" | |
633 | (if j | |
634 | (substring (car flst) (match-beginning 1) (match-end 1)) | |
635 | nil))) | |
636 | (m (member s extlst))) | |
637 | (if (not s) nil | |
638 | (if m | |
639 | (let ((cell (nthcdr (- (length extlst) (length m)) cntlst))) | |
640 | (setcar cell (1+ (car cell)))) | |
641 | (setq extlst (cons s extlst) | |
642 | cntlst (cons 1 cntlst))))) | |
643 | (setq flst (cdr flst))) | |
644 | ;; Lets create the chart! | |
645 | (chart-bar-quickie 'vertical "Files Extension Distribution" | |
646 | extlst "File Extensions" | |
db9e401b | 647 | cntlst "# of occurrences" |
6dd12ef2 CY |
648 | 10 |
649 | '(lambda (a b) (> (cdr a) (cdr b)))) | |
650 | )) | |
651 | ||
652 | (defun chart-space-usage (d) | |
653 | "Display a top usage chart for directory D." | |
654 | (interactive "DDirectory: ") | |
655 | (message "Collecting statistics...") | |
656 | (let ((nmlst nil) | |
657 | (cntlst nil) | |
658 | (b (get-buffer-create " *du-tmp*"))) | |
659 | (set-buffer b) | |
660 | (erase-buffer) | |
661 | (insert "cd " d ";du -sk * \n") | |
662 | (message "Running `cd %s;du -sk *'..." d) | |
663 | (call-process-region (point-min) (point-max) shell-file-name t | |
664 | (current-buffer) nil) | |
665 | (goto-char (point-min)) | |
666 | (message "Scanning output ...") | |
667 | (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t) | |
668 | (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) | |
669 | (num (buffer-substring (match-beginning 1) (match-end 1)))) | |
670 | (setq nmlst (cons nam nmlst) | |
671 | ;; * 1000 to put it into bytes | |
672 | cntlst (cons (* (string-to-number num) 1000) cntlst)))) | |
673 | (if (not nmlst) | |
674 | (error "No files found!")) | |
675 | (chart-bar-quickie 'vertical (format "Largest files in %s" d) | |
676 | nmlst "File Name" | |
677 | cntlst "File Size" | |
678 | 10 | |
679 | '(lambda (a b) (> (cdr a) (cdr b)))) | |
680 | )) | |
681 | ||
682 | (defun chart-emacs-storage () | |
683 | "Chart the current storage requirements of Emacs." | |
684 | (interactive) | |
685 | (let* ((data (garbage-collect)) | |
686 | (names '("strings/2" "vectors" | |
687 | "conses" "free cons" | |
688 | "syms" "free syms" | |
689 | "markers" "free mark" | |
690 | ;; "floats" "free flt" | |
691 | )) | |
692 | (nums (list (/ (nth 3 data) 2) | |
693 | (nth 4 data) | |
694 | (car (car data)) ; conses | |
695 | (cdr (car data)) | |
696 | (car (nth 1 data)) ; syms | |
697 | (cdr (nth 1 data)) | |
698 | (car (nth 2 data)) ; markers | |
699 | (cdr (nth 2 data)) | |
700 | ;(car (nth 5 data)) ; floats are Emacs only | |
701 | ;(cdr (nth 5 data)) | |
702 | ))) | |
703 | ;; Lets create the chart! | |
704 | (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" | |
705 | names "Storage Items" | |
706 | nums "Objects"))) | |
707 | ||
708 | (defun chart-emacs-lists () | |
709 | "Chart out the size of various important lists." | |
710 | (interactive) | |
711 | (let* ((names '("buffers" "frames" "processes" "faces")) | |
712 | (nums (list (length (buffer-list)) | |
713 | (length (frame-list)) | |
714 | (length (process-list)) | |
715 | (length (face-list)) | |
716 | ))) | |
717 | (if (fboundp 'x-display-list) | |
718 | (setq names (append names '("x-displays")) | |
719 | nums (append nums (list (length (x-display-list)))))) | |
720 | ;; Lets create the chart! | |
721 | (chart-bar-quickie 'vertical "Emacs List Size Chart" | |
722 | names "Various Lists" | |
723 | nums "Objects"))) | |
724 | ||
725 | (defun chart-rmail-from () | |
726 | "If we are in an rmail summary buffer, then chart out the froms." | |
727 | (interactive) | |
728 | (if (not (eq major-mode 'rmail-summary-mode)) | |
729 | (error "You must invoke chart-rmail-from in an rmail summary buffer")) | |
730 | (let ((nmlst nil) | |
731 | (cntlst nil)) | |
732 | (save-excursion | |
733 | (goto-char (point-min)) | |
734 | (while (re-search-forward "\\-[A-Z][a-z][a-z] +\\(\\w+\\)@\\w+" nil t) | |
735 | (let* ((nam (buffer-substring (match-beginning 1) (match-end 1))) | |
736 | (m (member nam nmlst))) | |
737 | (message "Scanned username %s" nam) | |
738 | (if m | |
739 | (let ((cell (nthcdr (- (length nmlst) (length m)) cntlst))) | |
740 | (setcar cell (1+ (car cell)))) | |
741 | (setq nmlst (cons nam nmlst) | |
742 | cntlst (cons 1 cntlst)))))) | |
db9e401b | 743 | (chart-bar-quickie 'vertical "Username Occurrence in RMAIL box" |
6dd12ef2 | 744 | nmlst "User Names" |
db9e401b | 745 | cntlst "# of occurrences" |
6dd12ef2 CY |
746 | 10 |
747 | '(lambda (a b) (> (cdr a) (cdr b)))) | |
748 | )) | |
749 | ||
750 | ||
751 | (provide 'chart) | |
752 | ||
3999968a | 753 | ;; arch-tag: 43847e44-5b45-465e-adc9-e505490a6b59 |
6dd12ef2 | 754 | ;;; chart.el ends here |