annotate lisp/emacs-lisp/chart.el @ 104444:2bf481006ba4

lisp/Makefile.in: Ignore CEDET subdirectories when making subdirs.el. lisp/emacs-lisp/autoload.el (generated-autoload-feature): New var. (autoload-rubric): Use it. lisp/cedet/semantic/adebug.el (data-debug-insert-find-results-button): Require db-find. lisp/cedet/semantic/analyze.el: Require semantic/tag. Don't declare autoloaded functions. lisp/cedet/semantic/chart.el: Don't declare autoloaded functions. lisp/cedet/semantic/complete.el: eval-when-compile semantic/find for macro. (semantic-collector-calculate-completions-raw): Require semantic/db-find. lisp/cedet/semantic/ctxt.el (semantic-up-context): Require semantic/find. Don't require it at top-level. lisp/cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-dump): Require data-debug. Don't require it at top-level. Don't require semantic/sort. lisp/cedet/semantic/db-find.el: Add local vars for autoloading. Don't require semantic/tag-file and semantic/sort. (semanticdb-find-default-throttle, semanticdb-find-result-length) (semanticdb-find-result-nth, semanticdb-find-result-nth-in-buffer) (semanticdb-find-tags-by-name, semanticdb-find-tags-for-completion) (semanticdb-find-translate-path, semanticdb-find-table-for-include): Autoload. lisp/cedet/semantic/db-ref.el: Require semantic and semantic/tag. (semanticdb-ref-test): Require data-debug. Don't require it at top-level. lisp/cedet/semantic/db-typecache.el: Require semantic and semantic/tag. Declare semantic-sort-tags-by-name-then-type-increasing and semantic-scope-tag-clone-with-scope. eval-when-compile semantic/find for semantic-find-tags-by-* macros. Add local vars for autoloading. (semanticdb-typecache-find): Autoload. lisp/cedet/semantic/db.el: Add local vars for autoloading. (semanticdb-current-database, semanticdb-current-table) (semanticdb-file-table-object): Autoload. lisp/cedet/semantic/decorate.el: Don't requirements for autoloaded functions. lisp/cedet/semantic/doc.el: Add local vars for autoloading. (semantic-documentation-for-tag): Autoload. lisp/cedet/semantic/edit.el: Drop requirements for autoloaded functions. lisp/cedet/semantic/find.el: Add local vars for autoloading. (semantic-current-tag, semantic-find-tag-by-overlay) (semantic-find-first-tag-by-name): Autoload. lisp/cedet/semantic/format.el: Add local vars for autoloading. (semantic-format-tag-name, semantic-format-tag-custom-list) (semantic-format-tag-functions): Autoload. lisp/cedet/semantic/fw.el: Require semantic/loaddefs. lisp/cedet/semantic/html.el (semantic-html-recursive-combobulate-list): Use assoc-string instead of assoc-case. lisp/cedet/semantic/ia.el (semantic-ia-insert-tag): Move up to avoid compiler error. (semantic-ia-complete-symbol-menu): Require imenu. (semantic-ia-fast-jump): Require semantic/decorate/include. lisp/cedet/semantic/idle.el: Require semantic and semantic/tag. Declare semanticdb-typecache-refresh-for-buffer and eldoc-message. eval-when-compile semantic/find for semantic-find-tags-by-name macro. lisp/cedet/semantic/sort.el: Add local vars for autoloading. (semantic-flatten-tags-table, semantic-tag-external-member-parent): Autoload. lisp/cedet/semantic/tag-file.el: Add local vars for autoloading. (semantic-go-to-tag, semantic-dependency-tag-file): Autoload. lisp/cedet/semantic/tag-ls.el: Add local vars for autoloading. (semantic-tag-prototype-p): Autoload. lisp/cedet/semantic/tag.el: Don't declare autoloaded functions. lisp/cedet/semantic/analyze/complete.el: Add local variables for autoloading. (semantic-analyze-possible-completions): Autoload. lisp/cedet/semantic/analyze/fcn.el: Require mode-local.

;;; 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  <[e-mail]>
;; 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