Commits

Anonymous committed 2c387ec

Add new package eieio

Comments (0)

Files changed (16)

+2001-02-17  Steve Youngs  <youngs@xemacs.org>
+
+	* Initial XEmacs Package - Author version 0.15.
+
+Installation instructions for Eieio
+
+The following updates to your .emacs file will help you get the most out of this
+update of eieio.
+
+1) Build eieio
+
+   On the unix command line, type:
+
+   $ make
+
+   On windows NT, you will need to byte compile each file from within
+   emacs, or you can leave everything unbyte compiled.
+
+
+2) Add eieio's directory to your load path.
+
+   (add-to-list 'load-path "~/eieio-0.15")
+
+   Be sure to replace the directory above with the actual path to
+   where eieio was unpacked.  This will make sure the latest version
+   of eieio superceeds any version already installed on your system.
+
+
+# Makefile for eieio
+
+# This file is part of XEmacs.
+
+# XEmacs 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 2, or (at your option) any
+# later version.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.00
+AUTHOR_VERSION = 0.15
+MAINTAINER = Eric Ludlam <zappo@gnu.org>
+PACKAGE = eieio
+PKG_TYPE = regular
+REQUIRES = eieio speedbar xemacs-base 
+CATEGORY = prog
+
+ELCS = chart.elc eieio-comp.elc eieio-custom.elc eieio-doc.elc \
+	eieio-opt.elc eieio-speedbar.elc eieio-tests.elc eieio.elc \
+	tree.elc
+
+INFO_FILES = $(PACKAGE).info
+TEXI_FILES = $(PACKAGE).texi
+MANUALS = $(PACKAGE)
+
+EXTRA_SOURCES = Makefile.upstream INSTALL Project.ede
+
+include ../../XEmacs.rules
+
+GENERATED += custom-load.elc
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc $(INFO_FILES)
+
+srckit: srckit-std
+
+binkit: binkit-common
+
+

Makefile.upstream

+# Automatically Generated Makefile by EDE.
+# For use with: make
+#
+# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
+# EDE is the Emacs Development Environment.
+# http://www.ultranet.com/~zappo/ede.shtml
+# 
+
+ede_FILES=Project.ede Makefile
+
+Misc_MISC=INSTALL
+eieio_LISP=eieio.el eieio-custom.el eieio-opt.el eieio-comp.el eieio-doc.el
+EMACS=emacs
+eieio_info_INFOS=eieio.texi
+examples_LISP=tree.el chart.el eieio-speedbar.el eieio-tests.el
+VERSION=$(shell grep "Version: " eieio.el | cut -d" " -f3)
+DISTDIR=eieio-$(VERSION)
+top_builddir = 
+
+DEP_FILES=.deps/.P
+
+all: eieio eieio.info examples
+
+DEPS_MAGIC := $(shell mkdir .deps > /dev/null 2>&1 || :)
+-include $(DEP_FILES)
+
+%.o: %.c
+	@echo '$(COMPILE) -c $<'; \
+	$(COMPILE) -Wp,-MD,.deps/$(*F).P -c $<
+
+Misc: 
+	@
+
+eieio:
+	@echo "(add-to-list 'load-path \"$(PWD)\")" > eieio-compile-script
+	@echo "(setq debug-on-error t)" >> eieio-compile-script
+	$(EMACS) -batch -l eieio-compile-script -f batch-byte-compile  $(eieio_LISP)
+
+eieio.info: $(eieio_info_INFOS)
+	makeinfo eieio.texi
+examples:
+	@echo "(add-to-list 'load-path \"$(PWD)\")" > examples-compile-script
+	@echo "(setq debug-on-error t)" >> examples-compile-script
+	$(EMACS) -batch -l examples-compile-script -f batch-byte-compile  $(examples_LISP)
+
+clean:
+	rm -f *.elc *.info
+
+
+dist:
+	rm -rf $(DISTDIR)
+	mkdir $(DISTDIR)
+	cp $(Misc_MISC) $(eieio_LISP) $(eieio_info_INFOS) $(examples_LISP) $(ede_FILES) $(DISTDIR)
+	tar -cvzf $(DISTDIR).tar.gz $(DISTDIR)
+	rm -rf $(DISTDIR)
+
+tags: $(Misc_MISC) $(eieio_LISP) $(eieio_info_INFOS) $(examples_LISP) 
+	etags $^
+
+Makefile: Project.ede
+	@echo Makefile is out of date!  It needs to be regenerated by EDE.
+	@false
+
+
+
+# End of Makefile
+;; Object ede-proj-project
+;; EDE project file.
+(ede-proj-project "ede-proj-project"
+  :name "eieio"
+  :version "$(shell grep \"Version: \" eieio.el | cut -d\" \" -f3)"
+  :file "Project.ede"
+  :targets (list   (ede-proj-target-makefile-miscelaneous "Misc"
+    :name "Misc"
+    :path ""
+    :source '("INSTALL")
+    :partofall 'nil
+    )
+   (ede-proj-target-elisp "eieio"
+    :name "eieio"
+    :path ""
+    :source '("eieio.el" "eieio-custom.el" "eieio-opt.el" "eieio-comp.el" "eieio-doc.el")
+    )
+   (ede-proj-target-makefile-info "eieio.info"
+    :name "eieio.info"
+    :path ""
+    :source '("eieio.texi")
+    )
+   (ede-proj-target-elisp "examples"
+    :name "examples"
+    :path ""
+    :source '("tree.el" "chart.el" "eieio-speedbar.el" "eieio-tests.el")
+    )
+   )
+  :configuration-variables 'nil
+  )
+;;; chart.el --- Draw charts (bar charts, etc)
+
+;;; Copyright (C) 1996, 1998, 1999 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; Version: 0.1
+;; RCS: $Id$
+;; Keywords: OO, chart, graph
+;;                                                                          
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.org
+
+;;; Future versions of Chart can be found at:
+;;  ftp://ftp.ultranet.com/pub/zappo
+
+;;; 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.
+;;
+;; PREFERRED: Emacs 19.30 or better, but should work with earlier
+;;            versions but without special fonts/colors/pixmaps
+
+(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"
+				"orange" "yellow" "purple")
+  "Colors to use when generating `chart-face-list'.
+Colors will be the background color.")
+
+(defvar chart-face-pixmap-list '("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")
+
+(if (and window-system (not chart-face-list))
+    (let ((cl chart-face-color-list)
+	  (pl chart-face-pixmap-list)
+	  nf)
+      (while (and cl pl)
+	(setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl)))))
+	(if (> (x-display-color-cells) 4)
+	    (set-face-background nf (car cl))
+	  (set-face-background nf "white"))
+	(set-face-foreground nf "black")
+	(if (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")
+  (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
+	    :initform (lambda () (- (window-width) 10)))
+   (y-axis :initarg :y-axis
+	   :initform nil)
+   (y-margin :initarg :y-margin
+	     :initform 5)
+   (y-width :initarg :y-width
+	    :initform (lambda () (- (window-height) 10)))
+   (key-label :initarg :key-label
+	      :initform "Key")
+   (sequences :initarg :sequences
+	      :initform nil)
+   )
+  "Superclass for all charts to be displayed in an emacs buffer")
+
+(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)
+    (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)
+	  (chart-goto-xy (+ (+ margin z) (if (oref a loweredge)
+					     (- (length s)) 1))
+			 (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 (/ (float w) (float ns)))
+	 )
+    (cons (+ m 1 (round (* lpn (float n))))
+	  (+ m (round (* lpn (+ 1 (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))
+      (setq p (- (+ (car r) (/ (- (cdr r) (car r)) 2)) (/ (length (car s)) 2)))
+      (if (eq dir 'vertical)
+	  (chart-goto-xy (+ (+ margin z) (if (oref a loweredge)
+					     (- (length (car s)))
+					   (length (car s))))
+			 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))
+    ;; 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) "csh" 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-int 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 '("conses" "free cons" "syms" "free syms"
+		  "markers" "free mark" "floats" "free flt"
+		  "strings/2" "vectors"))
+	 (nums (list (car (car data))
+		     (cdr (car data))
+		     (car (nth 1 data))
+		     (cdr (nth 1 data))
+		     (car (nth 2 data))
+		     (cdr (nth 2 data))
+		     (car (nth 5 data))
+		     (cdr (nth 5 data))
+		     (/ (nth 3 data) 2)
+		     (nth 4 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" "x-displays"
+		  ))
+	 (nums (list (length (buffer-list))
+		     (length (frame-list))
+		     (length (process-list))
+		     (length (face-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
+;;; eieio-comp.el -- eieio routines to help with byte compilation
+
+;;;
+;; Copyright (C) 1995,1996, 1998, 1999, 2000 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; RCS: $Id$
+;; Keywords: oop, lisp, tools
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.org
+;;
+;; Updates can be found at:
+;;    ftp://ftp.ultranet.com/pub/zappo
+
+;;; Commentary:
+;;  
+;; Byte compiler functions for defmethod.  This will affect the new GNU
+;; byte compiler for Emacs 19 and better.  This function will be called by
+;; the byte compiler whenever a `defmethod' is encountered in a file.
+;; It will output a function call to `eieio-defmethod' with the byte
+;; compiled function as a parameter.
+
+;;; Code:
+
+;; Some compatibility stuff
+(eval-and-compile
+  (if (not (fboundp 'byte-compile-compiled-obj-to-list))
+      (defun byte-compile-compiled-obj-to-list (moose) nil))
+
+  (if (not (boundp 'byte-compile-outbuffer))
+      (defvar byte-compile-outbuffer nil))
+  )
+
+;; This teaches the byte compiler how to do this sort of thing.
+(put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod)
+
+(defun byte-compile-file-form-defmethod (form)
+  "Mumble about the method we are compiling.
+This function is mostly ripped from `byte-compile-file-form-defun', but
+it's been modified to handle the special syntax of the defmethod
+command.  There should probably be one for defgeneric as well, but
+that is called but rarely.  Argument FORM is the body of the method."
+  (setq form (cdr form))
+  (let* ((meth (car form))
+	 (key (progn (setq form (cdr form))
+		     (cond ((eq ':BEFORE (car form))
+			    (setq form (cdr form))
+			    ":BEFORE ")
+			   ((eq ':AFTER (car form))
+			    (setq form (cdr form))
+			    ":AFTER ")
+			   ((eq ':PRIMARY (car form))
+			    (setq form (cdr form))
+			    ":PRIMARY ")
+			   (t ""))))
+	 (params (car form))
+	 (lamparams (byte-compile-defmethod-param-convert params))
+	 (arg1 (car params))
+	 (class (if (listp arg1) (nth 1 arg1) nil))
+	 (my-outbuffer (if (eval-when-compile
+			     (string-match "XEmacs" emacs-version))
+			   byte-compile-outbuffer outbuffer))
+	 )
+    (let ((name (format "%s::%s" (or class "#<generic>") meth)))
+      (if byte-compile-verbose
+	  ;; #### filename used free
+	  (message "Compiling %s... (%s)" (or filename "") name))
+      (setq byte-compile-current-form name) ; for warnings
+      )
+    ;; Flush any pending output
+    (byte-compile-flush-pending)
+    ;; Byte compile the body.  For the byte compiled forms, add the
+    ;; rest arguments, which will get ignored by the engine which will
+    ;; add them later (I hope)
+    (let* ((new-one (byte-compile-lambda
+		     (append (list 'lambda lamparams)
+			     (cdr form))))
+	   (code (byte-compile-byte-code-maker new-one)))
+      (princ "\n(eieio-defmethod '" my-outbuffer)
+      (princ meth my-outbuffer)
+      (princ " '(" my-outbuffer)
+      (princ key my-outbuffer)
+      (prin1 params my-outbuffer)
+      (princ " " my-outbuffer)
+      (eieio-byte-compile-princ-code code my-outbuffer)
+      (princ "))" my-outbuffer)
+      )
+    ;; Now add this function to the list of known functions.
+    ;; Don't bother with a doc string.   Not relevant here.
+    (add-to-list 'byte-compile-function-environment
+		 (cons meth
+		       (eieio-defgeneric-form meth "")))
+    
+    ;; Remove it from the undefined list if it is there.
+    (let ((elt (assq meth byte-compile-unresolved-functions)))
+      (if elt (setq byte-compile-unresolved-functions
+		    (delq elt byte-compile-unresolved-functions))))
+
+    ;; nil prevents cruft from appearing in the output buffer.
+    nil))
+
+
+(defun eieio-byte-compile-princ-code (code outbuffer)
+  "Xemacs and GNU Emacs do their things differently.
+Lets do it right on both platforms
+Argument CODE is the code to output.
+Argument OUTBUFFER is the buffer to dump the created code to."
+  (if (eval-when-compile (not (string-match "XEmacs" emacs-version)))
+      ;; FSF emacs
+      (prin1 code outbuffer)
+    ;; XEmacs
+    (if (atom code)
+	(princ "#[" outbuffer)
+      (princ "'(" outbuffer))
+    (let ((codelist (if (byte-code-function-p code)
+			(byte-compile-compiled-obj-to-list code)
+		      (append code nil))))
+      (while codelist
+	(eieio-prin1 (car codelist) outbuffer)
+	(princ " " outbuffer)
+	(setq codelist (cdr codelist))
+	))
+    (if (atom code)
+	(princ "]" outbuffer)
+      (princ ")" outbuffer))))
+
+(defun eieio-prin1 (code outbuffer)
+  "For XEmacs only, princ one item.
+Recurse into lists in search of `byte-code' which needs expanding...
+Argument CODE is the code to output.
+Argument OUTBUFFER is the buffer to dump the created code to."
+  (cond ((byte-code-function-p code)
+	 (let ((codelist (byte-compile-compiled-obj-to-list code)))
+	   (princ "#[" outbuffer)
+	   (while codelist
+	     (eieio-prin1 (car codelist) outbuffer)
+	     (princ " " outbuffer)
+	     (setq codelist (cdr codelist))
+	     )
+	   (princ "]" outbuffer)))
+	((vectorp code)
+	 (let ((i 0) (ln (length code)))
+	   (princ "[" outbuffer)
+	   (while (< i ln)
+	     (eieio-prin1 (aref code i) outbuffer)
+	     (princ " " outbuffer)
+	     (setq i (1+ i)))
+	   (princ "]" outbuffer)))
+	(t (prin1 code outbuffer))))
+    
+
+(defun byte-compile-defmethod-param-convert (paramlist)
+  "Convert method params into the params used by the defmethod thingy.
+Argument PARAMLIST is the paramter list to convert."
+  (let ((argfix nil))
+    (while paramlist
+      (setq argfix (cons (if (listp (car paramlist))
+			     (car (car paramlist))
+			   (car paramlist))
+			 argfix))
+      (setq paramlist (cdr paramlist)))
+    (nreverse argfix)))
+
+(provide 'eieio-comp)
+
+;;; eieio-comp.el ends here
+;;; eieio-custom.el -- eieio object customization
+
+;;; Copyright (C) 1999, 2000 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; RCS: $Id$
+;; Keywords: OO, lisp
+;;                                                                          
+;; This program 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 2, or (at your option)
+;; any later version.
+;;           
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.org
+;;
+;; Updates can be found at:
+;;    ftp://ftp.ultranet.com/pub/zappo
+
+;;; Commentary:
+;;
+;;   This contains support customization of eieio objects.  Enabling your
+;; object to be customizable requires use of the added class slot
+;; attirbute :custom
+;;
+
+(require 'eieio)
+(require 'widget)
+(require 'wid-edit)
+(require 'custom)
+
+;;; Code:
+(defclass eieio-widget-test-class nil
+  ((a-string :initarg :a-string
+	     :initform "The moose is loose"
+	     :custom string
+	     :documentation "A string for testing custom.
+This is the next line of documentation.")
+   (listostuff :initarg :listostuff
+	       :initform ("1" "2" "3")
+	       :type list
+	       :custom (repeat (string :tag "Stuff"))
+	       :documentation "A list of stuff.")
+   (uninitialized :initarg :uninitialized
+		  :type string
+		  :custom string
+		  :documentation "This slot is not initialized.
+Used to make sure that custom doesn't barf when it encounters one
+of these.")
+   (a-number :initarg :a-number
+	     :initform 2
+	     :custom integer
+	     :documentation "A number of thingies."))
+  "A class for testing the widget on.")
+
+(defcustom eieio-widget-test (eieio-widget-test-class "Foo")
+  "Test variable for editing an object."
+  :type 'object)
+
+(defface eieio-custom-slot-tag-face '((((class color)
+					(background dark))
+				       (:foreground "light blue"))
+				      (((class color)
+					(background light))
+				       (:foreground "blue"))
+				      (t (:italic t)))
+  "Face used for unpushable variable tags."
+  :group 'custom-faces)
+
+(defvar eieio-wo nil
+  "Buffer local variable in object customize buffers for the current widget.")
+(defvar eieio-co nil
+  "Buffer local variable in object customize buffers for the current obj.")
+
+(define-widget 'object-edit 'group
+  "Abstractly modify a CLOS object."
+  :tag "Object"
+  :format "%v"
+  :convert-widget 'widget-types-convert-widget
+  :value-create 'eieio-object-value-create
+  :value-get 'eieio-object-value-get
+  :value-delete 'widget-children-value-delete
+  :validate 'widget-children-validate
+  :match 'eieio-object-match
+  :clone-object-children nil
+  )
+
+(defun eieio-object-match (widget value)
+  "Match info for WIDGET against VALUE."
+  ;; Write me
+  t)
+
+(defun eieio-filter-slot-type (widget slottype)
+  "Filter WIDGETs SLOTTYPE."
+  (if (widget-get widget :clone-object-children)
+      slottype
+    (cond ((eq slottype 'object)
+	   'object-edit)
+	  ((and (listp slottype)
+		(eq (car slottype) 'object))
+	   (cons 'object-edit (cdr slottype)))
+	  ((equal slottype '(repeat object))
+	   '(repeat object-edit))
+	  ((and (listp slottype)
+		(equal (car slottype) 'repeat)
+		(listp (car (cdr slottype)))
+		(equal (car (car (cdr slottype))) 'object))
+	   (list 'repeat
+		 (cons 'object-edit
+		       (cdr (car (cdr slottype))))))
+	  (t slottype))))
+
+(defun eieio-object-value-create (widget)
+  "Create the value of WIDGET."
+  (if (not (widget-get widget :value))
+      (widget-put widget
+		  :value (funcall (class-constructor
+				   (widget-get widget :objecttype))
+				  "Custom-new")))
+  (let* ((chil nil)
+	 (obj (widget-get widget :value))
+	 (cv (class-v (object-class-fast obj)))
+	 (fields (aref cv class-public-a))
+	 (fdoc (aref cv class-public-doc))
+	 (fcust (aref cv class-public-custom)))
+    ;; First line describes the object, but is not editable.
+    (setq chil (cons (widget-create-child-and-convert
+		      widget 'string :tag "Object "
+		      :sample-face 'bold
+		      (object-name-string obj))
+		     chil))
+    ;; Loop over all the fields, creating child widgets.
+    (while fields
+      ;; Output this slot if it has a customize flag associated with it.
+      (if (car fcust)
+	  (when (slot-boundp obj (car fields))
+	    ;; In this case, this field has a custom type.  Create it's
+	    ;; children widgets.
+	    (setq chil (cons (widget-create-child-and-convert
+			      widget
+			      (eieio-filter-slot-type widget (car fcust))
+			      :tag
+			      (concat
+			       (make-string
+				(or (widget-get widget :indent) 0)
+				? )
+			       "Slot "
+			       (let ((s (symbol-name
+					 (or (class-slot-initarg
+					      (object-class-fast obj)
+					      (car fields))
+					     (car fields)))))
+				 (capitalize
+				  (if (string-match "^:" s)
+				      (substring s (match-end 0))
+				    s))))
+			      :value (slot-value obj (car fields))
+			      :sample-face 'eieio-custom-slot-tag-face
+			      )
+			     chil))
+	    (setq chil (cons (widget-create-child-and-convert
+			      widget 'documentation-string
+			      :format "%t   %v"
+			      :tag (make-string
+				    (or (widget-get widget :indent) 0)
+				    ? )
+			      :value (if (car fdoc) (car fdoc)
+				       "Slot not Documented."))
+			     chil))
+	    ))
+      (setq fields (cdr fields)
+	    fdoc (cdr fdoc)
+	    fcust (cdr fcust)))
+    (widget-put widget :children (nreverse chil))
+    ))
+
+(defun eieio-object-value-get (widget)
+  "Get the value of WIDGET."
+  (let* ((obj (widget-get widget :value))
+	 (wids (widget-get widget :children))
+	 (name (car (widget-apply (car wids) :value-inline)))
+	 (chil (nthcdr 1 wids))
+	 (cv (class-v (object-class-fast obj)))
+	 (fields (aref cv class-public-a))
+	 (fcust (aref cv class-public-custom)))
+    ;; If there are any prefix widgets, clear them.
+    ;; -- None yet
+    ;; Create a batch of initargs for each slot.
+    (while (and fields chil)
+      (if (car fcust)
+	  (progn
+	    ;; Only customized fields have widgets
+	    (eieio-oset obj (car fields)
+			 (car (widget-apply (car chil) :value-inline)))
+	    ;; Two widets per field.  The slot value, and the doc.
+	    (setq chil (cdr (cdr chil)))))
+      (setq fields (cdr fields)
+	    fcust (cdr fcust)))
+    ;; Set any name updates on it.
+    (aset obj object-name name)
+    ;; This is the same object we had before.
+    obj))
+
+(defmethod eieio-done-customizing ((obj eieio-default-superclass))
+  "When a applying change to a widget, call this method.
+This method is called by the default widget-edit commands.  User made
+commands should also call this method when applying changes.
+Argument OBJ is the object that has been customized."
+  nil)
+
+(defun customize-object (obj)
+  "Customize OBJ in a custom buffer."
+  (eieio-customize-object obj))
+
+(defmethod eieio-customize-object ((obj eieio-default-superclass))
+  "Customize OBJ in a specialized custom buffer.
+To override call the `eieio-custom-widget-insert' to just insert the
+object widget."
+  ;; Insert check for multiple edits here.
+  (let ((b (switch-to-buffer (get-buffer-create
+			      (concat "*CUSTOMIZE " (object-name obj) "*")))))
+    (toggle-read-only -1)
+    (kill-all-local-variables)
+    (erase-buffer)
+    (let ((all (overlay-lists)))
+      ;; Delete all the overlays.
+      (mapcar 'delete-overlay (car all))
+      (mapcar 'delete-overlay (cdr all)))
+    ;; Add an apply reset option at the top of the buffer.
+    (eieio-custom-object-apply-reset obj)
+    (widget-insert "\n\n")
+    (widget-insert "Edit object " (object-name obj) "\n\n")
+    ;; Create the widget editing the object.
+    (make-local-variable 'eieio-wo)
+    (setq eieio-wo (eieio-custom-widget-insert obj))
+    ;;Now generate the apply buttons
+    (widget-insert "\n")
+    (eieio-custom-object-apply-reset obj)
+    ;; Now initialize the buffer
+    (use-local-map widget-keymap)
+    (widget-setup)
+    ;(widget-minor-mode)
+    (goto-char (point-min))
+    (widget-forward 3)
+    (make-local-variable 'eieio-co)
+    (setq eieio-co obj)))
+
+(defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass))
+  "Insert an Apply and Reset button into the object editor.
+Argument OBJ os the object being customized."
+  (widget-create 'push-button
+		 :notify (lambda (&rest ignore)
+			   ;; I think the act of getting it sets
+			   ;; it's value through the get function.
+			   (message "Applying Changes...")
+			   (widget-apply eieio-wo :value-get)
+			   (eieio-done-customizing eieio-co)
+			   (message "Applying Changes...Done."))
+		 "Apply")
+  (widget-insert "   ")
+  (widget-create 'push-button
+		 :notify (lambda (&rest ignore)
+			   (message "Resetting.")
+			   (eieio-customize-object eieio-co))
+		 "Reset"))
+
+(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
+				       &rest flags)
+  "Insert the widget used for editing object OBJ in the current buffer.
+Arguments FLAGS are widget compatible flags.
+Must return the created widget."
+  (widget-create 'object-edit :value obj))
+
+(define-widget 'object 'object-edit
+  "Instance of a CLOS class."
+  :format "%{%t%}:\n%v"
+  :value-to-internal 'eieio-object-value-to-abstract
+  :value-to-external 'eieio-object-abstract-to-value
+  :clone-object-children t
+  )
+
+(defun eieio-object-value-to-abstract (widget value)
+  "For WIDGET, convert VALUE to an abstract /safe/ representation."
+  (clone value))
+
+(defun eieio-object-abstract-to-value (widget value)
+  "For WIDGET, convert VALUE to an abstract /safe/ representation."
+  value)
+
+(provide 'eieio-custom)
+
+;;; eieio-custom.el ends here
+;;; eieio-doc.el --- create texinfo documentation for an eieio class
+
+;;; Copyright (C) 1996, 1998, 1999 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; RCS: $Id$
+;; Keywords: OO, lisp, docs
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.org
+;;
+;; Updates can be found at:
+;;    ftp://ftp.ultranet.com/pub/zappo
+
+;;; Commentary:
+;;
+;;  Outputs into the current buffer documentation in texinfo format
+;;  for a class, all it's children, and all it's slots.
+
+;;; Code:
+(defvar eieiodoc-currently-in-node nil
+  "String representing the node we go BACK to.")
+
+(defvar eieiodoc-current-section-level nil
+  "String represending what type of section header to use.")
+
+(defvar eieiodoc-prev-class nil
+  "Non-nil when while `eieiodoc-recurse' is running.
+Can be referenced from the recursed function.")
+
+(defvar eieiodoc-next-class nil
+  "Non-nil when `eieiodoc-recurse' is running.
+Can be referenced from the recursed function.")
+
+(defun eieiodoc-class (root-class indexstring &optional skiplist)
+  "Create documentation starting with ROOT-CLASS.
+The first job is to create an indented menu of all the classes
+starting with `root-class' and including all it's children.  Once this
+is done, @nodes are created for all the subclasses.  Each node is then
+documented with a description of the class, a brief inheritance tree
+(with xrefs) and a list of all slots in a big table.  Where each slot
+is inherited from is also documented.  In addition, each class is
+documented in the index referenced by INDEXSTRING, a two letter code
+described in the texinfo manual.
+
+The optional third argument SKIPLIST is a list of object not to put
+into any menus, nodes or lists."
+  (interactive
+   (list (intern-soft
+	  (completing-read "Class: " (eieio-build-class-alist) nil t))
+	 (read-string "Index name (2 chars): ")))
+  (save-excursion
+    (setq eieiodoc-currently-in-node
+	  (if (re-search-backward "@node \\([^,]+\\)" nil t)
+	      (buffer-substring (match-beginning 1) (match-end 1))
+	    "Top")
+	  eieiodoc-current-section-level
+	  (if (re-search-forward "@\\(chapter\\|\\(sub\\)*section\\)"
+				 (+ (point) 500) t)
+	      (progn
+		(goto-char (match-beginning 0))
+		(cond ((looking-at "@chapter") "section")
+		      ((looking-at "@section") "subsection")
+		      ((looking-at "@\\(sub\\)+section") "subsubsection")
+		      (t "subsubsection")))
+	    "subsubsection")))
+  (save-excursion
+    (eieiodoc-main-menu root-class skiplist)
+    (insert "\n")
+    (eieiodoc-recurse root-class 'eieiodoc-one-node nil skiplist)))
+  
+(defun eieiodoc-main-menu (class skiplist)
+  "Create a menu of all classes under CLASS indented the correct amount.
+SKIPLIST is a list of objects to skip"
+  (end-of-line)
+  (insert "\n@menu\n")
+  (eieiodoc-recurse class (lambda (class level)
+			(insert "* " (make-string level ? )
+				(symbol-name class) " ::\n"))
+		nil skiplist)
+  (insert "@end menu\n"))
+
+(defun eieiodoc-one-node (class level)
+  "Create a node for CLASS, and for all subclasses of CLASS in order.
+This function should only be called by `eieiodoc-class'
+Argument LEVEL is the current level of recursion we have hit."
+  (message "Building node for %s" class)
+  (insert "\n@node " (symbol-name class) ", "
+	  (if eieiodoc-next-class (symbol-name eieiodoc-next-class) " ") ", "
+	  (if eieiodoc-prev-class (symbol-name eieiodoc-prev-class) " ") ", "
+	  eieiodoc-currently-in-node "\n"
+	  "@comment  node-name,  next,  previous,  up\n"
+	  "@" eieiodoc-current-section-level " " (symbol-name class) "\n"
+	  ;; indexstring is grabbed from parent calling function
+	  "@" indexstring "index " (symbol-name class) "\n\n")
+  ;; Now lets create a nifty little inheritance tree
+  (let ((cl class)
+	(revlist nil)
+	(depth 0))
+    (while cl
+      (setq revlist (cons cl revlist)
+	    cl (class-parent cl)))
+    (insert "@table @asis\n@item Inheritance Tree:\n")
+    (while revlist
+      ;; root-class is dragged in from the top-level function
+      (insert "@table @code\n@item "
+	      (if (and (child-of-class-p (car revlist) root-class)
+		       (not (eq class (car revlist))))
+		  (concat "@w{@xref{" (symbol-name (car revlist)) "}.}")
+		(symbol-name (car revlist)))
+	      "\n")
+      (setq revlist (cdr revlist)
+	    depth (1+ depth)))
+    ;; the value of rclass is brought in from caller
+    (let ((clist (reverse (aref (class-v rclass) class-children))))
+      (if (not clist)
+	  (insert "No children")
+	(insert "@table @asis\n@item Children:\n")
+	(while clist
+	  (insert "@w{@xref{" (symbol-name (car clist)) "}")
+	  (if (cdr clist) (insert ",") (insert "."))
+	  (insert "} ")
+	  (setq clist (cdr clist)))
+	(insert "\n@end table\n")
+	))
+    (while (> depth 0)
+      (insert "\n@end table\n")
+      (setq depth (1- depth)))
+    (insert "@end table\n\n  "))
+  ;; Now lets build some documentation by extracting information from
+  ;; the class description vector
+  (let* ((cv (class-v class))
+	 (docs (aref cv class-public-doc))
+	 (names (aref cv class-public-a))
+	 (deflt (aref cv class-public-d))
+	 (prot (aref cv class-protection))
+	 (typev (aref cv class-public-type))
+	 (i 0)
+	 (set-one nil)
+	 (anchor nil)
+	 )
+    ;; doc of the class itself
+    (insert (eieiodoc-texify-docstring (aref cv 2) class) "\n\n@table @asis\n")
+    (if names
+	(progn
+	  (setq anchor (point))
+	  (insert "@item Slots:\n\n@table @code\n")
+	  (while names
+	    (if (eieiodoc-one-attribute class (car names) (car docs)
+					(car prot) (car deflt) (aref typev i))
+		(setq set-one t))
+	    (setq names (cdr names)
+		  docs (cdr docs)
+		  prot (cdr prot)
+		  deflt (cdr deflt)
+		  i (1+ i)))
+	  (insert "@end table\n\n")
+	  (if (not set-one) (delete-region (point) anchor))
+	  ))
+    (insert "@end table\n")
+    ))
+
+(defun eieiodoc-one-attribute (class attribute doc priv deflt type)
+  "Create documentation of CLASS for a single ATTRIBUTE.
+Assume this attribute is inside a table, so it is initiated with the
+@item indicator.  If this attribute is not inserted (because it is
+contained in the parent) then return nil, else return t.
+DOC is the documentation to use, PRIV is non-nil if it is a private slot,
+and DEFLT is the default value.  TYPE is the symbol describing what type
+validation is done on that slot."
+  (let ((pv (eieiodoc-parent-diff class attribute))
+	(ia (eieio-attribute-to-initarg class attribute))
+	(set-me nil))
+    (if (or (eq pv t) (not ia))
+	nil  ;; same in parent or no init arg
+      (setq set-me t)
+      (insert "@item " (if priv "Private: " "")
+	      (symbol-name ia))
+      (if (and type (not (eq type t)))
+	  (insert "\nType: @code{" (format "%S" type) "}"))
+      (if (not (eq deflt eieio-unbound))
+	  (insert "\nDefault Value: @code{"(format "%S" deflt) "}"))
+      (insert "\n\n")
+      (if (eq pv 'default)
+	  ;; default differs only, xref the parent
+	  ;; This should be upgraded to actually search for the last
+	  ;; differing default (or the original.)
+	  (insert "@xref{" (symbol-name (class-parent class)) "}.\n")
+	(insert (if doc (eieiodoc-texify-docstring doc class) "Not Documented")
+		"\n@refill\n\n")))
+    set-me))
+;;;
+;; Utilities
+;;
+(defun eieiodoc-recurse (rclass func &optional level skiplist)
+  "Recurse down all children of RCLASS, calling FUNC on each one.
+LEVEL indicates the current depth below the first call we are.  The
+function FUNC will be called with RCLASS and LEVEL.  This will then
+recursivly call itself once for each child class of RCLASS.  The
+optional fourth argument SKIPLIST is a list of objects to ignore while
+recursing."
+
+  (if (not level) (setq level 0))
+
+  ;; we reverse the children so they appear in the same order as it
+  ;; does in the code that creates them.
+  (let* ((children (reverse (aref (class-v rclass) class-children)))
+	 (ocnc eieiodoc-next-class)
+	 (eieiodoc-next-class (or (car children) ocnc))
+	 (eieiodoc-prev-class eieiodoc-prev-class))
+
+    (if (not (member rclass skiplist))
+	(progn
+	  (apply func (list rclass level))
+
+	  (setq eieiodoc-prev-class rclass)))
+
+    (while children
+      (setq eieiodoc-next-class (or (car (cdr children)) ocnc))
+      (setq eieiodoc-prev-class (eieiodoc-recurse (car children) func (1+ level)))
+      (setq children (cdr children)))
+    ;; return the previous class so that the prev/next node gets it right
+    eieiodoc-prev-class))
+
+(defun eieiodoc-parent-diff (class slot)
+  "Return nil if the parent of CLASS does not have slot SLOT.
+Return t if it does, and return 'default if the default has changed."
+  (let ((df nil) (err t)
+	(scoped-class (class-parent class))
+	(eieio-skip-typecheck))
+    (condition-case nil
+	(setq df (eieio-oref-default (class-parent class) slot)
+	      err nil)
+      (invalid-slot-name (setq df nil))
+      (error (setq df nil)))
+    (if err
+	nil
+      (if (equal df (eieio-oref-default class slot))
+	  t
+	'default))))
+
+(defun eieiodoc-texify-docstring (string class)
+  "Take STRING, (a normal doc string), and convert it into a texinfo string.
+For instances where CLASS is the class being referenced, do not Xref
+that class.
+
+ `function' => @dfn{function}
+ `variable' => @code{variable}
+ `class'    => @code{class} @xref{class}
+ `unknown'  => @code{unknonwn}
+ 'quoteme   => @code{quoteme}
+ non-nil    => non-@code{nil}
+ t          => @code{t}
+ :tag       => @code{:tag}
+ [ stuff ]  => @code{[ stuff ]}
+ Key        => @kbd{Key}        (key is C-h, M-h, SPC, RET, TAB and the like)"
+  (while (string-match "`\\([-a-zA-Z0-9]+\\)'" string)
+    (let* ((vs (substring string (match-beginning 1) (match-end 1)))
+	   (v (intern-soft vs)))
+      (setq string
+	    (concat
+	     (replace-match (concat
+			     (if (and (not (class-p v))(fboundp v))
+				 "@dfn{" "@code{")
+			     vs "}"
+			     (if (and (class-p v) (not (eq v class)))
+				 (concat " @xref{" vs "}.")))
+			    nil t string)))))
+  (while (string-match "\\( \\|^\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([ ,]\\|$\\)" string)
+    (setq string (replace-match "@code{\\2}" t nil string 2)))
+  (while (string-match "\\( \\|^\\)\\(\\(non-\\)\\(nil\\)\\)\\([ ,]\\|$\\)" string)
+    (setq string (replace-match "\\2@code{\\3}" t nil string 2)))
+  (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string)
+    (setq string (replace-match "@code{\\2}" t nil string 2)))
+  (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|$\\)" string)
+    (setq string (replace-match "@kbd{\\2}" t nil string 2)))
+  string)
+
+(provide 'eieio-doc)
+
+;;; eieio-doc.el ends here
+;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
+
+;;; Copyright (C) 1996, 1998, 1999, 2000 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; RCS: $Id$
+;; Keywords: OO, lisp
+;;                                                                          
+;; This program 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 2, or (at your option)
+;; any later version.
+;;           
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.org
+;;
+;; Updates can be found at:
+;;    ftp://ftp.ultranet.com/pub/zappo
+
+;;; Commentary:
+;;
+;;   This contains support functions to eieio.  These functions contain
+;; some small class browser and class printing functions.
+;;
+
+(require 'eieio)
+
+;;; Code:
+(defun eieio-browse (&optional root-class)
+  "Create an object browser window to show all objects.
+If optional ROOT-CLASS, then start with that, otherwise start with
+variable `eieio-default-superclass'."
+  (interactive (if current-prefix-arg
+		   (list (read (completing-read "Class: "
+						(eieio-build-class-alist)
+						nil t)))
+		 nil))
+  (if (not root-class) (setq root-class 'eieio-default-superclass))
+  (if (not (class-p root-class)) (signal 'wrong-type-argument (list 'class-p root-class)))
+  (display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
+  (save-excursion
+    (set-buffer (get-buffer "*EIEIO OBJECT BROWSE*"))
+    (erase-buffer)
+    (goto-char 0)
+    (eieio-browse-tree root-class "" "")
+    ))
+
+(defun eieio-browse-tree (this-root prefix ch-prefix)
+  "Recursively, draws the children of the given class on the screen.
+Argument THIS-ROOT is the local root of the tree.
+Argument PREFIX is the character prefix to use.
+Argument CH-PREFIX is another character prefix to display."
+  (if (not (class-p (eval this-root))) (signal 'wrong-type-argument (list 'class-p this-root)))
+  (let ((myname (symbol-name this-root))
+	(chl (aref (class-v this-root) class-children))
+	(fprefix (concat ch-prefix "  +--"))
+	(mprefix (concat ch-prefix "  |  "))
+	(lprefix (concat ch-prefix "     ")))
+    (insert prefix myname "\n")
+    (while (cdr chl)
+      (eieio-browse-tree (car chl) fprefix mprefix)
+      (setq chl (cdr chl)))
+    (if chl
+	(eieio-browse-tree (car chl) fprefix lprefix))
+    ))
+
+;;;###autoload
+(defalias 'describe-class 'eieio-describe-class)
+;;;###autoload
+(defun eieio-describe-class (class)
+  "Describe a CLASS defined by a string or symbol.
+If CLASS is actually an object, then also display current values of that obect."
+  (interactive (list (eieio-read-class "Class: ")))
+  (with-output-to-temp-buffer "*Help*"
+    (princ "Class ")
+    (prin1 class)
+    (terpri)
+    ;; Inheritence tree information
+    (let ((pl (class-parents class)))
+      (when pl
+	(princ " Inherits from ")
+	(while pl
+	  (princ "`") (prin1 (car pl)) (princ "'")
+	  (if pl (princ ", "))
+	  (setq pl (cdr pl)))
+	(terpri)))
+    (let ((ch (class-children class)))
+      (when ch
+	(princ " Children ")
+	(while ch
+	  (princ "`") (prin1 (car ch)) (princ "'")
+	  (if ch (princ ", "))
+	  (setq ch (cdr ch)))
+	(terpri)))
+    (terpri)
+    ;; System documentation
+    (let ((doc (documentation-property class 'variable-documentation)))
+      (when doc
+	(princ "Documentation:")
+	(terpri)
+	(princ doc)
+	(terpri)
+	(terpri)))
+    ;; Describe all the slots in this class
+    (eieio-describe-class-slots class)
+    ;; Describe all the methods specific to this class.
+    (let ((methods (eieio-all-generic-functions class))
+	  (doc nil))
+      (if (not methods) nil
+	(princ "Specialized Methods:")
+	(terpri)
+	(terpri)
+	(while methods
+	  (setq doc (eieio-method-documentation (car methods) class))
+	  (princ "`")
+	  (prin1 (car methods))
+	  (princ "'")
+	  (if (not doc)
+	      (princ "  Undocumented")
+	    (if (car doc)
+		(progn
+		  (princ "  :BEFORE method:")
+		  (terpri)
+		  (princ (car doc))))
+	    (setq doc (cdr doc))
+	    (if (car doc)
+		(progn
+		  (princ "  :PRIMARY method:")
+		  (terpri)
+		  (princ (car doc))))
+	    (setq doc (cdr doc))
+	    (if (car doc)
+		(progn
+		  (princ "  :AFTER method:")
+		  (terpri)
+		  (princ (car doc))))
+	    (terpri)
+	    (terpri))
+	  (setq methods (cdr methods)))))
+    (buffer-string)))
+
+(defun eieio-describe-class-slots (class)
+  "Describe the slots in CLASS.
+Outputs to the standard output."
+  (let* ((cv (class-v class))
+	 (docs   (aref cv class-public-doc))
+	 (names  (aref cv class-public-a))
+	 (deflt  (aref cv class-public-d))
+	 (types  (aref cv class-public-type))
+	 (i      0)
+	 (prot   (aref cv class-protection))
+	 )
+    (princ "Instance Allocated Slots:")
+    (terpri)
+    (terpri)
+    (while names
+      (if (car prot) (princ "Private "))
+      (princ "Slot: ")
+      (prin1 (car names))
+      (when (not (eq (aref types i) t))
+	(princ "    type = ")
+	(prin1 (aref types i)))
+      (unless (eq (car deflt) eieio-unbound)
+	(princ "    default = ")
+	(prin1 (car deflt)))
+      (when (car docs)
+	(terpri)
+	(princ "  ")
+	(princ (car docs))
+	(terpri))
+      (terpri)
+      (setq names (cdr names)
+	    docs (cdr docs)
+	    deflt (cdr deflt)
+	    prot (cdr prot)
+	    i (1+ i)))
+    (setq docs  (aref cv class-class-allocation-doc)
+	  names (aref cv class-class-allocation-a)
+	  types (aref cv class-class-allocation-type)
+	  i     0
+	  prot  (aref cv class-class-allocation-protection))
+    (when names
+	(terpri)
+	(princ "Class Allocated Slots:"))
+	(terpri)
+	(terpri)
+    (while names
+      (when (car prot)
+	(princ "Private "))
+      (princ "Slot: ")
+      (prin1 (car names))
+      (unless (eq (aref types i) t)
+	(princ "    type = ")
+	(prin1 (aref types i)))
+      (when (car docs)
+	(terpri)
+	(princ "  ")
+	(princ (car docs))
+	(terpri))
+      (terpri)
+      (setq names (cdr names)
+	    docs (cdr docs)
+	    prot (cdr prot)
+	    i (1+ i)))))
+
+(defun eieio-build-class-alist (&optional class buildlist)
+  "Return an alist of all currently active classes for completion purposes.
+Optional argument CLASS is the class to start with.
+Optional argument BUILDLIST is more list to attach."
+  (let* ((cc (or class eieio-default-superclass))
+	 (sublst (aref (class-v cc) class-children)))
+    (setq buildlist (cons (cons (symbol-name cc) 1) buildlist))
+    (while sublst
+      (setq buildlist (eieio-build-class-alist (car sublst) buildlist))
+      (setq sublst (cdr sublst)))
+    buildlist))
+
+(defvar eieio-read-class nil
+  "History of the function `eieio-read-class' prompt.")
+
+(defun eieio-read-class (prompt &optional histvar)
+  "Return a class chosen by the user using PROMPT.
+Optional argument HISTVAR is a variable to use as history."
+  (intern (completing-read prompt (eieio-build-class-alist) nil t nil
+			   (or histvar 'eieio-read-class))))
+
+;;; Collect all the generic functions created so far, and do cool stuff.
+;;
+;;;###autoload
+(defalias 'describe-method 'eieio-describe-generic)
+;;;###autoload
+(defalias 'describe-generic 'eieio-describe-generic)
+;;;###autoload
+(defalias 'eieio-describe-method 'eieio-describe-generic)
+;;;###autoload
+(defun eieio-describe-generic (generic)
+  "Describe the generic function GENERIC.
+Also extracts information about all methods specific to this generic."
+  (interactive (list (eieio-read-generic "Generic Method: ")))
+  (if (not (generic-p generic))
+      (signal 'wrong-type-argument '(generic-p generic)))
+  (with-output-to-temp-buffer "*Help*"
+    (prin1 generic)
+    (princ " is a generic function.")
+    (terpri)
+    (terpri)
+    (let ((d (documentation generic)))
+      (if (not d)
+	  (princ "The generic is not documented.\n")
+	(princ "Documentation:")
+	(terpri)
+	(princ d)
+	(terpri)
+	(terpri)))
+    (princ "Implementations:")
+    (terpri)
+    (terpri)
+    (let ((i 3)
+	  (prefix [ ":BEFORE" ":PRIMARY" ":AFTER" ] ))
+      ;; Loop over fanciful generics
+      (while (< i 6)
+	(let ((gm (aref (get generic 'eieio-method-tree) i)))
+	  (when gm
+	    (princ "Generic ")
+	    (princ (aref prefix (- i 3)))
+	    (terpri)
+	    (princ (or (nth 2 gm) "Undocumented"))
+	    (terpri)
+	    (terpri)))
+	(setq i (1+ i)))
+      (setq i 0)
+      ;; Loop over defined class-specific methods
+      (while (< i 3)
+	(let ((gm (reverse (aref (get generic 'eieio-method-tree) i))))
+	  (while gm
+	    (princ "`")
+	    (prin1 (car (car gm)))
+	    (princ "'")
+	    ;; prefix type
+	    (princ " ")
+	    (princ (aref prefix i))
+	    (princ " ")
+	    ;; argument list
+	    (let* ((func (cdr (car gm)))
+		   (arglst
+		    (if (byte-code-function-p func)
+			(eieio-compiled-function-arglist func)
+		      (car (cdr func)))))
+	      (prin1 arglst))
+	    (terpri)
+	    ;; 3 because of cdr
+	    (princ (or (documentation (cdr (car gm)))
+		       "Undocumented"))
+	    (setq gm (cdr gm))
+	    (terpri)
+	    (terpri)))
+	(setq i (1+ i))))
+    (buffer-string)))
+
+(defun eieio-all-generic-functions (&optional class)
+  "Return a list of all generic functions.
+Optional CLASS argument returns only those functions that contain methods for CLASS."
+  (let ((l nil) tree (cn (if class (symbol-name class) nil)))
+    (mapatoms
+     (lambda (symbol)
+       (setq tree (get symbol 'eieio-method-obarray))
+       (if tree
+	   (progn
+	     ;; A symbol might be interned for that class in one of
+	     ;; these three slots in the method-obarray.
+	     (if (or (not class)
+		     (fboundp (intern-soft cn (aref tree 0)))
+		     (fboundp (intern-soft cn (aref tree 1)))
+		     (fboundp (intern-soft cn (aref tree 2))))
+		 (setq l (cons symbol l)))))))
+    l))
+
+(defun eieio-method-documentation (generic class)
+  "Return a list of the specific documentation of GENERIC for CLASS.
+If there is not an explicit method for CLASS in GENERIC, or if that
+function has no documentation, then return nil."
+  (let ((tree (get generic 'eieio-method-obarray))
+	(cn (symbol-name class))
+	before primary after)
+    (if (not tree)
+	nil
+      ;; A symbol might be interned for that class in one of
+      ;; these three slots in the method-obarray.
+      (setq before (intern-soft cn (aref tree 0))
+	    primary (intern-soft cn (aref tree 1))
+	    after (intern-soft cn (aref tree 2)))
+      (if (not (or (fboundp before)
+		   (fboundp primary)
+		   (fboundp after)))
+	  nil
+	(list (if (fboundp before) (documentation before) nil)
+	      (if (fboundp primary) (documentation primary) nil)
+	      (if (fboundp after) (documentation after)))))))
+
+(defvar eieio-read-generic nil
+  "History of the `eieio-read-generic' prompt.")
+
+(defun eieio-read-generic-p (fn)
+  "Function used in function `eieio-read-generic'.
+This is because `generic-p' is a macro.
+Argument FN is the function to test."
+  (generic-p fn))
+
+(defun eieio-read-generic (prompt &optional historyvar)
+  "Read a generic function from the minibuffer with PROMPT.
+Optional argument HISTORYVAR is the variable to use as history."
+  (intern (completing-read prompt obarray 'eieio-read-generic-p
+			   t nil (or historyvar 'eieio-read-generic))))
+
+;;; Help system augmentation
+;;
+(defun eieio-help-mode-augmentation-maybee ()
+  "For buffers thrown into help mode, augment for eieio."
+  ;; Scan created buttons so far if we are in help mode.
+  (when (eq major-mode 'help-mode)
+    ;; View mode's read-only status of existing *Help* buffer is lost
+    ;; by with-output-to-temp-buffer.
+    (toggle-read-only -1)
+    (goto-char (point-min))
+    (save-excursion
+      (let ((pos t))
+	(while pos
+	  (if (get-text-property (point) 'help-xref) ; move off reference
+	      (goto-char
+	       (or (next-single-property-change (point) 'help-xref)
+		   (point))))
+	  (setq pos (next-single-property-change (point) 'help-xref))
+	  (when pos
+	    (goto-char pos)
+	    (let* ((help-data (get-text-property (point) 'help-xref))
+		   (method (car help-data))
+		   (args (cdr help-data)))
+	      (when (symbolp (car args))
+		(cond ((class-p (car args))
+		       (setcar help-data 'eieio-describe-class))
+		      ((generic-p (car args))
+		       (setcar help-data 'eieio-describe-generic))
+		      (t nil))
+		))))))))
+
+(defun eieio-help-augment-keymap ()
+  "Augment the help keymap for cool EIEIO stuff."
+  (define-key help-map "g" 'describe-generic)
+  (define-key help-map "C" 'describe-class))
+
+(if (and (boundp 'help-map) help-map)
+    (eieio-help-augment-keymap)
+  (eval-after-load 'help 'eieio-help-augment-keymap))
+
+;;; How about showing the hierarchy in speedbar?  Cool!
+;;
+(eval-when-compile
+  (condition-case nil
+      (require 'speedbar)
+    (error (message "Error loading speedbar... ignored."))))
+
+(defvar eieio-class-speedbar-key-map nil
+  "Keymap used when working with a project in speedbar.")
+
+(defun eieio-class-speedbar-make-map ()
+  "Make a keymap for eieio under speedbar."
+  (setq eieio-class-speedbar-key-map (speedbar-make-specialized-keymap))
+
+  ;; General viewing stuff
+  (define-key eieio-class-speedbar-key-map "\C-m" 'speedbar-edit-line)
+  (define-key eieio-class-speedbar-key-map "+" 'speedbar-expand-line)
+  (define-key eieio-class-speedbar-key-map "-" 'speedbar-contract-line)
+  )
+
+(if eieio-class-speedbar-key-map
+    nil
+  (if (not (featurep 'speedbar))
+      (add-hook 'speedbar-load-hook (lambda ()
+				      (eieio-class-speedbar-make-map)
+				      (speedbar-add-expansion-list
+				       '("EIEIO"
+					 eieio-class-speedbar-menu
+					 eieio-class-speedbar-key-map
+					 eieio-class-speedbar))))
+    (eieio-class-speedbar-make-map)
+    (speedbar-add-expansion-list '("EIEIO"
+				   eieio-class-speedbar-menu
+				   eieio-class-speedbar-key-map
+				   eieio-class-speedbar))))
+
+(defvar eieio-class-speedbar-menu
+  ()
+  "Menu part in easymenu format used in speedbar while in `eieio' mode.")
+
+(defun eieio-class-speedbar (dir-or-object depth)
+  "Create buttons in speedbar that represents the current project.
+DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the current
+expansion depth."
+  ;; This function is only called once, to start the whole deal.
+  ;; Ceate, and expand the default object.
+  (eieio-class-button eieio-default-superclass 0)
+  (forward-line -1)
+  (speedbar-expand-line))
+
+(defun eieio-class-button (class depth)
+  "Draw a speedbar button at the current point for CLASS at DEPTH."
+  (if (not (class-p class))
+      (signal 'wrong-type-argument (list 'class-p class)))
+  (speedbar-make-tag-line 'angle ?+
+			  'eieio-sb-expand
+			  class
+			  (symbol-name class)
+			  'eieio-describe-class-sb
+			  class
+			  'speedbar-directory-face
+			  depth))
+
+(defun eieio-sb-expand (text class indent)
+  "For button TEXT, expand CLASS at the current location.
+Argument INDENT is the depth of indentation."
+  (cond ((string-match "+" text)	;we have to expand this file
+	 (speedbar-change-expand-button-char ?-)
+	 (speedbar-with-writable
+	   (save-excursion
+	     (end-of-line) (forward-char 1)
+	     (let ((subclasses (aref (class-v class) class-children)))
+	       (while subclasses
+		 (eieio-class-button (car subclasses) (1+ indent))
+		 (setq subclasses (cdr subclasses)))))))
+	((string-match "-" text)	;we have to contract this node
+	 (speedbar-change-expand-button-char ?+)
+	 (speedbar-delete-subblock indent))
+	(t (error "Ooops...  not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun eieio-describe-class-sb (text token indent)
+  "Describe the class TEXT in TOKEN.
+INDENT is the current indentation level."
+  (speedbar-with-attached-buffer
+   (eieio-describe-class token))
+  (speedbar-maybee-jump-to-attached-frame))
+
+(provide 'eieio-opt)
+
+;;; eieio-opt.el ends here

eieio-speedbar.el

+;;; eieio-speedbar.el -- Classes for managing speedbar displays.
+
+;;;
+;; Copyright (C) 1999, 2000 Eric M. Ludlam
+;;
+;; Author: <zappo@gnu.org>
+;; RCS: $Id$
+;; Keywords: oop, tools
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.