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