Commit 6dd12ef2 authored by Chong Yidong's avatar Chong Yidong
Browse files

* emacs-lisp/chart.el:

* emacs-lisp/eieio-base.el:
* emacs-lisp/eieio-comp.el:
* emacs-lisp/eieio-custom.el:
* emacs-lisp/eieio-opt.el:
* emacs-lisp/eieio-speedbar.el:
* emacs-lisp/eieio.el: New files.
parent c93d41ba
2009-09-28 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/chart.el:
* emacs-lisp/eieio-base.el:
* emacs-lisp/eieio-comp.el:
* emacs-lisp/eieio-custom.el:
* emacs-lisp/eieio-opt.el:
* emacs-lisp/eieio-speedbar.el:
* emacs-lisp/eieio.el: New files.
2009-09-27 Chong Yidong <cyd@stupidchicken.com>
* menu-bar.el: Remove menu-bar-ediff-misc-menu from the Tools
......
;;; 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 (progn (goto-char (point-min)) (forward-line 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