Mercurial > emacs
changeset 104432:71a5910811e0
Move eieio/chart.el to emacs-lisp/chart.el.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sun, 30 Aug 2009 02:04:15 +0000 |
| parents | a64f3429f0ac |
| children | 77f14bf50035 |
| files | lisp/eieio/chart.el lisp/emacs-lisp/chart.el |
| diffstat | 2 files changed, 755 insertions(+), 755 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/eieio/chart.el Sun Aug 30 02:02:15 2009 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,755 +0,0 @@ -;;; chart.el --- Draw charts (bar charts, etc) - -;;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009 -;;; Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 -;; Keywords: OO, chart, graph - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; This package is an experiment of mine aiding in the debugging of -;; eieio, and proved to be neat enough that others may like to use -;; it. To quickly see what you can do with chart, run the command -;; `chart-test-it-all'. -;; -;; Chart current can display bar-charts in either of two -;; directions. It also supports ranged (integer) axis, and axis -;; defined by some set of strings or names. These name can be -;; automatically derived from data sequences, which are just lists of -;; anything encapsulated in a nice eieio object. -;; -;; Current example apps for chart can be accessed via these commands: -;; `chart-file-count' - count files w/ matching extensions -;; `chart-space-usage' - display space used by files/directories -;; `chart-emacs-storage' - Emacs storage units used/free (garbage-collect) -;; `chart-emacs-lists' - length of Emacs lists -;; `chart-rmail-from' - who sends you the most mail (in -summary only) -;; -;; Customization: -;; -;; If you find the default colors and pixmaps unpleasant, or too -;; short, you can change them. The variable `chart-face-color-list' -;; contains a list of colors, and `chart-face-pixmap-list' contains -;; all the pixmaps to use. The current pixmaps are those found on -;; several systems I found. The two lists should be the same length, -;; as the long list will just be truncated. -;; -;; If you would like to draw your own stipples, simply create some -;; xbm's and put them in a directory, then you can add: -;; -;; (setq x-bitmap-file-path (cons "~/mybitmaps" x-bitmap-file-path)) -;; -;; to your .emacs (or wherever) and load the `chart-face-pixmap-list' -;; with all the bitmaps you want to use. - -(require 'eieio) - -;;; Code: -(defvar chart-map nil "Keymap used in chart mode.") -(if chart-map - () - (setq chart-map (make-sparse-keymap)) - ) - -(defvar chart-local-object nil - "Local variable containing the locally displayed chart object.") -(make-variable-buffer-local 'chart-local-object) - -(defvar chart-face-list nil - "Faces used to colorize charts. -List is limited currently, which is ok since you really can't display -too much in text characters anyways.") - -(defvar chart-face-color-list '("red" "green" "blue" - "cyan" "yellow" "purple") - "Colors to use when generating `chart-face-list'. -Colors will be the background color.") - -(defvar chart-face-pixmap-list - (if (and (fboundp 'display-graphic-p) - (display-graphic-p)) - '("dimple1" "scales" "dot" "cross_weave" "boxes" "dimple3")) - "If pixmaps are allowed, display these background pixmaps. -Useful if new Emacs is used on B&W display") - -(defcustom chart-face-use-pixmaps nil - "*Non-nil to use fancy pixmaps in the background of chart face colors." - :group 'eieio - :type 'boolean) - -(if (and (if (fboundp 'display-color-p) - (display-color-p) - window-system) - (not chart-face-list)) - (let ((cl chart-face-color-list) - (pl chart-face-pixmap-list) - nf) - (while cl - (setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl))))) - (if (condition-case nil - (> (x-display-color-cells) 4) - (error t)) - (set-face-background nf (car cl)) - (set-face-background nf "white")) - (set-face-foreground nf "black") - (if (and chart-face-use-pixmaps - pl - (fboundp 'set-face-background-pixmap)) - (condition-case nil - (set-face-background-pixmap nf (car pl)) - (error (message "Cannot set background pixmap %s" (car pl))))) - (setq chart-face-list (cons nf chart-face-list)) - (setq cl (cdr cl) - pl (cdr pl))))) - -(defun chart-mode () - "Define a mode in Emacs for displaying a chart." - (kill-all-local-variables) - (use-local-map chart-map) - (setq major-mode 'chart-mode - mode-name "CHART") - (buffer-disable-undo) - (set (make-local-variable 'font-lock-global-modes) nil) - (font-lock-mode -1) - (run-hooks 'chart-mode-hook) - ) - -(defun chart-new-buffer (obj) - "Create a new buffer NAME in which the chart OBJ is displayed. -Returns the newly created buffer" - (save-excursion - (set-buffer (get-buffer-create (format "*%s*" (oref obj title)))) - (chart-mode) - (setq chart-local-object obj) - (current-buffer))) - -(defclass chart () - ((title :initarg :title - :initform "Emacs Chart") - (title-face :initarg :title-face - :initform 'bold-italic) - (x-axis :initarg :x-axis - :initform nil ) - (x-margin :initarg :x-margin - :initform 5) - (x-width :initarg :x-width - ) - (y-axis :initarg :y-axis - :initform nil) - (y-margin :initarg :y-margin - :initform 5) - (y-width :initarg :y-width - ) - (key-label :initarg :key-label - :initform "Key") - (sequences :initarg :sequences - :initform nil) - ) - "Superclass for all charts to be displayed in an emacs buffer") - -(defmethod initialize-instance :AFTER ((obj chart) &rest fields) - "Initialize the chart OBJ being created with FIELDS. -Make sure the width/height is correct." - (oset obj x-width (- (window-width) 10)) - (oset obj y-width (- (window-height) 12))) - -(defclass chart-axis () - ((name :initarg :name - :initform "Generic Axis") - (loweredge :initarg :loweredge - :initform t) - (name-face :initarg :name-face - :initform 'bold) - (labels-face :initarg :lables-face - :initform 'italic) - (chart :initarg :chart - :initform nil) - ) - "Superclass used for display of an axis.") - -(defclass chart-axis-range (chart-axis) - ((bounds :initarg :bounds - :initform '(0.0 . 50.0)) - ) - "Class used to display an axis defined by a range of values") - -(defclass chart-axis-names (chart-axis) - ((items :initarg :items - :initform nil) - ) - "Class used to display an axis which represents different named items") - -(defclass chart-sequece () - ((data :initarg :data - :initform nil) - (name :initarg :name - :initform "Data") - ) - "Class used for all data in different charts") - -(defclass chart-bar (chart) - ((direction :initarg :direction - :initform vertical)) - "Subclass for bar charts. (Vertical or horizontal)") - -(defmethod chart-draw ((c chart) &optional buff) - "Start drawing a chart object C in optional BUFF. -Erases current contents of buffer" - (save-excursion - (if buff (set-buffer buff)) - (erase-buffer) - (insert (make-string 100 ?\n)) - ;; Start by displaying the axis - (chart-draw-axis c) - ;; Display title - (chart-draw-title c) - ;; Display data - (message "Rendering chart...") - (sit-for 0) - (chart-draw-data c) - ;; Display key - ; (chart-draw-key c) - (message "Rendering chart...done") - )) - -(defmethod chart-draw-title ((c chart)) - "Draw a title upon the chart. -Argument C is the chart object." - (chart-display-label (oref c title) 'horizontal 0 0 (window-width) - (oref c title-face))) - -(defmethod chart-size-in-dir ((c chart) dir) - "Return the physical size of chart C in direction DIR." - (if (eq dir 'vertical) - (oref c y-width) - (oref c x-width))) - -(defmethod chart-draw-axis ((c chart)) - "Draw axis into the current buffer defined by chart C." - (let ((ymarg (oref c y-margin)) - (xmarg (oref c x-margin)) - (ylen (oref c y-width)) - (xlen (oref c x-width))) - (chart-axis-draw (oref c y-axis) 'vertical ymarg - (if (oref (oref c y-axis) loweredge) nil xlen) - xmarg (+ xmarg ylen)) - (chart-axis-draw (oref c x-axis) 'horizontal xmarg - (if (oref (oref c x-axis) loweredge) nil ylen) - ymarg (+ ymarg xlen))) - ) - -(defmethod chart-axis-draw ((a chart-axis) &optional dir margin zone start end) - "Draw some axis for A in direction DIR at with MARGIN in boundry. -ZONE is a zone specification. -START and END represent the boundary." - (chart-draw-line dir (+ margin (if zone zone 0)) start end) - (chart-display-label (oref a name) dir (if zone (+ zone margin 3) - (if (eq dir 'horizontal) - 1 0)) - start end (oref a name-face))) - -(defmethod chart-translate-xpos ((c chart) x) - "Translate in chart C the coordinate X into a screen column." - (let ((range (oref (oref c x-axis) bounds))) - (+ (oref c x-margin) - (round (* (float (- x (car range))) - (/ (float (oref c x-width)) - (float (- (cdr range) (car range)))))))) - ) - -(defmethod chart-translate-ypos ((c chart) y) - "Translate in chart C the coordinate Y into a screen row." - (let ((range (oref (oref c y-axis) bounds))) - (+ (oref c x-margin) - (- (oref c y-width) - (round (* (float (- y (car range))) - (/ (float (oref c y-width)) - (float (- (cdr range) (car range))))))))) - ) - -(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end) - "Draw axis information based upon a range to be spread along the edge. -A is the chart to draw. DIR is the direction. -MARGIN, ZONE, START, and END specify restrictions in chart space." - (call-next-method) - ;; We prefer about 5 spaces between each value - (let* ((i (car (oref a bounds))) - (e (cdr (oref a bounds))) - (z (if zone zone 0)) - (s nil) - (rng (- e i)) - ;; want to jump by units of 5 spaces or so - (j (/ rng (/ (chart-size-in-dir (oref a chart) dir) 4))) - p1) - (if (= j 0) (setq j 1)) - (while (<= i e) - (setq s - (cond ((> i 999999) - (format "%dM" (/ i 1000000))) - ((> i 999) - (format "%dK" (/ i 1000))) - (t - (format "%d" i)))) - (if (eq dir 'vertical) - (let ((x (+ (+ margin z) (if (oref a loweredge) - (- (length s)) 1)))) - (if (< x 1) (setq x 1)) - (chart-goto-xy x (chart-translate-ypos (oref a chart) i))) - (chart-goto-xy (chart-translate-xpos (oref a chart) i) - (+ margin z (if (oref a loweredge) -1 1)))) - (setq p1 (point)) - (insert s) - (chart-zap-chars (length s)) - (put-text-property p1 (point) 'face (oref a labels-face)) - (setq i (+ i j)))) -) - -(defmethod chart-translate-namezone ((c chart) n) - "Return a dot-pair representing a positional range for a name. -The name in chart C of the Nth name resides. -Automatically compensates for for direction." - (let* ((dir (oref c direction)) - (w (if (eq dir 'vertical) (oref c x-width) (oref c y-width))) - (m (if (eq dir 'vertical) (oref c y-margin) (oref c x-margin))) - (ns (length - (oref (if (eq dir 'vertical) (oref c x-axis) (oref c y-axis)) - items))) - (lpn (/ (+ 1.0 (float w)) (float ns))) - ) - (cons (+ m (round (* lpn (float n)))) - (+ m -1 (round (* lpn (+ 1.0 (float n)))))) - )) - -(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end) - "Draw axis information based upon A range to be spread along the edge. -Optional argument DIR the direction of the chart. -Optional argument MARGIN , ZONE, START and END specify boundaries of the drawing." - (call-next-method) - ;; We prefer about 5 spaces between each value - (let* ((i 0) - (s (oref a items)) - (z (if zone zone 0)) - (r nil) - (p nil) - (odd nil) - p1) - (while s - (setq odd (= (% (length s) 2) 1)) - (setq r (chart-translate-namezone (oref a chart) i)) - (if (eq dir 'vertical) - (setq p (/ (+ (car r) (cdr r)) 2)) - (setq p (- (+ (car r) (/ (- (cdr r) (car r)) 2)) - (/ (length (car s)) 2)))) - (if (eq dir 'vertical) - (let ((x (+ (+ margin z) (if (oref a loweredge) - (- (length (car s))) - (length (car s)))))) - (if (< x 1) (setq x 1)) - (if (> (length (car s)) (1- margin)) - (setq x (+ x margin))) - (chart-goto-xy x p)) - (chart-goto-xy p (+ (+ margin z) (if (oref a loweredge) - (if odd -2 -1) - (if odd 2 1))))) - (setq p1 (point)) - (insert (car s)) - (chart-zap-chars (length (car s))) - (put-text-property p1 (point) 'face (oref a labels-face)) - (setq i (+ i 1) - s (cdr s)))) -) - -(defmethod chart-draw-data ((c chart-bar)) - "Display the data available in a bar chart C." - (let* ((data (oref c sequences)) - (dir (oref c direction)) - (odir (if (eq dir 'vertical) 'horizontal 'vertical)) - ) - (while data - (if (stringp (car (oref (car data) data))) - ;; skip string lists... - nil - ;; display number lists... - (let ((i 0) - (seq (oref (car data) data))) - (while seq - (let* ((rng (chart-translate-namezone c i)) - (dp (if (eq dir 'vertical) - (chart-translate-ypos c (car seq)) - (chart-translate-xpos c (car seq)))) - (zp (if (eq dir 'vertical) - (chart-translate-ypos c 0) - (chart-translate-xpos c 0))) - (fc (if chart-face-list - (nth (% i (length chart-face-list)) chart-face-list) - 'default)) - ) - (if (< dp zp) - (progn - (chart-draw-line dir (car rng) dp zp) - (chart-draw-line dir (cdr rng) dp zp)) - (chart-draw-line dir (car rng) zp (1+ dp)) - (chart-draw-line dir (cdr rng) zp (1+ dp))) - (if (= (car rng) (cdr rng)) nil - (chart-draw-line odir dp (1+ (car rng)) (cdr rng)) - (chart-draw-line odir zp (car rng) (1+ (cdr rng)))) - (if (< dp zp) - (chart-deface-rectangle dir rng (cons dp zp) fc) - (chart-deface-rectangle dir rng (cons zp dp) fc)) - ) - ;; find the bounds, and chart it! - ;; for now, only do one! - (setq i (1+ i) - seq (cdr seq))))) - (setq data (cdr data)))) - ) - -(defmethod chart-add-sequence ((c chart) &optional seq axis-label) - "Add to chart object C the sequence object SEQ. -If AXIS-LABEL, then the axis stored in C is updated with the bounds of SEQ, -or is created with the bounds of SEQ." - (if axis-label - (let ((axis (eieio-oref c axis-label))) - (if (stringp (car (oref seq data))) - (let ((labels (oref seq data))) - (if (not axis) - (setq axis (make-instance chart-axis-names - :name (oref seq name) - :items labels - :chart c)) - (oset axis items labels))) - (let ((range (cons 0 1)) - (l (oref seq data))) - (if (not axis) - (setq axis (make-instance chart-axis-range - :name (oref seq name) - :chart c))) - (while l - (if (< (car l) (car range)) (setcar range (car l))) - (if (> (car l) (cdr range)) (setcdr range (car l))) - (setq l (cdr l))) - (oset axis bounds range))) - (if (eq axis-label 'x-axis) (oset axis loweredge nil)) - (eieio-oset c axis-label axis) - )) - (oset c sequences (append (oref c sequences) (list seq)))) - -;;; Charting optimizers - -(defmethod chart-trim ((c chart) max) - "Trim all sequences in chart C to be at most MAX elements long." - (let ((s (oref c sequences))) - (while s - (let ((sl (oref (car s) data))) - (if (> (length sl) max) - (setcdr (nthcdr (1- max) sl) nil))) - (setq s (cdr s)))) - ) - -(defmethod chart-sort ((c chart) pred) - "Sort the data in chart C using predicate PRED. -See `chart-sort-matchlist' for more details" - (let* ((sl (oref c sequences)) - (s1 (car sl)) - (s2 (car (cdr sl))) - (s nil)) - (if (stringp (car (oref s1 data))) - (progn - (chart-sort-matchlist s1 s2 pred) - (setq s (oref s1 data))) - (if (stringp (car (oref s2 data))) - (progn - (chart-sort-matchlist s2 s1 pred) - (setq s (oref s2 data))) - (error "Sorting of chart %s not supported" (object-name c)))) - (if (eq (oref c direction) 'horizontal) - (oset (oref c y-axis) items s) - (oset (oref c x-axis) items s) - )) - ) - -(defun chart-sort-matchlist (namelst numlst pred) - "Sort NAMELST and NUMLST (both SEQUENCE objects) based on predicate PRED. -PRED should be the equivalent of '<, except it must expect two -cons cells of the form (NAME . NUM). See SORT for more details." - ;; 1 - create 1 list of cons cells - (let ((newlist nil) - (alst (oref namelst data)) - (ulst (oref numlst data))) - (while alst - ;; this is reversed, but were are sorting anyway - (setq newlist (cons (cons (car alst) (car ulst)) newlist)) - (setq alst (cdr alst) - ulst (cdr ulst))) - ;; 2 - Run sort routine on it - (setq newlist (sort newlist pred) - alst nil - ulst nil) - ;; 3 - Separate the lists - (while newlist - (setq alst (cons (car (car newlist)) alst) - ulst (cons (cdr (car newlist)) ulst)) - (setq newlist (cdr newlist))) - ;; 4 - Store them back - (oset namelst data (reverse alst)) - (oset numlst data (reverse ulst)))) - -;;; Utilities - -(defun chart-goto-xy (x y) - "Move cursor to position X Y in buffer, and add spaces and CRs if needed." - - (let ((indent-tabs-mode nil) - (num (goto-line (1+ y)))) - (if (and (= 0 num) (/= 0 (current-column))) (newline 1)) - (if (eobp) (newline num)) - (if (< x 0) (setq x 0)) - (if (< y 0) (setq y 0)) - ;; Now, a quicky column moveto/forceto method. - (or (= (move-to-column x) x) - (let ((p (point))) - (indent-to x) - (remove-text-properties p (point) '(face)))))) - -(defun chart-zap-chars (n) - "Zap up to N chars without deleteting EOLs." - (if (not (eobp)) - (if (< n (- (save-excursion (end-of-line) (point)) (point))) - (delete-char n) - (delete-region (point) (save-excursion (end-of-line) (point)))))) - -(defun chart-display-label (label dir zone start end &optional face) - "Display LABEL in direction DIR in column/row ZONE between START and END. -Optional argument FACE is the property we wish to place on this text." - (if (eq dir 'horizontal) - (let (p1) - (chart-goto-xy (+ start (- (/ (- end start) 2) (/ (length label) 2))) - zone) - (setq p1 (point)) - (insert label) - (chart-zap-chars (length label)) - (put-text-property p1 (point) 'face face) - ) - (let ((i 0) - (stz (+ start (- (/ (- end start) 2) (/ (length label) 2))))) - (while (< i (length label)) - (chart-goto-xy zone (+ stz i)) - (insert (aref label i)) - (chart-zap-chars 1) - (put-text-property (1- (point)) (point) 'face face) - (setq i (1+ i)))))) - -(defun chart-draw-line (dir zone start end) - "Draw a line using line-drawing characters in direction DIR. -Use column or row ZONE between START and END" - (chart-display-label - (make-string (- end start) (if (eq dir 'vertical) ?| ?\-)) - dir zone start end)) - -(defun chart-deface-rectangle (dir r1 r2 face) - "Colorize a rectangle in direction DIR across range R1 by range R2. -R1 and R2 are dotted pairs. Colorize it with FACE." - (let* ((range1 (if (eq dir 'vertical) r1 r2)) - (range2 (if (eq dir 'vertical) r2 r1)) - (y (car range2))) - (while (<= y (cdr range2)) - (chart-goto-xy (car range1) y) - (put-text-property (point) (+ (point) (1+ (- (cdr range1) (car range1)))) - 'face face) - (setq y (1+ y))))) - -;;; Helpful `I don't want to learn eieio just now' washover functions - -(defun chart-bar-quickie (dir title namelst nametitle numlst numtitle - &optional max sort-pred) - "Wash over the complex eieio stuff and create a nice bar chart. -Creat it going in direction DIR ['horizontal 'vertical] with TITLE -using a name sequence NAMELST labeled NAMETITLE with values NUMLST -labeled NUMTITLE. -Optional arguments: -Set the charts' max element display to MAX, and sort lists with -SORT-PRED if desired." - (let ((nc (make-instance chart-bar - :title title - :key-label "8-m" ; This is a text key pic - :direction dir - )) - (iv (eq dir 'vertical))) - (chart-add-sequence nc - (make-instance chart-sequece - :data namelst - :name nametitle) - (if iv 'x-axis 'y-axis)) - (chart-add-sequence nc - (make-instance chart-sequece - :data numlst - :name numtitle) - (if iv 'y-axis 'x-axis)) - (if sort-pred (chart-sort nc sort-pred)) - (if (integerp max) (chart-trim nc max)) - (switch-to-buffer (chart-new-buffer nc)) - (chart-draw nc))) - -;;; Test code - -(defun chart-test-it-all () - "Test out various charting features." - (interactive) - (chart-bar-quickie 'vertical "Test Bar Chart" - '( "U1" "ME2" "C3" "B4" "QT" "EZ") "Items" - '( 5 -10 23 20 30 -3) "Values") - ) - -;;; Sample utility function - -(defun chart-file-count (dir) - "Draw a chart displaying the number of different file extentions in DIR." - (interactive "DDirectory: ") - (if (not (string-match "/$" dir)) - (setq dir (concat dir "/"))) - (message "Collecting statistics...") - (let ((flst (directory-files dir nil nil t)) - (extlst (list "<dir>")) - (cntlst (list 0))) - (while flst - (let* ((j (string-match "[^\\.]\\(\\.[a-zA-Z]+\\|~\\|#\\)$" (car flst))) - (s (if (file-accessible-directory-p (concat dir (car flst))) - "<dir>" - (if j - (substring (car flst) (match-beginning 1) (match-end 1)) - nil))) - (m (member s extlst))) - (if (not s) nil - (if m - (let ((cell (nthcdr (- (length extlst) (length m)) cntlst))) - (setcar cell (1+ (car cell)))) - (setq extlst (cons s extlst) - cntlst (cons 1 cntlst))))) - (setq flst (cdr flst))) - ;; Lets create the chart! - (chart-bar-quickie 'vertical "Files Extension Distribution" - extlst "File Extensions" - cntlst "# of occurances" - 10 - '(lambda (a b) (> (cdr a) (cdr b)))) - )) - -(defun chart-space-usage (d) - "Display a top usage chart for directory D." - (interactive "DDirectory: ") - (message "Collecting statistics...") - (let ((nmlst nil) - (cntlst nil) - (b (get-buffer-create " *du-tmp*"))) - (set-buffer b) - (erase-buffer) - (insert "cd " d ";du -sk * \n") - (message "Running `cd %s;du -sk *'..." d) - (call-process-region (point-min) (point-max) shell-file-name t - (current-buffer) nil) - (goto-char (point-min)) - (message "Scanning output ...") - (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t) - (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) - (num (buffer-substring (match-beginning 1) (match-end 1)))) - (setq nmlst (cons nam nmlst) - ;; * 1000 to put it into bytes - cntlst (cons (* (string-to-number num) 1000) cntlst)))) - (if (not nmlst) - (error "No files found!")) - (chart-bar-quickie 'vertical (format "Largest files in %s" d) - nmlst "File Name" - cntlst "File Size" - 10 - '(lambda (a b) (> (cdr a) (cdr b)))) - )) - -(defun chart-emacs-storage () - "Chart the current storage requirements of Emacs." - (interactive) - (let* ((data (garbage-collect)) - (names '("strings/2" "vectors" - "conses" "free cons" - "syms" "free syms" - "markers" "free mark" - ;; "floats" "free flt" - )) - (nums (list (/ (nth 3 data) 2) - (nth 4 data) - (car (car data)) ; conses - (cdr (car data)) - (car (nth 1 data)) ; syms - (cdr (nth 1 data)) - (car (nth 2 data)) ; markers - (cdr (nth 2 data)) - ;(car (nth 5 data)) ; floats are Emacs only - ;(cdr (nth 5 data)) - ))) - ;; Lets create the chart! - (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" - names "Storage Items" - nums "Objects"))) - -(defun chart-emacs-lists () - "Chart out the size of various important lists." - (interactive) - (let* ((names '("buffers" "frames" "processes" "faces")) - (nums (list (length (buffer-list)) - (length (frame-list)) - (length (process-list)) - (length (face-list)) - ))) - (if (fboundp 'x-display-list) - (setq names (append names '("x-displays")) - nums (append nums (list (length (x-display-list)))))) - ;; Lets create the chart! - (chart-bar-quickie 'vertical "Emacs List Size Chart" - names "Various Lists" - nums "Objects"))) - -(defun chart-rmail-from () - "If we are in an rmail summary buffer, then chart out the froms." - (interactive) - (if (not (eq major-mode 'rmail-summary-mode)) - (error "You must invoke chart-rmail-from in an rmail summary buffer")) - (let ((nmlst nil) - (cntlst nil)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\\-[A-Z][a-z][a-z] +\\(\\w+\\)@\\w+" nil t) - (let* ((nam (buffer-substring (match-beginning 1) (match-end 1))) - (m (member nam nmlst))) - (message "Scanned username %s" nam) - (if m - (let ((cell (nthcdr (- (length nmlst) (length m)) cntlst))) - (setcar cell (1+ (car cell)))) - (setq nmlst (cons nam nmlst) - cntlst (cons 1 cntlst)))))) - (chart-bar-quickie 'vertical "Username Occurance in RMAIL box" - nmlst "User Names" - cntlst "# of occurances" - 10 - '(lambda (a b) (> (cdr a) (cdr b)))) - )) - - -(provide 'chart) - -;;; chart.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/emacs-lisp/chart.el Sun Aug 30 02:04:15 2009 +0000 @@ -0,0 +1,755 @@ +;;; chart.el --- Draw charts (bar charts, etc) + +;;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Version: 0.2 +;; Keywords: OO, chart, graph + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This package is an experiment of mine aiding in the debugging of +;; eieio, and proved to be neat enough that others may like to use +;; it. To quickly see what you can do with chart, run the command +;; `chart-test-it-all'. +;; +;; Chart current can display bar-charts in either of two +;; directions. It also supports ranged (integer) axis, and axis +;; defined by some set of strings or names. These name can be +;; automatically derived from data sequences, which are just lists of +;; anything encapsulated in a nice eieio object. +;; +;; Current example apps for chart can be accessed via these commands: +;; `chart-file-count' - count files w/ matching extensions +;; `chart-space-usage' - display space used by files/directories +;; `chart-emacs-storage' - Emacs storage units used/free (garbage-collect) +;; `chart-emacs-lists' - length of Emacs lists +;; `chart-rmail-from' - who sends you the most mail (in -summary only) +;; +;; Customization: +;; +;; If you find the default colors and pixmaps unpleasant, or too +;; short, you can change them. The variable `chart-face-color-list' +;; contains a list of colors, and `chart-face-pixmap-list' contains +;; all the pixmaps to use. The current pixmaps are those found on +;; several systems I found. The two lists should be the same length, +;; as the long list will just be truncated. +;; +;; If you would like to draw your own stipples, simply create some +;; xbm's and put them in a directory, then you can add: +;; +;; (setq x-bitmap-file-path (cons "~/mybitmaps" x-bitmap-file-path)) +;; +;; to your .emacs (or wherever) and load the `chart-face-pixmap-list' +;; with all the bitmaps you want to use. + +(require 'eieio) + +;;; Code: +(defvar chart-map nil "Keymap used in chart mode.") +(if chart-map + () + (setq chart-map (make-sparse-keymap)) + ) + +(defvar chart-local-object nil + "Local variable containing the locally displayed chart object.") +(make-variable-buffer-local 'chart-local-object) + +(defvar chart-face-list nil + "Faces used to colorize charts. +List is limited currently, which is ok since you really can't display +too much in text characters anyways.") + +(defvar chart-face-color-list '("red" "green" "blue" + "cyan" "yellow" "purple") + "Colors to use when generating `chart-face-list'. +Colors will be the background color.") + +(defvar chart-face-pixmap-list + (if (and (fboundp 'display-graphic-p) + (display-graphic-p)) + '("dimple1" "scales" "dot" "cross_weave" "boxes" "dimple3")) + "If pixmaps are allowed, display these background pixmaps. +Useful if new Emacs is used on B&W display") + +(defcustom chart-face-use-pixmaps nil + "*Non-nil to use fancy pixmaps in the background of chart face colors." + :group 'eieio + :type 'boolean) + +(if (and (if (fboundp 'display-color-p) + (display-color-p) + window-system) + (not chart-face-list)) + (let ((cl chart-face-color-list) + (pl chart-face-pixmap-list) + nf) + (while cl + (setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl))))) + (if (condition-case nil + (> (x-display-color-cells) 4) + (error t)) + (set-face-background nf (car cl)) + (set-face-background nf "white")) + (set-face-foreground nf "black") + (if (and chart-face-use-pixmaps + pl + (fboundp 'set-face-background-pixmap)) + (condition-case nil + (set-face-background-pixmap nf (car pl)) + (error (message "Cannot set background pixmap %s" (car pl))))) + (setq chart-face-list (cons nf chart-face-list)) + (setq cl (cdr cl) + pl (cdr pl))))) + +(defun chart-mode () + "Define a mode in Emacs for displaying a chart." + (kill-all-local-variables) + (use-local-map chart-map) + (setq major-mode 'chart-mode + mode-name "CHART") + (buffer-disable-undo) + (set (make-local-variable 'font-lock-global-modes) nil) + (font-lock-mode -1) + (run-hooks 'chart-mode-hook) + ) + +(defun chart-new-buffer (obj) + "Create a new buffer NAME in which the chart OBJ is displayed. +Returns the newly created buffer" + (save-excursion + (set-buffer (get-buffer-create (format "*%s*" (oref obj title)))) + (chart-mode) + (setq chart-local-object obj) + (current-buffer))) + +(defclass chart () + ((title :initarg :title + :initform "Emacs Chart") + (title-face :initarg :title-face + :initform 'bold-italic) + (x-axis :initarg :x-axis + :initform nil ) + (x-margin :initarg :x-margin + :initform 5) + (x-width :initarg :x-width + ) + (y-axis :initarg :y-axis + :initform nil) + (y-margin :initarg :y-margin + :initform 5) + (y-width :initarg :y-width + ) + (key-label :initarg :key-label + :initform "Key") + (sequences :initarg :sequences + :initform nil) + ) + "Superclass for all charts to be displayed in an emacs buffer") + +(defmethod initialize-instance :AFTER ((obj chart) &rest fields) + "Initialize the chart OBJ being created with FIELDS. +Make sure the width/height is correct." + (oset obj x-width (- (window-width) 10)) + (oset obj y-width (- (window-height) 12))) + +(defclass chart-axis () + ((name :initarg :name + :initform "Generic Axis") + (loweredge :initarg :loweredge + :initform t) + (name-face :initarg :name-face + :initform 'bold) + (labels-face :initarg :lables-face + :initform 'italic) + (chart :initarg :chart + :initform nil) + ) + "Superclass used for display of an axis.") + +(defclass chart-axis-range (chart-axis) + ((bounds :initarg :bounds + :initform '(0.0 . 50.0)) + ) + "Class used to display an axis defined by a range of values") + +(defclass chart-axis-names (chart-axis) + ((items :initarg :items + :initform nil) + ) + "Class used to display an axis which represents different named items") + +(defclass chart-sequece () + ((data :initarg :data + :initform nil) + (name :initarg :name + :initform "Data") + ) + "Class used for all data in different charts") + +(defclass chart-bar (chart) + ((direction :initarg :direction + :initform vertical)) + "Subclass for bar charts. (Vertical or horizontal)") + +(defmethod chart-draw ((c chart) &optional buff) + "Start drawing a chart object C in optional BUFF. +Erases current contents of buffer" + (save-excursion + (if buff (set-buffer buff)) + (erase-buffer) + (insert (make-string 100 ?\n)) + ;; Start by displaying the axis + (chart-draw-axis c) + ;; Display title + (chart-draw-title c) + ;; Display data + (message "Rendering chart...") + (sit-for 0) + (chart-draw-data c) + ;; Display key + ; (chart-draw-key c) + (message "Rendering chart...done") + )) + +(defmethod chart-draw-title ((c chart)) + "Draw a title upon the chart. +Argument C is the chart object." + (chart-display-label (oref c title) 'horizontal 0 0 (window-width) + (oref c title-face))) + +(defmethod chart-size-in-dir ((c chart) dir) + "Return the physical size of chart C in direction DIR." + (if (eq dir 'vertical) + (oref c y-width) + (oref c x-width))) + +(defmethod chart-draw-axis ((c chart)) + "Draw axis into the current buffer defined by chart C." + (let ((ymarg (oref c y-margin)) + (xmarg (oref c x-margin)) + (ylen (oref c y-width)) + (xlen (oref c x-width))) + (chart-axis-draw (oref c y-axis) 'vertical ymarg + (if (oref (oref c y-axis) loweredge) nil xlen) + xmarg (+ xmarg ylen)) + (chart-axis-draw (oref c x-axis) 'horizontal xmarg + (if (oref (oref c x-axis) loweredge) nil ylen) + ymarg (+ ymarg xlen))) + ) + +(defmethod chart-axis-draw ((a chart-axis) &optional dir margin zone start end) + "Draw some axis for A in direction DIR at with MARGIN in boundry. +ZONE is a zone specification. +START and END represent the boundary." + (chart-draw-line dir (+ margin (if zone zone 0)) start end) + (chart-display-label (oref a name) dir (if zone (+ zone margin 3) + (if (eq dir 'horizontal) + 1 0)) + start end (oref a name-face))) + +(defmethod chart-translate-xpos ((c chart) x) + "Translate in chart C the coordinate X into a screen column." + (let ((range (oref (oref c x-axis) bounds))) + (+ (oref c x-margin) + (round (* (float (- x (car range))) + (/ (float (oref c x-width)) + (float (- (cdr range) (car range)))))))) + ) + +(defmethod chart-translate-ypos ((c chart) y) + "Translate in chart C the coordinate Y into a screen row." + (let ((range (oref (oref c y-axis) bounds))) + (+ (oref c x-margin) + (- (oref c y-width) + (round (* (float (- y (car range))) + (/ (float (oref c y-width)) + (float (- (cdr range) (car range))))))))) + ) + +(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end) + "Draw axis information based upon a range to be spread along the edge. +A is the chart to draw. DIR is the direction. +MARGIN, ZONE, START, and END specify restrictions in chart space." + (call-next-method) + ;; We prefer about 5 spaces between each value + (let* ((i (car (oref a bounds))) + (e (cdr (oref a bounds))) + (z (if zone zone 0)) + (s nil) + (rng (- e i)) + ;; want to jump by units of 5 spaces or so + (j (/ rng (/ (chart-size-in-dir (oref a chart) dir) 4))) + p1) + (if (= j 0) (setq j 1)) + (while (<= i e) + (setq s + (cond ((> i 999999) + (format "%dM" (/ i 1000000))) + ((> i 999) + (format "%dK" (/ i 1000))) + (t + (format "%d" i)))) + (if (eq dir 'vertical) + (let ((x (+ (+ margin z) (if (oref a loweredge) + (- (length s)) 1)))) + (if (< x 1) (setq x 1)) + (chart-goto-xy x (chart-translate-ypos (oref a chart) i))) + (chart-goto-xy (chart-translate-xpos (oref a chart) i) + (+ margin z (if (oref a loweredge) -1 1)))) + (setq p1 (point)) + (insert s) + (chart-zap-chars (length s)) + (put-text-property p1 (point) 'face (oref a labels-face)) + (setq i (+ i j)))) +) + +(defmethod chart-translate-namezone ((c chart) n) + "Return a dot-pair representing a positional range for a name. +The name in chart C of the Nth name resides. +Automatically compensates for for direction." + (let* ((dir (oref c direction)) + (w (if (eq dir 'vertical) (oref c x-width) (oref c y-width))) + (m (if (eq dir 'vertical) (oref c y-margin) (oref c x-margin))) + (ns (length + (oref (if (eq dir 'vertical) (oref c x-axis) (oref c y-axis)) + items))) + (lpn (/ (+ 1.0 (float w)) (float ns))) + ) + (cons (+ m (round (* lpn (float n)))) + (+ m -1 (round (* lpn (+ 1.0 (float n)))))) + )) + +(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end) + "Draw axis information based upon A range to be spread along the edge. +Optional argument DIR the direction of the chart. +Optional argument MARGIN , ZONE, START and END specify boundaries of the drawing." + (call-next-method) + ;; We prefer about 5 spaces between each value + (let* ((i 0) + (s (oref a items)) + (z (if zone zone 0)) + (r nil) + (p nil) + (odd nil) + p1) + (while s + (setq odd (= (% (length s) 2) 1)) + (setq r (chart-translate-namezone (oref a chart) i)) + (if (eq dir 'vertical) + (setq p (/ (+ (car r) (cdr r)) 2)) + (setq p (- (+ (car r) (/ (- (cdr r) (car r)) 2)) + (/ (length (car s)) 2)))) + (if (eq dir 'vertical) + (let ((x (+ (+ margin z) (if (oref a loweredge) + (- (length (car s))) + (length (car s)))))) + (if (< x 1) (setq x 1)) + (if (> (length (car s)) (1- margin)) + (setq x (+ x margin))) + (chart-goto-xy x p)) + (chart-goto-xy p (+ (+ margin z) (if (oref a loweredge) + (if odd -2 -1) + (if odd 2 1))))) + (setq p1 (point)) + (insert (car s)) + (chart-zap-chars (length (car s))) + (put-text-property p1 (point) 'face (oref a labels-face)) + (setq i (+ i 1) + s (cdr s)))) +) + +(defmethod chart-draw-data ((c chart-bar)) + "Display the data available in a bar chart C." + (let* ((data (oref c sequences)) + (dir (oref c direction)) + (odir (if (eq dir 'vertical) 'horizontal 'vertical)) + ) + (while data + (if (stringp (car (oref (car data) data))) + ;; skip string lists... + nil + ;; display number lists... + (let ((i 0) + (seq (oref (car data) data))) + (while seq + (let* ((rng (chart-translate-namezone c i)) + (dp (if (eq dir 'vertical) + (chart-translate-ypos c (car seq)) + (chart-translate-xpos c (car seq)))) + (zp (if (eq dir 'vertical) + (chart-translate-ypos c 0) + (chart-translate-xpos c 0))) + (fc (if chart-face-list + (nth (% i (length chart-face-list)) chart-face-list) + 'default)) + ) + (if (< dp zp) + (progn + (chart-draw-line dir (car rng) dp zp) + (chart-draw-line dir (cdr rng) dp zp)) + (chart-draw-line dir (car rng) zp (1+ dp)) + (chart-draw-line dir (cdr rng) zp (1+ dp))) + (if (= (car rng) (cdr rng)) nil + (chart-draw-line odir dp (1+ (car rng)) (cdr rng)) + (chart-draw-line odir zp (car rng) (1+ (cdr rng)))) + (if (< dp zp) + (chart-deface-rectangle dir rng (cons dp zp) fc) + (chart-deface-rectangle dir rng (cons zp dp) fc)) + ) + ;; find the bounds, and chart it! + ;; for now, only do one! + (setq i (1+ i) + seq (cdr seq))))) + (setq data (cdr data)))) + ) + +(defmethod chart-add-sequence ((c chart) &optional seq axis-label) + "Add to chart object C the sequence object SEQ. +If AXIS-LABEL, then the axis stored in C is updated with the bounds of SEQ, +or is created with the bounds of SEQ." + (if axis-label + (let ((axis (eieio-oref c axis-label))) + (if (stringp (car (oref seq data))) + (let ((labels (oref seq data))) + (if (not axis) + (setq axis (make-instance chart-axis-names + :name (oref seq name) + :items labels + :chart c)) + (oset axis items labels))) + (let ((range (cons 0 1)) + (l (oref seq data))) + (if (not axis) + (setq axis (make-instance chart-axis-range + :name (oref seq name) + :chart c))) + (while l + (if (< (car l) (car range)) (setcar range (car l))) + (if (> (car l) (cdr range)) (setcdr range (car l))) + (setq l (cdr l))) + (oset axis bounds range))) + (if (eq axis-label 'x-axis) (oset axis loweredge nil)) + (eieio-oset c axis-label axis) + )) + (oset c sequences (append (oref c sequences) (list seq)))) + +;;; Charting optimizers + +(defmethod chart-trim ((c chart) max) + "Trim all sequences in chart C to be at most MAX elements long." + (let ((s (oref c sequences))) + (while s + (let ((sl (oref (car s) data))) + (if (> (length sl) max) + (setcdr (nthcdr (1- max) sl) nil))) + (setq s (cdr s)))) + ) + +(defmethod chart-sort ((c chart) pred) + "Sort the data in chart C using predicate PRED. +See `chart-sort-matchlist' for more details" + (let* ((sl (oref c sequences)) + (s1 (car sl)) + (s2 (car (cdr sl))) + (s nil)) + (if (stringp (car (oref s1 data))) + (progn + (chart-sort-matchlist s1 s2 pred) + (setq s (oref s1 data))) + (if (stringp (car (oref s2 data))) + (progn + (chart-sort-matchlist s2 s1 pred) + (setq s (oref s2 data))) + (error "Sorting of chart %s not supported" (object-name c)))) + (if (eq (oref c direction) 'horizontal) + (oset (oref c y-axis) items s) + (oset (oref c x-axis) items s) + )) + ) + +(defun chart-sort-matchlist (namelst numlst pred) + "Sort NAMELST and NUMLST (both SEQUENCE objects) based on predicate PRED. +PRED should be the equivalent of '<, except it must expect two +cons cells of the form (NAME . NUM). See SORT for more details." + ;; 1 - create 1 list of cons cells + (let ((newlist nil) + (alst (oref namelst data)) + (ulst (oref numlst data))) + (while alst + ;; this is reversed, but were are sorting anyway + (setq newlist (cons (cons (car alst) (car ulst)) newlist)) + (setq alst (cdr alst) + ulst (cdr ulst))) + ;; 2 - Run sort routine on it + (setq newlist (sort newlist pred) + alst nil + ulst nil) + ;; 3 - Separate the lists + (while newlist + (setq alst (cons (car (car newlist)) alst) + ulst (cons (cdr (car newlist)) ulst)) + (setq newlist (cdr newlist))) + ;; 4 - Store them back + (oset namelst data (reverse alst)) + (oset numlst data (reverse ulst)))) + +;;; Utilities + +(defun chart-goto-xy (x y) + "Move cursor to position X Y in buffer, and add spaces and CRs if needed." + + (let ((indent-tabs-mode nil) + (num (goto-line (1+ y)))) + (if (and (= 0 num) (/= 0 (current-column))) (newline 1)) + (if (eobp) (newline num)) + (if (< x 0) (setq x 0)) + (if (< y 0) (setq y 0)) + ;; Now, a quicky column moveto/forceto method. + (or (= (move-to-column x) x) + (let ((p (point))) + (indent-to x) + (remove-text-properties p (point) '(face)))))) + +(defun chart-zap-chars (n) + "Zap up to N chars without deleteting EOLs." + (if (not (eobp)) + (if (< n (- (save-excursion (end-of-line) (point)) (point))) + (delete-char n) + (delete-region (point) (save-excursion (end-of-line) (point)))))) + +(defun chart-display-label (label dir zone start end &optional face) + "Display LABEL in direction DIR in column/row ZONE between START and END. +Optional argument FACE is the property we wish to place on this text." + (if (eq dir 'horizontal) + (let (p1) + (chart-goto-xy (+ start (- (/ (- end start) 2) (/ (length label) 2))) + zone) + (setq p1 (point)) + (insert label) + (chart-zap-chars (length label)) + (put-text-property p1 (point) 'face face) + ) + (let ((i 0) + (stz (+ start (- (/ (- end start) 2) (/ (length label) 2))))) + (while (< i (length label)) + (chart-goto-xy zone (+ stz i)) + (insert (aref label i)) + (chart-zap-chars 1) + (put-text-property (1- (point)) (point) 'face face) + (setq i (1+ i)))))) + +(defun chart-draw-line (dir zone start end) + "Draw a line using line-drawing characters in direction DIR. +Use column or row ZONE between START and END" + (chart-display-label + (make-string (- end start) (if (eq dir 'vertical) ?| ?\-)) + dir zone start end)) + +(defun chart-deface-rectangle (dir r1 r2 face) + "Colorize a rectangle in direction DIR across range R1 by range R2. +R1 and R2 are dotted pairs. Colorize it with FACE." + (let* ((range1 (if (eq dir 'vertical) r1 r2)) + (range2 (if (eq dir 'vertical) r2 r1)) + (y (car range2))) + (while (<= y (cdr range2)) + (chart-goto-xy (car range1) y) + (put-text-property (point) (+ (point) (1+ (- (cdr range1) (car range1)))) + 'face face) + (setq y (1+ y))))) + +;;; Helpful `I don't want to learn eieio just now' washover functions + +(defun chart-bar-quickie (dir title namelst nametitle numlst numtitle + &optional max sort-pred) + "Wash over the complex eieio stuff and create a nice bar chart. +Creat it going in direction DIR ['horizontal 'vertical] with TITLE +using a name sequence NAMELST labeled NAMETITLE with values NUMLST +labeled NUMTITLE. +Optional arguments: +Set the charts' max element display to MAX, and sort lists with +SORT-PRED if desired." + (let ((nc (make-instance chart-bar + :title title + :key-label "8-m" ; This is a text key pic + :direction dir + )) + (iv (eq dir 'vertical))) + (chart-add-sequence nc + (make-instance chart-sequece + :data namelst + :name nametitle) + (if iv 'x-axis 'y-axis)) + (chart-add-sequence nc + (make-instance chart-sequece + :data numlst + :name numtitle) + (if iv 'y-axis 'x-axis)) + (if sort-pred (chart-sort nc sort-pred)) + (if (integerp max) (chart-trim nc max)) + (switch-to-buffer (chart-new-buffer nc)) + (chart-draw nc))) + +;;; Test code + +(defun chart-test-it-all () + "Test out various charting features." + (interactive) + (chart-bar-quickie 'vertical "Test Bar Chart" + '( "U1" "ME2" "C3" "B4" "QT" "EZ") "Items" + '( 5 -10 23 20 30 -3) "Values") + ) + +;;; Sample utility function + +(defun chart-file-count (dir) + "Draw a chart displaying the number of different file extentions in DIR." + (interactive "DDirectory: ") + (if (not (string-match "/$" dir)) + (setq dir (concat dir "/"))) + (message "Collecting statistics...") + (let ((flst (directory-files dir nil nil t)) + (extlst (list "<dir>")) + (cntlst (list 0))) + (while flst + (let* ((j (string-match "[^\\.]\\(\\.[a-zA-Z]+\\|~\\|#\\)$" (car flst))) + (s (if (file-accessible-directory-p (concat dir (car flst))) + "<dir>" + (if j + (substring (car flst) (match-beginning 1) (match-end 1)) + nil))) + (m (member s extlst))) + (if (not s) nil + (if m + (let ((cell (nthcdr (- (length extlst) (length m)) cntlst))) + (setcar cell (1+ (car cell)))) + (setq extlst (cons s extlst) + cntlst (cons 1 cntlst))))) + (setq flst (cdr flst))) + ;; Lets create the chart! + (chart-bar-quickie 'vertical "Files Extension Distribution" + extlst "File Extensions" + cntlst "# of occurances" + 10 + '(lambda (a b) (> (cdr a) (cdr b)))) + )) + +(defun chart-space-usage (d) + "Display a top usage chart for directory D." + (interactive "DDirectory: ") + (message "Collecting statistics...") + (let ((nmlst nil) + (cntlst nil) + (b (get-buffer-create " *du-tmp*"))) + (set-buffer b) + (erase-buffer) + (insert "cd " d ";du -sk * \n") + (message "Running `cd %s;du -sk *'..." d) + (call-process-region (point-min) (point-max) shell-file-name t + (current-buffer) nil) + (goto-char (point-min)) + (message "Scanning output ...") + (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\([^ \n]+\\)$" nil t) + (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) + (num (buffer-substring (match-beginning 1) (match-end 1)))) + (setq nmlst (cons nam nmlst) + ;; * 1000 to put it into bytes + cntlst (cons (* (string-to-number num) 1000) cntlst)))) + (if (not nmlst) + (error "No files found!")) + (chart-bar-quickie 'vertical (format "Largest files in %s" d) + nmlst "File Name" + cntlst "File Size" + 10 + '(lambda (a b) (> (cdr a) (cdr b)))) + )) + +(defun chart-emacs-storage () + "Chart the current storage requirements of Emacs." + (interactive) + (let* ((data (garbage-collect)) + (names '("strings/2" "vectors" + "conses" "free cons" + "syms" "free syms" + "markers" "free mark" + ;; "floats" "free flt" + )) + (nums (list (/ (nth 3 data) 2) + (nth 4 data) + (car (car data)) ; conses + (cdr (car data)) + (car (nth 1 data)) ; syms + (cdr (nth 1 data)) + (car (nth 2 data)) ; markers + (cdr (nth 2 data)) + ;(car (nth 5 data)) ; floats are Emacs only + ;(cdr (nth 5 data)) + ))) + ;; Lets create the chart! + (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" + names "Storage Items" + nums "Objects"))) + +(defun chart-emacs-lists () + "Chart out the size of various important lists." + (interactive) + (let* ((names '("buffers" "frames" "processes" "faces")) + (nums (list (length (buffer-list)) + (length (frame-list)) + (length (process-list)) + (length (face-list)) + ))) + (if (fboundp 'x-display-list) + (setq names (append names '("x-displays")) + nums (append nums (list (length (x-display-list)))))) + ;; Lets create the chart! + (chart-bar-quickie 'vertical "Emacs List Size Chart" + names "Various Lists" + nums "Objects"))) + +(defun chart-rmail-from () + "If we are in an rmail summary buffer, then chart out the froms." + (interactive) + (if (not (eq major-mode 'rmail-summary-mode)) + (error "You must invoke chart-rmail-from in an rmail summary buffer")) + (let ((nmlst nil) + (cntlst nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\\-[A-Z][a-z][a-z] +\\(\\w+\\)@\\w+" nil t) + (let* ((nam (buffer-substring (match-beginning 1) (match-end 1))) + (m (member nam nmlst))) + (message "Scanned username %s" nam) + (if m + (let ((cell (nthcdr (- (length nmlst) (length m)) cntlst))) + (setcar cell (1+ (car cell)))) + (setq nmlst (cons nam nmlst) + cntlst (cons 1 cntlst)))))) + (chart-bar-quickie 'vertical "Username Occurance in RMAIL box" + nmlst "User Names" + cntlst "# of occurances" + 10 + '(lambda (a b) (> (cdr a) (cdr b)))) + )) + + +(provide 'chart) + +;;; chart.el ends here