CVS update by michaels packages/xemacs-packages/eieio,
Makefile.upstream, eieio-base.el, eieio-doc.el, eieio-tests.el,
package-info.in ...
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Mon Nov 26 10:01:24 EST 2007
User: michaels
Date: 07/11/26 16:01:23
Modified: packages/xemacs-packages/eieio ChangeLog INSTALL Makefile
Makefile.upstream Project.ede call-tree.el chart.el
eieio-base.el eieio-comp.el eieio-custom.el
eieio-doc.el eieio-opt.el eieio-speedbar.el
eieio-tests.el eieio.el eieio.texi linemark.el
package-info.in tree.el
Added: packages/xemacs-packages/eieio ChangeLog.upstream NEWS
eieio-load.el eieio-loaddefs.el
eieio-test-methodinvoke.el eieio.el.upstream
lmcompile.el
Log:
Update eieio to CEDET 1.0pre4 version.
Revision Changes Path
1.18 +6 -0 XEmacs/packages/xemacs-packages/eieio/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/ChangeLog,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -p -r1.17 -r1.18
--- ChangeLog 2003/10/31 16:47:49 1.17
+++ ChangeLog 2007/11/26 15:01:01 1.18
@@ -1,3 +1,9 @@
+2007-11-18 Mike Sperber <mike at xemacs.org>
+
+ * eieio.el (eieio-defclass): Add autoload.
+
+ * Makefile (AUTHOR_VERSION): Updated to CEDET 1.0pre4.
+
2003-10-31 Norbert Koch <viteno at xemacs.org>
* Makefile (VERSION): XEmacs package 1.05 released.
1.4 +5 -28 XEmacs/packages/xemacs-packages/eieio/INSTALL
Index: INSTALL
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/INSTALL,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- INSTALL 2002/08/09 21:54:34 1.3
+++ INSTALL 2007/11/26 15:01:02 1.4
@@ -1,37 +1,14 @@
-Installation instructions for Eieio
+Installation instructions for EIEIO
The following updates to your .emacs file will help you get the most out of this
update of eieio.
1) Byte compile EIEIO
-
- a) Edit Makefile, and change LOADPATH to include the path to
- Speedbar.
- b) run "make"
-
- -OR-
-
- a) run: make "LOADPATH=<path to speedbar>"
-
- If byte compilation fails fails:
- a) Follow step 3:
- b) byte compile the files individually and interactivly from
- Emacs or XEmacs.
-
- It is not necessary to use Speedbar with EIEIO, but EIEIO does
- support speedbar, and it is needed to compile those few files.
-
2) Add eieio's directory to your load path.
-
- (add-to-list 'load-path "~/eieio-X.XX")
-
- 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.
-
-3) Upgrading EIEIO.
+ Follow the INSTALL file in the top level of this distribution.
- New versions of EIEIO can be found here:
+3) To send bug reports, or participate in discussions about semantic,
+ use the mailing list cedet-eieio@@sourceforge.net via the URL:
- http://cedet.sourceforge.net/eieio.shtml
\ No newline at end of file
+ http://lists.sourceforge.net/lists/listinfo/cedet-eieio
1.16 +7 -5 XEmacs/packages/xemacs-packages/eieio/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/Makefile,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -p -r1.15 -r1.16
--- Makefile 2003/10/31 16:47:50 1.15
+++ Makefile 2007/11/26 15:01:02 1.16
@@ -18,20 +18,22 @@
# Boston, MA 02111-1307, USA.
VERSION = 1.05
-AUTHOR_VERSION = 0.17
-MAINTAINER = Eric Ludlam <zappo at gnu.org>
+AUTHOR_VERSION = 1.0pre4
+MAINTAINER = XEmacs Development Team <xemacs-beta at xemacs.org>
+AUTHOR = Eric Ludlam <zappo at gnu.org>
PACKAGE = eieio
PKG_TYPE = regular
-REQUIRES = speedbar xemacs-base edebug
+REQUIRES = xemacs-base edebug cedet-common speedbar
CATEGORY = standard
ELCS = eieio-comp.elc eieio.elc eieio-opt.elc eieio-custom.elc \
eieio-doc.elc eieio-base.elc tree.elc call-tree.elc \
- chart.elc eieio-speedbar.elc linemark.elc
+ chart.elc eieio-speedbar.elc linemark.elc \
+ eieio-load.elc lmcompile.elc
STANDARD_DOCS = t
-EXTRA_SOURCES = INSTALL Project.ede eieio-tests.el
+EXTRA_SOURCES = INSTALL Project.ede eieio-tests.el eieio-test-methodinvoke.el
include ../../XEmacs.rules
1.4 +41 -17 XEmacs/packages/xemacs-packages/eieio/Makefile.upstream
Index: Makefile.upstream
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/Makefile.upstream,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- Makefile.upstream 2002/08/09 21:54:34 1.3
+++ Makefile.upstream 2007/11/26 15:01:02 1.4
@@ -9,47 +9,72 @@
top=
ede_FILES=Project.ede Makefile
-eieio_LISP=eieio.el eieio-comp.el eieio-opt.el eieio-custom.el eieio-doc.el eieio-base.el
+EMACS=emacs
+LOADPATH=../common/ ../speedbar/
+LOADDEFS=eieio-loaddefs.el
+LOADDIRS=.
+init_LISP=eieio-load.el
EMACS=emacs
-LOADPATH=
-examples_LISP=tree.el call-tree.el chart.el eieio-speedbar.el linemark.el
+eieio_LISP=eieio.el eieio-comp.el eieio-opt.el eieio-custom.el eieio-doc.el eieio-base.el
+examples_LISP=tree.el call-tree.el chart.el eieio-speedbar.el linemark.el lmcompile.el
eieio_info_TEXINFOS=eieio.texi
MAKEINFO=makeinfo
-test_LISP=eieio-tests.el
-Misc_MISC=INSTALL ChangeLog
-VERSION=0.17
+test_LISP=eieio-tests.el eieio-test-methodinvoke.el
+Misc_MISC=INSTALL ChangeLog NEWS
+VERSION=1.0
DISTDIR=$(top)eieio-$(VERSION)
+
+all: autoloads init eieio examples eieio.info
+
+.PHONY: autoloads
+autoloads:
+ @echo "(add-to-list 'load-path nil)" > $@-compile-script
+ for loadpath in . ${LOADPATH}; do \
+ echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
+ done;
+ @echo "(require 'cedet-autogen)" >> $@-compile-script
+ "$(EMACS)" -batch --no-site-file -l $@-compile-script -f cedet-batch-update-autoloads $(LOADDEFS) $(LOADDIRS)
-all: eieio examples eieio.info
+.PHONY: init
+init: $(init_LISP)
+ @echo "(add-to-list 'load-path nil)" > $@-compile-script
+ for loadpath in . ${LOADPATH}; do \
+ echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
+ done;
+ @echo "(setq debug-on-error t)" >> $@-compile-script
+ "$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
+.PHONY: eieio
eieio: $(eieio_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
- $(EMACS) -batch -l $@-compile-script -f batch-byte-compile $^
+ "$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
+.PHONY: examples
examples: $(examples_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
- $(EMACS) -batch -l $@-compile-script -f batch-byte-compile $^
+ "$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
eieio.info: $(eieio_info_TEXINFOS)
- $(MAKEINFO) -o $@ $<
+ $(MAKEINFO) $<
+.PHONY: test
test: $(test_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
- $(EMACS) -batch -l $@-compile-script -f batch-byte-compile $^
+ "$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
Misc:
@
@@ -58,18 +83,17 @@ tags:
clean:
- rm -f *.elc *.html *.info
+ rm -f *.elc *.html *.info*
+.PHONY: dist
-dist: eieio.info
- rm -rf $(DISTDIR)
+dist: autoloads eieio.info
mkdir $(DISTDIR)
- cp $(eieio_LISP) $(examples_LISP) $(eieio_info_TEXINFOS) eieio.info* $(test_LISP) $(Misc_MISC) $(ede_FILES) $(DISTDIR)
- tar -cvzf $(DISTDIR).tar.gz $(DISTDIR)
- rm -rf $(DISTDIR)
+ cp eieio-loaddefs.el $(init_LISP) $(eieio_LISP) $(examples_LISP) $(eieio_info_TEXINFOS) eieio.info* $(test_LISP) $(Misc_MISC) $(ede_FILES) $(DISTDIR)
Makefile: Project.ede
@echo Makefile is out of date! It needs to be regenerated by EDE.
+ @echo If you have not modified Project.ede, you can use 'touch' to update the Makefile time stamp.
@false
1.4 +16 -5 XEmacs/packages/xemacs-packages/eieio/Project.ede
Index: Project.ede
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/Project.ede,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- Project.ede 2002/08/09 21:54:34 1.3
+++ Project.ede 2007/11/26 15:01:03 1.4
@@ -2,35 +2,45 @@
;; EDE project file.
(ede-proj-project "eieio"
:name "eieio"
-:version "0.17"
:file "Project.ede"
:targets (list
+ (ede-proj-target-elisp-autoloads "autoloads"
+:name "autoloads"
+:path ""
+:autoload-file "eieio-loaddefs.el"
+ )
+ (ede-proj-target-elisp "init"
+:name "init"
+:path ""
+:source '("eieio-load.el")
+ )
(ede-proj-target-elisp "eieio"
:name "eieio"
:path ""
:source '("eieio.el" "eieio-comp.el" "eieio-opt.el" "eieio-custom.el" "eieio-doc.el" "eieio-base.el")
:versionsource '("eieio.el")
+:aux-packages '("speedbar")
)
(ede-proj-target-elisp "examples"
:name "examples"
:path ""
-:source '("tree.el" "call-tree.el" "chart.el" "eieio-speedbar.el" "linemark.el")
+:source '("tree.el" "call-tree.el" "chart.el" "eieio-speedbar.el" "linemark.el" "lmcompile.el")
)
(ede-proj-target-makefile-info "eieio.info"
:name "eieio.info"
:path ""
:source '("eieio.texi")
)
- (ede-proj-target-elisp "nil"
+ (ede-proj-target-elisp "test"
:name "test"
:path ""
-:source '("eieio-tests.el")
+:source '("eieio-tests.el" "eieio-test-methodinvoke.el")
:partofall 'nil
)
(ede-proj-target-makefile-miscelaneous "Misc"
:name "Misc"
:path ""
-:source '("INSTALL" "ChangeLog")
+:source '("INSTALL" "ChangeLog" "NEWS")
:partofall 'nil
)
)
@@ -39,4 +49,5 @@
:web-site-file "eieio.shtml"
:ftp-upload-site "/ftp at upload.sourceforge.net:/incoming"
:configuration-variables 'nil
+:metasubproject 't
)
1.3 +5 -8 XEmacs/packages/xemacs-packages/eieio/call-tree.el
Index: call-tree.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/call-tree.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- call-tree.el 2002/08/09 21:54:34 1.2
+++ call-tree.el 2007/11/26 15:01:03 1.3
@@ -1,11 +1,11 @@
;;; call-tree.el --- Uses tree mode to display a call tree of the
;; give emacs lisp function.
;;
-;; Copyright (C) 1996, 1998, 2001 Eric M. Ludlam
+;; Copyright (C) 1996, 1998, 2001, 2005 Eric M. Ludlam
;;
;; Author: <zappo at gnu.ai.mit.edu>
;; Version: 0.1
-;; RCS: $Id: call-tree.el,v 1.2 2002/08/09 21:54:34 youngs Exp $
+;; RCS: $Id: call-tree.el,v 1.3 2007/11/26 15:01:03 michaels Exp $
;; Keywords: OO, tree, call-graph
;;
;; This program is free software; you can redistribute it and/or modify
@@ -19,12 +19,9 @@
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
;; Please send bug reports, etc. to zappo at gnu.org
1.4 +7 -10 XEmacs/packages/xemacs-packages/eieio/chart.el
Index: chart.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/chart.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- chart.el 2002/08/09 21:54:35 1.3
+++ chart.el 2007/11/26 15:01:03 1.4
@@ -1,10 +1,10 @@
;;; chart.el --- Draw charts (bar charts, etc)
-;;; Copyright (C) 1996, 1998, 1999, 2001 Eric M. Ludlam
+;;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
;; Version: 0.2
-;; RCS: $Id: chart.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: chart.el,v 1.4 2007/11/26 15:01:03 michaels Exp $
;; Keywords: OO, chart, graph
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,13 +18,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -664,7 +661,7 @@ SORT-PRED if desired."
(erase-buffer)
(insert "cd " d ";du -sk * \n")
(message "Running `cd %s;du -sk *'..." d)
- (call-process-region (point-min) (point-max) "csh" t
+ (call-process-region (point-min) (point-max) shell-file-name t
(current-buffer) nil)
(goto-char (point-min))
(message "Scanning output ...")
@@ -673,7 +670,7 @@ SORT-PRED if desired."
(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))))
+ cntlst (cons (* (string-to-number num) 1000) cntlst))))
(if (not nmlst)
(error "No files found!"))
(chart-bar-quickie 'vertical (format "Largest files in %s" d)
1.3 +20 -19 XEmacs/packages/xemacs-packages/eieio/eieio-base.el
Index: eieio-base.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-base.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- eieio-base.el 2002/08/09 21:54:35 1.2
+++ eieio-base.el 2007/11/26 15:01:03 1.3
@@ -1,10 +1,10 @@
;;; eieio-base.el --- Base classes for EIEIO.
;;;
-;; Copyright (C) 2000, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 2000, 2001, 2002, 2004, 2005, 2007 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-base.el,v 1.2 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-base.el,v 1.3 2007/11/26 15:01:03 michaels Exp $
;; Keywords: OO, lisp
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,13 +18,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -76,7 +73,7 @@ All slots are unbound, except those init
(if (not passname)
(save-match-data
(if (string-match "-\\([0-9]+\\)" nm)
- (setq num (1+ (string-to-int (match-string 1 nm)))
+ (setq num (1+ (string-to-number (match-string 1 nm)))
nm (substring nm 0 (match-beginning 0))))
(aset nobj object-name (concat nm "-" (int-to-string num))))
(aset nobj object-name (car params)))
@@ -109,7 +106,7 @@ a variable symbol used to store a list o
Optional argument FIELDS are the initialization arguments."
;; Theoretically, this is never called twice for a given instance.
(let ((sym (oref this tracking-symbol)))
- (if (not (member this (symbol-value sym)))
+ (if (not (memq this (symbol-value sym)))
(set sym (append (symbol-value sym) (list this))))))
(defmethod delete-instance ((this eieio-instance-tracker))
@@ -145,21 +142,27 @@ A singleton is a class which will only e
NAME and FIELDS initialize the new object.
This constructor guarantees that no matter how many you request,
only one object ever exists."
+ ;; NOTE TO SELF: In next version, make `slot-boundp' support classes
+ ;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
- (or old (call-next-method))))
+ (if (eq old eieio-unbound)
+ (oset-default class singleton (call-next-method))
+ old)))
;;; eieio-persistent
;;
-;; For objects which must save themselves to disk. Provides a
-;; `object-save' method to save an object to disk, and a
+;; For objects which must save themselves to disk. Provides an
+;; `object-write' method to save an object to disk, and a
;; `eieio-persistent-read' function to call to read an object
;; from disk.
;;
;; Also provide the method `eieio-persistent-path-relative' to
;; calculate path names relative to a given instance. This will
-;; can make the saved object location independent of all file
-;; references are made relative.
+;; make the saved object location independent by converting all file
+;; references to be relative to the directory the object is saved to.
+;; You must call `eieio-peristent-path-relative' on each file name
+;; saved in your object.
(defclass eieio-persistent ()
((file :initarg :file
:type string
@@ -206,8 +209,7 @@ a file. Optional argument NAME specifie
(set-buffer (get-buffer-create " *tmp eieio read*"))
(unwind-protect
(progn
- (erase-buffer)
- (insert-file filename)
+ (insert-file-contents filename nil nil nil t)
(goto-char (point-min))
(setq ret (read (current-buffer)))
(if (not (child-of-class-p (car ret) 'eieio-persistent))
@@ -224,7 +226,6 @@ Optional argument COMMENT is a header li
(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
"For object THIS, make absolute file name FILE relative."
- ;; Woah! Look at `file-relative-name' as a solution.
(file-relative-name (expand-file-name file)
(file-name-directory (oref this file))))
@@ -270,7 +271,7 @@ access to it."
(defmethod slot-missing ((obj eieio-named)
slot-name operation &optional new-value)
"Called when a on-existant slot is accessed.
-For variable `eieio-named', provide an imaginary `object-nam' slot.
+For variable `eieio-named', provide an imaginary `object-name' slot.
Argument OBJ is the Named object.
Argument SLOT-NAME is the slot that was attempted to be accessed.
OPERATION is the type of access, such as `oref' or `oset'.
1.5 +5 -8 XEmacs/packages/xemacs-packages/eieio/eieio-comp.el
Index: eieio-comp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-comp.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- eieio-comp.el 2002/08/09 21:54:35 1.4
+++ eieio-comp.el 2007/11/26 15:01:03 1.5
@@ -1,10 +1,10 @@
;;; eieio-comp.el -- eieio routines to help with byte compilation
;;;
-;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002, 2005 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-comp.el,v 1.4 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-comp.el,v 1.5 2007/11/26 15:01:03 michaels Exp $
;; Keywords: oop, lisp, tools
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,12 +18,9 @@
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
;; Please send bug reports, etc. to zappo at gnu.org
1.4 +16 -12 XEmacs/packages/xemacs-packages/eieio/eieio-custom.el
Index: eieio-custom.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-custom.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio-custom.el 2002/08/09 21:54:35 1.3
+++ eieio-custom.el 2007/11/26 15:01:04 1.4
@@ -1,9 +1,9 @@
;;; eieio-custom.el -- eieio object customization
-;;; Copyright (C) 1999, 2000, 2001 Eric M. Ludlam
+;;; Copyright (C) 1999, 2000, 2001, 2005, 2007 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-custom.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-custom.el,v 1.4 2007/11/26 15:01:04 michaels Exp $
;; Keywords: OO, lisp
;;
;; This program is free software; you can redistribute it and/or modify
@@ -17,13 +17,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -67,7 +64,8 @@ of these.")
(defcustom eieio-widget-test (eieio-widget-test-class "Foo")
"Test variable for editing an object."
-:type 'object)
+:type 'object
+:group 'eieio)
(defface eieio-custom-slot-tag-face '((((class color)
(background dark))
@@ -86,6 +84,10 @@ of these.")
(defvar eieio-cog nil
"Buffer local variable in object customize buffers for the current group.")
+ (defvar eieio-custom-ignore-eieio-co nil
+ "When true, all customizable fields of the current object are updated.
+Updates occur regardless of the current customization group.")
+
(define-widget 'object-slot 'group
"Abstractly modify a single slot in an object."
:tag "Slot"
@@ -301,12 +303,14 @@ Optional argument IGNORE is an extraneou
;; Create a batch of initargs for each slot.
(while (and fields chil)
(if (and (car fcust)
- (or (not master-group) (member master-group (car fgroup)))
+ (or eieio-custom-ignore-eieio-co
+ (not master-group) (member master-group (car fgroup)))
(slot-boundp obj (car fields)))
(progn
;; Only customized fields have widgets
- (eieio-oset obj (car fields)
- (car (widget-apply (car chil) :value-inline)))
+ (let ((eieio-custom-ignore-eieio-co t))
+ (eieio-oset obj (car fields)
+ (car (widget-apply (car chil) :value-inline))))
(setq chil (cdr chil))))
(setq fields (cdr fields)
fgroup (cdr fgroup)
1.4 +12 -11 XEmacs/packages/xemacs-packages/eieio/eieio-doc.el
Index: eieio-doc.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-doc.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio-doc.el 2002/08/09 21:54:35 1.3
+++ eieio-doc.el 2007/11/26 15:01:04 1.4
@@ -1,9 +1,9 @@
;;; eieio-doc.el --- create texinfo documentation for an eieio class
-;;; Copyright (C) 1996, 1998, 1999, 2000, 2001 Eric M. Ludlam
+;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2004, 2005 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-doc.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-doc.el,v 1.4 2007/11/26 15:01:04 michaels Exp $
;; Keywords: OO, lisp, docs
;;
;; This program is free software; you can redistribute it and/or modify
@@ -17,13 +17,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -62,7 +59,7 @@ The first job is to create an indented m
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
+\(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.
@@ -73,6 +70,8 @@ into any menus, nodes or lists."
(list (intern-soft
(completing-read "Class: " (eieio-build-class-alist) nil t))
(read-string "Index name (2 chars): ")))
+ (if (looking-at "[ \t\n]+ at end ignore")
+ (goto-char (match-end 0)))
(save-excursion
(setq eieiodoc-currently-in-node
(if (re-search-backward "@node \\([^,]+\\)" nil t)
@@ -187,8 +186,10 @@ Argument LEVEL is the current level of r
(let ((methods (eieio-all-generic-functions class))
(doc nil))
(if (not methods) nil
- (insert "@sub" eieiodoc-current-section-level
- " Specialized Methods\n\n")
+ (if (string= eieiodoc-current-section-level "subsubsection")
+ (insert "@" eieiodoc-current-section-level)
+ (insert "@sub" eieiodoc-current-section-level))
+ (insert " Specialized Methods\n\n")
(while methods
(setq doc (eieio-method-documentation (car methods) class))
(insert "@deffn Method " (symbol-name (car methods)))
1.5 +23 -17 XEmacs/packages/xemacs-packages/eieio/eieio-opt.el
Index: eieio-opt.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-opt.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- eieio-opt.el 2002/11/28 17:30:38 1.4
+++ eieio-opt.el 2007/11/26 15:01:05 1.5
@@ -1,9 +1,9 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
-;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
+;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-opt.el,v 1.4 2002/11/28 17:30:38 scop Exp $
+;; RCS: $Id: eieio-opt.el,v 1.5 2007/11/26 15:01:05 michaels Exp $
;; Keywords: OO, lisp
;;
;; This program is free software; you can redistribute it and/or modify
@@ -17,13 +17,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -35,6 +32,7 @@
(require 'eieio)
;;; Code:
+;;;###autoload
(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
@@ -92,16 +90,16 @@ If CLASS is actually an object, then als
(princ " Inherits from ")
(while pl
(princ "`") (prin1 (car pl)) (princ "'")
- (if pl (princ ", "))
- (setq pl (cdr pl)))
+ (setq pl (cdr pl))
+ (if pl (princ ", ")))
(terpri)))
(let ((ch (class-children class)))
(when ch
(princ " Children ")
(while ch
(princ "`") (prin1 (car ch)) (princ "'")
- (if ch (princ ", "))
- (setq ch (cdr ch)))
+ (setq ch (cdr ch))
+ (if ch (princ ", ")))
(terpri)))
(terpri)
;; System documentation
@@ -130,6 +128,13 @@ If CLASS is actually an object, then als
(princ " Undocumented")
(if (car doc)
(progn
+ (princ " :STATIC ")
+ (prin1 (car (car doc)))
+ (terpri)
+ (princ (cdr (car doc)))))
+ (setq doc (cdr doc))
+ (if (car doc)
+ (progn
(princ " :BEFORE ")
(prin1 (car (car doc)))
(terpri)
@@ -287,7 +292,7 @@ Also extracts information about all meth
(terpri)
(terpri)
(let ((i 3)
- (prefix [ ":BEFORE" ":PRIMARY" ":AFTER" ] ))
+ (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
;; Loop over fanciful generics
(while (< i 6)
(let ((gm (aref (get generic 'eieio-method-tree) i)))
@@ -398,8 +403,9 @@ Optional argument HISTORYVAR is the vari
;;; Help system augmentation
;;
-(defun eieio-help-mode-augmentation-maybee (&optional ignored)
- "For buffers thrown into help mode, augment for eieio."
+(defun eieio-help-mode-augmentation-maybee (&rest unused)
+ "For buffers thrown into help mode, augment for eieio.
+Arguments UNUSED are not used."
;; Scan created buttons so far if we are in help mode.
(when (eq major-mode 'help-mode)
(save-excursion
@@ -434,7 +440,7 @@ Optional argument HISTORYVAR is the vari
(while (re-search-forward "^\\(Instance\\|Class\\) Allocated Slots:$" nil t)
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
- (while (re-search-forward ":\\(BEFORE\\|AFTER\\|PRIMARY\\)" nil t)
+ (while (re-search-forward ":\\(STATIC\\|BEFORE\\|AFTER\\|PRIMARY\\)" nil t)
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
@@ -515,7 +521,7 @@ expansion depth."
class
'speedbar-directory-face
depth)
- (speedbar-make-tag-line 'angle ? nil nil
+ (speedbar-make-tag-line 'angle ? nil nil
(symbol-name class)
'eieio-describe-class-sb
class
1.4 +22 -24 XEmacs/packages/xemacs-packages/eieio/eieio-speedbar.el
Index: eieio-speedbar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-speedbar.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio-speedbar.el 2002/08/09 21:54:35 1.3
+++ eieio-speedbar.el 2007/11/26 15:01:05 1.4
@@ -1,10 +1,10 @@
;;; eieio-speedbar.el -- Classes for managing speedbar displays.
;;;
-;; Copyright (C) 1999, 2000, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 1999, 2000, 2001, 2002, 2005, 2007 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-speedbar.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-speedbar.el,v 1.4 2007/11/26 15:01:05 michaels Exp $
;; Keywords: oop, tools
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,13 +18,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -101,22 +98,22 @@
;;; Support a way of adding generic object based modes into speedbar.
;;
-(defvar eieio-speedbar-key-map nil
- "A Generic object based speedbar display keymap.")
-
(defun eieio-speedbar-make-map ()
"Make the generic object based speedbar keymap."
- (setq eieio-speedbar-key-map (speedbar-make-specialized-keymap))
+ (let ((map (speedbar-make-specialized-keymap)))
- ;; General viewing things
- (define-key eieio-speedbar-key-map "\C-m" 'speedbar-edit-line)
- (define-key eieio-speedbar-key-map "+" 'speedbar-expand-line)
- (define-key eieio-speedbar-key-map "=" 'speedbar-expand-line)
- (define-key eieio-speedbar-key-map "-" 'speedbar-contract-line)
-
- ;; Some object based things
- (define-key eieio-speedbar-key-map "C" 'eieio-speedbar-customize-line)
- )
+ ;; General viewing things
+ (define-key map "\C-m" 'speedbar-edit-line)
+ (define-key map "+" 'speedbar-expand-line)
+ (define-key map "=" 'speedbar-expand-line)
+ (define-key map "-" 'speedbar-contract-line)
+
+ ;; Some object based things
+ (define-key map "C" 'eieio-speedbar-customize-line)
+ map))
+
+(defvar eieio-speedbar-key-map (eieio-speedbar-make-map)
+ "A Generic object based speedbar display keymap.")
(defvar eieio-speedbar-menu
'([ "Edit Object/Field" speedbar-edit-line t]
@@ -132,6 +129,7 @@
)
"Menu part in easymenu format used in speedbar while browsing objects.")
+;; Note to self: Fix this silly thing!
(defalias 'eieio-speedbar-customize-line 'speedbar-edit-line)
(defun eieio-speedbar-create (map-fn map-var menu-var modename fetcher)
@@ -168,7 +166,7 @@ MAP-FN, MAP-VAR, MENU-VAR, MODENAME, and
(speedbar-add-mode-functions-list
(list modename
'(speedbar-item-info . eieio-speedbar-item-info)
- '(speedbar-line-path . eieio-speedbar-line-path))))
+ '(speedbar-line-directory . eieio-speedbar-line-path))))
(defun eieio-speedbar-buttons (dir-or-object depth fetcher)
"Create buttons for the speedbar display.
@@ -384,7 +382,7 @@ Optional argument DEPTH is the current d
(progn
(beginning-of-line)
(when (looking-at "^\\([0-9]+\\):")
- (setq depth (string-to-int (match-string 1))))))
+ (setq depth (string-to-number (match-string 1))))))
(when depth
(while (and (not (object-p (speedbar-line-token)))
(> depth 0))
@@ -400,7 +398,7 @@ Optional DEPTH is the depth we start at.
(progn
(beginning-of-line)
(looking-at "^\\([0-9]+\\):")
- (setq depth (string-to-int (match-string 1)))))
+ (setq depth (string-to-number (match-string 1)))))
;; This whole function is presently bogus. Make it better later.
(let ((tok (eieio-speedbar-find-nearest-object depth)))
(if (object-p tok)
1.4 +139 -82 XEmacs/packages/xemacs-packages/eieio/eieio-tests.el
Index: eieio-tests.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio-tests.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio-tests.el 2002/08/09 21:54:35 1.3
+++ eieio-tests.el 2007/11/26 15:01:05 1.4
@@ -1,10 +1,10 @@
;;; eieio-tests.el -- eieio tests routines
;;;
-;; Copyright (C) 1999, 2000, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005, 2006 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio-tests.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio-tests.el,v 1.4 2007/11/26 15:01:05 michaels Exp $
;; Keywords: oop, lisp, tools
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,13 +18,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;
@@ -122,25 +119,71 @@
(error nil))
(error "Instantiation of an abstract class allowed."))
+;;; Generics (and the definition therof)
+;;
+(defun anormalfunction () "A plain function for error testing." nil)
+
+(if (condition-case nil
+ (defgeneric anormalfunction ()
+ "Attempt to turn it into a generic.")
+ (error nil))
+ (error "Generic function created over an existing function."))
+
+(defgeneric generic1 () "First generic function")
+
+(if (not (generic-p 'generic1))
+ (error "defgeneric did not make a generic method."))
+
+(defmethod generic1 ((c class-a))
+ "Method on generic1.")
+
;;; Class with a static method
;;
(defclass static-method-class ()
((some-slot :initform nil
:allocation :class
:documentation "A slot."))
-:documentation "A class used for testing static methods."
-:abstract t)
+:documentation "A class used for testing static methods.")
-(defmethod static-method-class-method :STATIC ((c static-method-class))
+(defmethod static-method-class-method :STATIC ((c static-method-class) value)
"Test static methods.
Argument C is the class bound to this static method."
- (oset-default c some-slot t))
+ (if (object-p c) (setq c (object-class c)))
+ (oset-default c some-slot value))
+
+(condition-case nil
+ (static-method-class-method static-method-class 'class)
+ (error (error "Failed to call static method on a class.")))
+(if (not (eq (oref static-method-class some-slot) 'class))
+ (error "Call to static method on a class did not run."))
+
+(condition-case nil
+ (static-method-class-method (static-method-class "test") 'object)
+ (error (error "Failed to call static method on an object.")))
+(if (not (eq (oref static-method-class some-slot) 'object))
+ (error "Call to static method on an object did not run."))
+
+(defclass static-method-class-2 (static-method-class)
+ ()
+ "A second class after the previous for static methods.")
+
+(defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
+ "Test static methods.
+Argument C is the class bound to this static method."
+ (if (object-p c) (setq c (object-class c)))
+ (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
+
+(condition-case nil
+ (static-method-class-method static-method-class-2 'class)
+ (error (error "Failed to call 2nd static method on a class.")))
+(if (not (eq (oref static-method-class-2 some-slot) 'moose-class))
+ (error "Call to 2nd static method on a class did not run."))
(condition-case nil
- (static-method-class-method static-method-class)
- (error (error "Failed to call static method.")))
-(if (not (eq (oref static-method-class some-slot) t))
- (error "Call to static method did not run."))
+ (static-method-class-method (static-method-class-2 "test") 'object)
+ (error (error "Failed to call 2nd static method on an object.")))
+(if (not (eq (oref static-method-class-2 some-slot) 'moose-object))
+ (error "Call to 2nd static method on an object did not run."))
;;; Perform method testing
@@ -219,7 +262,8 @@ METHOD is the method that was attempting
(defmethod class-fun2 ((b class-b))
"More fun with class B."
- (error "Class B fun2 should not be called"))
+ (error "Class B fun2 should not be called")
+ )
(defmethod class-fun2 ((ab class-ab))
"More fun with class AB."
@@ -249,72 +293,36 @@ METHOD is the method that was attempting
;;; Test the BEFORE, PRIMARY, and AFTER method tags.
;;
-(defvar class-fun-tag-state nil)
-
-(defmethod class-fun-tag :PRIMARY ((a class-a))
- "Tagging fun primary A."
- (message ":PRIMARY method")
- (unless (eq class-fun-tag-state 'before-generic)
- (error "BEFORE generic not called before PRIMARY method (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'primary-method)
- (call-next-method))
-
-(defmethod class-fun-tag :BEFORE ((a class-a))
- "Tagging fun before A."
- (message ":BEFORE method")
- (unless (eq class-fun-tag-state nil)
- (error "BEFORE method not called first (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'before-method)
- (call-next-method))
+(load-library "eieio-test-methodinvoke.el")
-(defmethod class-fun-tag :AFTER ((a class-a))
- "Tagging fun after A."
- (message ":AFTER method")
- (unless (eq class-fun-tag-state 'primary-generic)
- (error "PRIMARY generic not called before AFTER method (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'after-method)
- (call-next-method))
+;;; Test value of a generic function call
+;;
+(defvar class-fun-value-seq '())
-(defmethod class-fun-tag :PRIMARY (a)
- "Generic untyped primary for A."
- (message ":PRIMARY generic")
- (unless (eq class-fun-tag-state 'primary-method)
- (error "PRIMARY generic not called after PRIMARY method (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'primary-generic))
-
-(defmethod class-fun-tag :BEFORE (a)
- "Generic untyped before for A."
- (message ":BEFORE generic")
- (unless (eq class-fun-tag-state 'before-method)
- (error "BEFORE generic not called after BEFORE method (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'before-generic))
-
-(defmethod class-fun-tag :AFTER (a)
- "Generic untyped after for A."
- (message ":AFTER generic")
- (unless (eq class-fun-tag-state 'after-method)
- (error "AFTER generic not called after AFTER method (%s)"
- class-fun-tag-state))
- (setq class-fun-tag-state 'after-generic))
+(defmethod class-fun-value :BEFORE ((a class-a))
+ "Return `before', and push `before' in `class-fun-value-seq'."
+ (push 'before class-fun-value-seq)
+ 'before)
+
+(defmethod class-fun-value :PRIMARY ((a class-a))
+ "Return `primary', and push `primary' in `class-fun-value-seq'."
+ (push 'primary class-fun-value-seq)
+ 'primary)
+
+(defmethod class-fun-value :AFTER ((a class-a))
+ "Return `after', and push `after' in `class-fun-value-seq'."
+ (push 'after class-fun-value-seq)
+ 'after)
+
+(let* ((class-fun-value-seq nil)
+ (value (class-fun-value a)))
+ (unless (eq value 'primary)
+ (error
+ "Value of the generic function call isn't the primary method value [%S]."
+ value))
+ (unless (equal class-fun-value-seq '(after primary before))
+ (error "Methods were not called from :BEFORE to :AFTER.")))
-(let ((class-fun-tag-state nil))
- (condition-case er
- (progn
- (class-fun-tag a)
- (unless (eq class-fun-tag-state 'after-generic)
- (error "AFTER generic not called last. (%s)"
- class-fun-tag-state))
- )
- (error
- (if (eq (car er) 'error)
- (error (car (cdr er)))
- (error "%S" er)))))
-
;;; Test initialization methods
;;
@@ -530,6 +538,16 @@ METHOD is the method that was attempting
:group vorlon
:accessor get-slot-2
:protection :private)
+ (slot-3 :initarg :emu
+ :initform emu
+ :type symbol
+ :allocation :class
+ :documentation "Third slot test class allocated accessor"
+ :custom symbol
+ :label "Fuzz"
+ :group tokra
+ :accessor get-slot-3
+ :protection :private)
)
(:custom-groups (foo))
"A class for testing slot arguments."
@@ -557,8 +575,29 @@ METHOD is the method that was attempting
(error "A string was set on a symbol slot during init."))
(invalid-slot-type nil))
+(if (not (eq (get-slot-3 t1) 'emu))
+ (error "Accessor to private :class slot returned bad value from object."))
+
+(if (not (eq (get-slot-3 class-c) 'emu))
+ (error "Accessor to private :class slot returned bad value from class."))
+
+(setf (get-slot-3 t1) 'moose)
+(if (not (eq (get-slot-3 t1) 'moose))
+ (error "setf and get through accessor failed!"))
+
;; Slot protection
-(defclass prot-1 ()
+(defclass prot-0 ()
+ ()
+ "Protection testing baseclass.")
+
+(defmethod prot0-slot-2 ((s2 prot-0))
+ "Try to access slot-2 from this class which doesn't have it.
+The object S2 passed in will be of class prot-1, which does have
+the slot. This could be allowed, and currently is in EIEIO.
+Needed by the eieio persistant base class."
+ (oref s2 slot-2))
+
+(defclass prot-1 (prot-0)
((slot-1 :initarg :slot-1
:initform nil
:protection :public)
@@ -618,6 +657,9 @@ Do not override for `prot-2'."
(condition-case nil
(prot1-slot-2 p2)
(error (error "Error accessing protected slot in a subclass method.")))
+(condition-case nil
+ (prot0-slot-2 p1)
+ (error (error "Error accessing protected slot from parent class method.")))
(condition-case nil
(progn
@@ -667,6 +709,18 @@ Do not override for `prot-2'."
(error "Instance inheritor: Level zero inheritance failed."))
(t t))
+;;; Test clone on boring objects too!
+;;
+(defvar CLONETEST1 nil)
+(defvar CLONETEST2 nil)
+;; A simple make instance with EIEIO extension
+(setq CLONETEST1 (make-instance 'class-a "a"))
+(setq CLONETEST2 (clone CLONETEST1))
+
+;; CLOS form of make-instance
+(setq CLONETEST1 (make-instance 'class-a))
+(setq CLONETEST2 (clone CLONETEST1))
+
;;; Test the persistent object, and object-write by side-effect.
;;
@@ -714,7 +768,10 @@ Do not override for `prot-2'."
(let ((obj1 (SINGLE "Moose"))
(obj2 (SINGLE "Cow")))
- (if (not (eq obj1 obj2))
+ (if (not (and (object-p obj1)
+ (object-p obj2)
+ (eq obj1 obj2)
+ (oref obj1 a-slot)))
(error "Two instances of a singleton")))
1.4 +257 -168 XEmacs/packages/xemacs-packages/eieio/eieio.el
Index: eieio.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio.el 2002/08/09 21:54:35 1.3
+++ eieio.el 2007/11/26 15:01:06 1.4
@@ -2,12 +2,12 @@
;; or maybe Eric's Implementation of Emacs Intrepreted Objects
;;;
-;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 95,96,98,99,2000,01,02,03,04,05,06,07 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
-;; RCS: $Id: eieio.el,v 1.3 2002/08/09 21:54:35 youngs Exp $
+;; RCS: $Id: eieio.el,v 1.4 2007/11/26 15:01:06 michaels Exp $
;; Keywords: OO, lisp
-(defvar eieio-version "0.17"
+(defvar eieio-version "1.0"
"Current version of EIEIO.")
;;
;; This program is free software; you can redistribute it and/or modify
@@ -21,13 +21,10 @@
;; 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:
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
-;; The Free Software Foundation, Inc.
-;; 675 Mass Ave.
-;; Cambridge, MA 02139, USA.
-;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; Commentary:
@@ -50,6 +47,11 @@
(interactive)
(message eieio-version))
+(require 'inversion)
+
+;;;###autoload immediate
+(autoload 'eieio-defclass "eieio")
+
(defun eieio-require-version (major minor &optional beta)
"Non-nil if this version of EIEIO does not satisfy a specific version.
Arguments can be:
@@ -62,18 +64,9 @@ excluded if a released version is requir
It is assumed that if the current version is newer than that specified,
everything passes. Exceptions occur when known incompatibilities are
introduced."
- (when (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\( ?beta ?\\([0-9]+\\)\\)?"
- eieio-version)
- (let ((vmajor (string-to-int (match-string 1 eieio-version)))
- (vminor (string-to-int (match-string 2 eieio-version)))
- (vbeta (match-string 4 eieio-version)))
- (when vbeta (setq vbeta (string-to-int vbeta)))
- (or (> major vmajor)
- (and (= major vmajor) (> minor vminor))
- (and (= major vmajor) (= minor vminor)
- (or (and (not beta) vbeta)
- (and beta vbeta (> beta vbeta)))))
- )))
+ (inversion-test 'eieio
+ (format "%s.%s%s" major minor
+ (if beta (format "beta%s" beta) ""))))
(eval-and-compile
;; Abount the above. EIEIO must process it's own code when it compiles
@@ -310,8 +303,6 @@ OPTIONS-AND-DOC as the toplevel document
;; or add definitions when eieio is loaded or something like that.
(run-hooks 'eieio-hook)
(setq eieio-hook nil)
- ;; If no cl, put that sucker back into the hook-list.
- (if (not (featurep 'cl)) (add-hook 'eieio-hook 'eieio-cl-run-defsetf))
(if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
(if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses)))
@@ -522,22 +513,19 @@ OPTIONS-AND-DOC as the toplevel document
(if acces
(progn
(eieio-defmethod acces
- (list (list (list 'this cname))
+ (list (if (eq alloc :class) :STATIC :PRIMARY)
+ (list (list 'this cname))
(format
"Retrieves the slot `%s' from an object of class `%s'"
name cname)
(list 'eieio-oref 'this (list 'quote name))))
- ;; It turns out that using the setf macro with a
- ;; generic method form is impossible because almost
- ;; any type of form could be created for disparaging
- ;; objects. Yuck! Therefore, we shouldn't try to make
- ;; setf calls to accessors.
- ;; Create a setf definition for this accessor.
- ;;(eieio-cl-defsetf acces '(widget)
- ;; '(store)
- ;; (list 'eieio-oset 'widget
- ;; (list 'quote cname)
- ;; 'store))
+ ;; Thanks Pascal Bourguignon <pjb at informatimago.com>
+ ;; For this complex macro.
+ (eval (macroexpand
+ (list 'defsetf acces '(widget) '(store)
+ (list 'list ''eieio-oset 'widget
+ (list 'quote (list 'quote name)) 'store))))
+ ;;`(defsetf ,acces (widget) (store) (eieio-oset widget ',cname store))
)
)
;; If a writer is defined, then create a generic method of that
@@ -718,7 +706,8 @@ if default value is nil."
(num (- (length ca) (length np)))
(dp (if np (nthcdr num (aref newc class-public-d))
nil))
- (tp (if np (nth num (aref newc class-public-type)))))
+ (tp (if np (nth num (aref newc class-public-type))))
+ )
(if (not np)
(error "Eieio internal error overriding default value for %s"
a)
@@ -731,6 +720,18 @@ if default value is nil."
;; If we have a repeat, only update the initarg...
(eieio-perform-slot-validation-for-default a tp d skipnil)
(setcar dp d)
+ ;; If we have a new initarg, check for it.
+ (when init
+ (let* ((inits (aref newc class-initarg-tuples))
+ (inita (rassq a inits)))
+ ;; Replace the CAR of the associate INITA.
+ ;;(message "Initarg: %S replace %s" inita init)
+ (setcar inita init)
+ ))
+ ;; TODO:
+ ;; For other slots (protection, etc) we should get the
+ ;; original value, and make sure each is equal to the
+ ;; last value and throw an error, or accept it.
)))))
(let ((value (eieio-default-eval-maybe d)))
(if (not (member a (aref newc class-class-allocation-a)))
@@ -771,7 +772,8 @@ if default value is nil."
type tp a)))
;; If we have a repeat, only update the vlaue...
(eieio-perform-slot-validation-for-default a tp value skipnil)
- (setcar dp value)))))))
+ (setcar dp value))
+ )))))
))
(defun eieio-copy-parents-into-subclass (newc parents)
@@ -853,7 +855,10 @@ the shortcut (make-instance foo) will wo
is more robust."
(if (and (car initargs) (stringp (car initargs)))
(apply (class-constructor class) initargs)
- (apply (class-constructor class) class initargs)))
+ (apply (class-constructor class)
+ (cond ((symbolp class) (symbol-name class))
+ (t (format "%S" class)))
+ initargs)))
;;; CLOS methods and generics
@@ -878,12 +883,31 @@ DOC-STRING is the documentation attached
(defun eieio-defgeneric (method doc-string)
"Engine part to `defgeneric' macro defining METHOD with DOC-STRING."
- (let ((lambda-form (eieio-defgeneric-form method doc-string)))
- (if (and (fboundp method) (not (generic-p method)))
- (error "You cannot create a generic/method over an existing symbol"))
- (fset method lambda-form)
+ (if (and (fboundp method) (not (generic-p method))
+ (or (byte-code-function-p (symbol-function method))
+ (not (eq 'autoload (car (symbol-function method)))))
+ )
+ (error "You cannot create a generic/method over an existing symbol: %s"
+ method))
+ ;; Don't do this over and over.
+ (unless (fboundp 'method)
+ ;; This defun tells emacs where the first definition of this
+ ;; method is defined.
+ `(defun ,method nil)
+ ;; Apply the actual body of this function.
+ (fset method (eieio-defgeneric-form method doc-string))
+ ;; Make sure the method tables are installed.
+ (eieiomt-install method)
+ ;; Return the method
'method))
+(defun eieio-unbind-method-implementations (method)
+ "Make the generic method METHOD have no implementations..
+It will leave the original generic function in place, but remove
+reference to all implementations of METHOD."
+ (put method 'eieio-method-tree nil)
+ (put method 'eieio-method-obarray nil))
+
(defmacro defmethod (method &rest args)
"Create a new METHOD through `defgeneric' with ARGS.
ARGS lists any keys (such as :BEFORE, :PRIMARY, :AFTER, or :STATIC),
@@ -922,10 +946,10 @@ the arglst, and doc string, and eventual
argfix))
(setq loopa (cdr loopa)))
;; make sure there is a generic
- (if (not (fboundp method))
- (eieio-defgeneric method
- (if (stringp (car body))
- (car body) (format "Generically created method `%s'" method))))
+ (eieio-defgeneric
+ method
+ (if (stringp (car body))
+ (car body) (format "Generically created method `%s'" method)))
;; create symbol for property to bind to. If the first arg is of
;; the form (varname vartype) and `vartype' is a class, then
;; that class will be the type symbol. If not, then it will fall
@@ -1014,7 +1038,7 @@ created by the :initarg tag."
(if (not (symbolp field))
(signal 'wrong-type-argument (list 'symbolp field)))
(let* ((class (if (class-p obj) obj (aref obj object-class)))
- (c (eieio-field-name-index class field)))
+ (c (eieio-field-name-index class obj field)))
(if (not c)
;; It might be missing because it is a :class allocated field.
;; Lets check that info out.
@@ -1064,7 +1088,7 @@ Fills in OBJ's FIELD with it's default v
(if (not (or (object-p obj) (class-p obj))) (signal 'wrong-type-argument (list 'object-p obj)))
(if (not (symbolp field)) (signal 'wrong-type-argument (list 'symbolp field)))
(let* ((cl (if (object-p obj) (aref obj object-class) obj))
- (c (eieio-field-name-index cl field)))
+ (c (eieio-field-name-index cl obj field)))
(if (not c)
;; It might be missing because it is a :class allocated field.
;; Lets check that info out.
@@ -1109,7 +1133,7 @@ with in the :initarg slot. VALUE can be
Fills in OBJ's FIELD with VALUE."
(if (not (object-p obj)) (signal 'wrong-type-argument (list 'object-p obj)))
(if (not (symbolp field)) (signal 'wrong-type-argument (list 'symbolp field)))
- (let ((c (eieio-field-name-index (object-class-fast obj) field)))
+ (let ((c (eieio-field-name-index (object-class-fast obj) obj field)))
(if (not c)
;; It might be missing because it is a :class allocated field.
;; Lets check that info out.
@@ -1141,7 +1165,7 @@ Fills in the default value in CLASS' in
(if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class)))
(if (not (symbolp field)) (signal 'wrong-type-argument (list 'symbolp field)))
(let* ((scoped-class class)
- (c (eieio-field-name-index class field)))
+ (c (eieio-field-name-index class nil field)))
(if (not c)
;; It might be missing because it is a :class allocated field.
;; Lets check that info out.
@@ -1409,10 +1433,13 @@ so that we can protect private slots."
(setq par (cdr par)))
ret)))
-(defun eieio-field-name-index (class field)
- "In CLASS find the index of the named FIELD.
+(defun eieio-field-name-index (class obj field)
+ "In CLASS for OBJ find the index of the named FIELD.
The field is a symbol which is installed in CLASS by the `defclass'
-call. If FIELD is the value created with :initarg instead,
+call. OBJ can be nil, but if it is an object, and the slot in question
+is protected, access will be allowed if obj is a child of the currently
+`scoped-class'.
+If FIELD is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
(let* ((fsym (intern-soft (symbol-name field)
@@ -1424,7 +1451,10 @@ reverse-lookup that name, and recurse wi
((not (get fsym 'protection))
(+ 3 fsi))
((and (eq (get fsym 'protection) 'protected)
- (and scoped-class (child-of-class-p class scoped-class)))
+ scoped-class
+ (or (child-of-class-p class scoped-class)
+ (and (object-p obj)
+ (child-of-class-p class (object-class obj)))))
(+ 3 fsi))
((and (eq (get fsym 'protection) 'private)
(or (and scoped-class
@@ -1433,7 +1463,7 @@ reverse-lookup that name, and recurse wi
(+ 3 fsi))
(t nil))
(let ((fn (eieio-initarg-to-attribute class field)))
- (if fn (eieio-field-name-index class fn) nil)))))
+ (if fn (eieio-field-name-index class obj fn) nil)))))
(defun eieio-class-field-name-index (class field)
"In CLASS find the index of the named FIELD.
@@ -1459,6 +1489,10 @@ reverse-lookup that name, and recurse wi
(defvar eieio-generic-call-key nil
"When using `call-next-method', provides a context for the current key.
Keys are a number representing :BEFORE, :PRIMARY, and :AFTER methods.")
+(defvar eieio-generic-call-next-method-list nil
+ "When executing a PRIMARY or STATIC method, track the 'next-method'.
+During executions, the list is first generated, then as each next method
+is called, the next method is popped off the stack.")
(defun eieio-generic-call (method args)
"Call METHOD with ARGS.
@@ -1467,17 +1501,29 @@ This should only be called from a generi
;; We must expand our arguments first as they are always
;; passed in as quoted symbols
(let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil)
- (static nil)
(eieio-generic-call-methodname method)
- (eieio-generic-call-arglst args))
+ (eieio-generic-call-arglst args)
+ (firstarg nil)
+ (primarymethodlist nil))
;; get a copy
- (setq newargs args)
+ (setq newargs args
+ firstarg (car newargs))
+ ;; Is the class passed in autoloaded?
+ ;; Since class names are also constructors, they can be autoloaded
+ ;; via the autoload command. Check for this, and load them in.
+ ;; It's ok if it doesn't turn out to be a class. Probably want that
+ ;; function loaded anyway.
+ (if (and (symbolp firstarg)
+ (fboundp firstarg)
+ (listp (symbol-function firstarg))
+ (eq 'autoload (car (symbol-function firstarg))))
+ (load (nth 1 (symbol-function firstarg))))
;; lookup the forms to use
- (cond ((object-p (car newargs))
- (setq mclass (object-class-fast (car newargs))))
- ((class-p (car newargs))
- (setq mclass (car newargs)
- static t)))
+ (cond ((object-p firstarg)
+ (setq mclass (object-class-fast firstarg)))
+ ((class-p firstarg)
+ (setq mclass firstarg
+ )))
;; Now create a list in reverse order of all the calls we have
;; make in order to successfully do this right. Rules:
;; 1) Only call generics if scoped-class is not defined
@@ -1485,62 +1531,115 @@ This should only be called from a generi
;; 2) Only call static if this is a static method.
;; 3) Only call specifics if the definition allows for them.
;; 4) Call in order based on :BEFORE, :PRIMARY, and :AFTER
- (if static
- (progn
- (setq tlambdas
- (eieio-generic-form method method-static mclass))
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-static keys))
- )
-
+ (when (object-p firstarg)
;; Non-static calls do all this stuff.
+
+ ;; :AFTER methods
(setq tlambdas
- (or (and mclass (eieio-generic-form method method-after mclass))
- (eieio-generic-form method method-after nil)))
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-after keys))
+ (if mclass
+ (eieiomt-method-list method method-after mclass)
+ (list (eieio-generic-form method method-after nil)))
+ ;;(or (and mclass (eieio-generic-form method method-after mclass))
+ ;; (eieio-generic-form method method-after nil))
+ )
+ (setq lambdas (append tlambdas lambdas)
+ keys (append (make-list (length tlambdas) method-after) keys))
+ ;; :PRIMARY methods
(setq tlambdas
(or (and mclass (eieio-generic-form method method-primary mclass))
(eieio-generic-form method method-primary nil)))
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-primary keys))
+ (when tlambdas
+ (setq lambdas (cons tlambdas lambdas)
+ keys (cons method-primary keys)
+ primarymethodlist
+ (eieiomt-method-list method method-primary mclass)))
+ ;; :BEFORE methods
(setq tlambdas
- (or (and mclass (eieio-generic-form method method-before mclass))
- (eieio-generic-form method method-before nil)))
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-before keys))
+ (if mclass
+ (eieiomt-method-list method method-before mclass)
+ (list (eieio-generic-form method method-before nil)))
+ ;;(or (and mclass (eieio-generic-form method method-before mclass))
+ ;; (eieio-generic-form method method-before nil))
+ )
+ (setq lambdas (append tlambdas lambdas)
+ keys (append (make-list (length tlambdas) method-before) keys))
)
+
+ ;; If there were no methods found, then there could be :STATIC methods.
+ (when (not lambdas)
+ (setq tlambdas
+ (eieio-generic-form method method-static mclass))
+ (setq lambdas (cons tlambdas lambdas)
+ keys (cons method-static keys)
+ primarymethodlist ;; Re-use even with bad name here
+ (eieiomt-method-list method method-static mclass)))
+
;; Now loop through all occurances forms which we must execute
- ;; (which are happilly sorted now) and execute them all!
- (let ((rval nil) (found nil))
+ ;; (which are happily sorted now) and execute them all!
+ (let ((rval nil) (lastval nil) (rvalever nil) (found nil))
(while lambdas
(if (car lambdas)
- (let ((scoped-class (cdr (car lambdas)))
- (eieio-generic-call-key (car keys)))
+ (let* ((scoped-class (cdr (car lambdas)))
+ (eieio-generic-call-key (car keys))
+ (has-return-val
+ (or (= eieio-generic-call-key method-primary)
+ (= eieio-generic-call-key method-static)))
+ (eieio-generic-call-next-method-list
+ ;; Use the cdr, as the first element is the fcn
+ ;; we are calling right now.
+ (when has-return-val (cdr primarymethodlist)))
+ )
(setq found t)
- (setq rval (apply (car (car lambdas)) newargs))))
+ ;;(setq rval (apply (car (car lambdas)) newargs))
+ (setq lastval (apply (car (car lambdas)) newargs))
+ (when has-return-val
+ (setq rval lastval
+ rvalever t))
+ ))
(setq lambdas (cdr lambdas)
keys (cdr keys)))
(if (not found)
(if (object-p (car args))
- (setq rval (no-applicable-method (car args) method))
+ (setq rval (no-applicable-method (car args) method)
+ rvalever t)
(signal
'no-method-definition
(list method args))))
+ ;; Right Here... it could be that lastval is returned when
+ ;; rvalever is nil. Is that right?
rval)))
+(defun eieiomt-method-list (method key class)
+ "Return an alist list of methods lambdas.
+METHOD is the method name.
+KEY represents either :BEFORE, or :AFTER methods.
+CLASS is the starting class to search from in the method tree."
+ (let ((lambdas nil)
+ (mclass (list class)))
+ (while mclass
+ (when (car mclass)
+ ;; lookup the form to use for the PRIMARY object for the next level
+ (let ((tmpl (eieio-generic-form method key (car mclass))))
+ (when (or (not lambdas)
+ ;; This prevents duplicates coming out of the
+ ;; class method optimizer. Perhaps we should
+ ;; just not optimize before/afters?
+ (not (eq (car tmpl) (car (car lambdas)))))
+ (setq lambdas (cons tmpl lambdas))
+ (if (null (car lambdas))
+ (setq lambdas (cdr lambdas))))))
+ ;; Add new classes to mclass
+ (setq mclass (append (cdr mclass) (eieiomt-next (car mclass))))
+ )
+ (if (eq key method-after)
+ lambdas
+ (nreverse lambdas))))
+
(defun next-method-p ()
"Return a list of lambdas which qualify as the `next-method'."
- (let ((lambdas nil)
- (mclass (eieiomt-next scoped-class)))
- (while (and (not lambdas) mclass)
- ;; lookup the form to use for the PRIMARY object for the next level
- (setq lambdas (eieio-generic-form eieio-generic-call-methodname
- eieio-generic-call-key (car mclass))
- mclass (cdr mclass)))
- (if lambdas t nil)))
+ eieio-generic-call-next-method-list)
(defun call-next-method (&rest replacement-args)
"Call the next logical method from another method.
@@ -1550,31 +1649,23 @@ use them instead of `eieio-generic-call-
are the arguments passed in at the top level."
(if (not scoped-class)
(error "Call-next-method not called within a class specific method"))
+ (if (and (/= eieio-generic-call-key method-primary)
+ (/= eieio-generic-call-key method-static))
+ (error "Cannot `call-next-method' except in :PRIMARY or :STATIC methods")
+ )
(let ((newargs (or replacement-args eieio-generic-call-arglst))
- (lambdas nil)
- (mclass (eieiomt-next scoped-class))
- (callsomething nil)
- (returnval nil))
- (while (and mclass (not callsomething))
- ;; lookup the form to use for the PRIMARY object for the next level
- (setq lambdas (eieio-generic-form eieio-generic-call-methodname
- eieio-generic-call-key (car mclass)))
- (if lambdas
- ;; Setup calling environment, and apply arguments...
- (let ((scoped-class (cdr lambdas)))
- (setq callsomething t)
- (setq returnval (apply (car lambdas) newargs))))
- (setq mclass (cdr mclass)))
- (if (not callsomething)
- (progn
- (setq lambdas (eieio-generic-form eieio-generic-call-methodname
- eieio-generic-call-key nil))
- (if lambdas
- (let ((scoped-class nil))
- (apply (car lambdas) newargs))
- (no-next-method (car newargs))))
- returnval)))
-
+ (next (car eieio-generic-call-next-method-list))
+ (returnval nil)
+ )
+ (if (or (not next) (not (car next)))
+ (no-next-method (car newargs))
+ (let* ((eieio-generic-call-next-method-list
+ (cdr eieio-generic-call-next-method-list))
+ (scoped-class (cdr next))
+ (fcn (car next))
+ )
+ (apply fcn newargs)
+ ))))
;;;
;; eieio-method-tree : eieiomt-
@@ -1598,6 +1689,23 @@ are the arguments passed in at the top l
(defvar eieiomt-optimizing-obarray nil
"While mapping atoms, this contain the obarray being optimized.")
+(defun eieiomt-install (method-name)
+ "Install the method tree, and obarray onto METHOD-NAME.
+Do not do the work if they already exist."
+ (let ((emtv (get method-name 'eieio-method-tree))
+ (emto (get method-name 'eieio-method-obarray)))
+ (if (or (not emtv) (not emto))
+ (progn
+ (setq emtv (put method-name 'eieio-method-tree
+ (make-vector method-num-fields nil))
+ emto (put method-name 'eieio-method-obarray
+ (make-vector method-num-fields nil)))
+ (aset emto 0 (make-vector 11 0))
+ (aset emto 1 (make-vector 11 0))
+ (aset emto 2 (make-vector 41 0))
+ (aset emto 3 (make-vector 11 0))
+ ))))
+
(defun eieiomt-add (method-name method key class)
"Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS.
METHOD-NAME is the name created by a call to `defgeneric'.
@@ -1610,17 +1718,9 @@ CLASS is the class this method is associ
(error "Eieiomt-add: method key error!"))
(let ((emtv (get method-name 'eieio-method-tree))
(emto (get method-name 'eieio-method-obarray)))
+ ;; Make sure the method tables are available.
(if (or (not emtv) (not emto))
- (progn
- (setq emtv (put method-name 'eieio-method-tree
- (make-vector method-num-fields nil))
- emto (put method-name 'eieio-method-obarray
- (make-vector method-num-fields nil)))
- (aset emto 0 (make-vector 11 0))
- (aset emto 1 (make-vector 11 0))
- (aset emto 2 (make-vector 41 0))
- (aset emto 3 (make-vector 11 0))
- ))
+ (error "Programmer error: eieiomt-add"))
;; only add new cells on if it doesn't already exist!
(if (assq class (aref emtv key))
(setcdr (assq class (aref emtv key)) method)
@@ -1637,16 +1737,6 @@ CLASS is the class this method is associ
(mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray)))
))
-(defun eieiomt-get (method-name key class)
- "Get the implementation for METHOD-NAME for int KEY matching CLASS.
-See `eieiomt-add' for details on how these are set."
- (if (>= key method-num-fields) (< key 0)
- (error "eieiomt-get: method key error!"))
- (let ((emto (get method-name 'eieio-method-obarray)))
- (if (not emto)
- nil
- (intern-soft (symbol-name class) (aref emto key)))))
-
(defun eieiomt-next (class)
"Return the next parent class for CLASS.
If CLASS is a superclass, return variable `eieio-default-superclass'. If CLASS
@@ -1792,30 +1882,21 @@ This is usually a symbol that starts wit
;;; Here are some CLOS items that need the CL package
;;
-(defun eieio-cl-run-defsetf ()
- "Execute many `defsetf's when the 'cl package is loaded."
- (if (featurep 'cl)
- (progn
- (defsetf slot-value (obj field) (store)
- (list 'eieio-oset obj field store))
- (defsetf eieio-oref (obj field) (store)
- (list 'eieio-oset obj field store))
- ;; The below setf method was written by
- ;; Arnd Kohrs <kohrs at acm.org>
- (define-setf-method oref (obj field)
- (let ((obj-temp (gensym))
- (field-temp (gensym))
- (store-temp (gensym)))
- (list (list obj-temp field-temp)
- (list obj `(quote ,field))
- (list store-temp)
- (list 'set-slot-value obj-temp field-temp
- store-temp)
- (list 'slot-value obj-temp field-temp))))
- ))
- )
+
+(defsetf slot-value (obj field) (store) (list 'eieio-oset obj field store))
+(defsetf eieio-oref (obj field) (store) (list 'eieio-oset obj field store))
-(add-hook 'eieio-hook 'eieio-cl-run-defsetf)
+;; The below setf method was written by Arnd Kohrs <kohrs at acm.org>
+(define-setf-method oref (obj field)
+ (let ((obj-temp (gensym))
+ (field-temp (gensym))
+ (store-temp (gensym)))
+ (list (list obj-temp field-temp)
+ (list obj `(quote ,field))
+ (list store-temp)
+ (list 'set-slot-value obj-temp field-temp
+ store-temp)
+ (list 'slot-value obj-temp field-temp))))
;;;
@@ -1944,7 +2025,7 @@ sure to call `call-next-method' first an
(if (not passname)
(save-match-data
(if (string-match "-\\([0-9]+\\)" nm)
- (setq num (1+ (string-to-int (match-string 1 nm)))
+ (setq num (1+ (string-to-number (match-string 1 nm)))
nm (substring nm 0 (match-beginning 0))))
(aset nobj object-name (concat nm "-" (int-to-string num))))
(aset nobj object-name (car params)))
@@ -1977,7 +2058,7 @@ This writes out the vector version of th
object are discouraged from being written.
If optional COMMENT is non-nil, include comments when outputting
this object."
- (if (not comment) nil
+ (when comment
(princ ";; Object ")
(princ (object-name-string this))
(princ "\n")
@@ -2007,8 +2088,7 @@ this object."
(princ (make-string (* eieio-print-depth 2) ? ))
(princ (symbol-name i))
(princ " ")
- (let ((o (eieio-oref this (car publa))))
- (eieio-override-prin1 o))
+ (eieio-override-prin1 v)
(princ "\n"))))
(setq publa (cdr publa) publd (cdr publd)))
(princ (make-string (* eieio-print-depth 2) ? )))
@@ -2095,10 +2175,19 @@ Optional argument NOESCAPE is passed to
;; appeared as "#1 =" which was not useful. This allows
;; edebug to print my objects in the nice way they were
;; meant to with `object-print' and `class-name'
- (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string)
+ ;; (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string)
)
)
+(eval-after-load "cedet-edebug"
+ '(progn
+ (cedet-edebug-add-print-override '(class-p object) '(class-name object) )
+ (cedet-edebug-add-print-override '(object-p object) '(object-print object) )
+ (cedet-edebug-add-print-override '(and (listp object)
+ (or (class-p (car object)) (object-p (car object))))
+ '(cedet-edebug-prin1-recurse object) )
+ ))
+
;;; Interfacing with imenu in emacs lisp mode
;; (Only if the expression is defined)
;;
@@ -2139,7 +2228,7 @@ Optional argument NOESCAPE is passed to
(add-hook 'temp-buffer-show-hook 'eieio-help-mode-augmentation-maybee t)
(require 'advice)
(defadvice describe-variable (around eieio-describe activate)
- "Display the full documentation of VARIABLE (a symbol).
+ "Display the full documentation of FUNCTION (a symbol).
Returns the documentation as a string, also."
(if (class-p (ad-get-arg 0))
(eieio-describe-class (ad-get-arg 0))
1.4 +295 -7 XEmacs/packages/xemacs-packages/eieio/eieio.texi
Index: eieio.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/eieio.texi,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- eieio.texi 2002/08/09 21:54:35 1.3
+++ eieio.texi 2007/11/26 15:01:06 1.4
@@ -1,7 +1,14 @@
\input texinfo @c -*-texinfo-*-
@c
- at c $Id: eieio.texi,v 1.3 2002/08/09 21:54:35 youngs Exp $
+ at c $Id: eieio.texi,v 1.4 2007/11/26 15:01:06 michaels Exp $
@c
+
+ at c
+ at c THIS MANUAL NEEDS WORK:
+ at c
+ at c See the comments at the end of this document.
+ at c they need to be integrated into the text of this manual.
+ at c
@setfilename eieio.info
@settitle Enhanced Implementation of Emacs Interpreted Objects
@@ -17,7 +24,7 @@ END-INFO-DIR-ENTRY
@sp 10
@center @titlefont{eieio}
@vskip 0pt plus 1 fill
-Copyright @copyright{} 1995,1996,1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
+Copyright @copyright{} 1995,1996,1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Eric M. Ludlam
@end titlepage
@@ -53,9 +60,6 @@ wrong!
* Function Index::
@end menu
-As of this writing, updates can be found at:
- @uref{ftp://ftp.ultranet.com/pub/zappo}.
-
@node Introduction, CLOS compatibility, Top, Top
@comment node-name, next, previous, up
@chapter Introduction
@@ -122,6 +126,9 @@ highlighted in files not currently loade
read in, the lines are given the graphic properties.
Includes an MS Visual Studio like bookmark facility.
+ at item lmcompile
+Using linemark, highlight all lines where the latest compilation
+has valid hits.
@item tree
Draw a structured tree by building a series of embedded lists of
`tree-node' class objects. Includes the functions `eieio-class-tree' to
@@ -1143,10 +1150,10 @@ Class allocated slot @var{file-header-li
@code{object-write} as a header comment.
@end deftp
-All objects can write themselves to a file, bu persistent objects have
+All objects can write themselves to a file, but persistent objects have
several additional methods that aid in maintaining them.
- at defmethod eieio-persistent eieio-save obj &optional file
+ at defmethod eieio-persistent eieio-persistent-save obj &optional file
Write the object @var{obj} to its file.
If optional argument @var{file} is specified, use that file name
instead.
@@ -1483,3 +1490,284 @@ values, file distribution, and rmail dis
@contents
@bye
+
+ at ignore
+From: Richard Stallman <rms at gnu.org>
+To: zappo at gnu.org
+Subject: eieio manual
+Reply-to: rms at gnu.org
+Date: Mon, 26 Jul 2004 10:30:19 -0400
+
+I read the eieio manual, and while it was complete enough that
+I could mostly understand it, it needs a lot of work.
+
+The general problem is that parts are still to some extent written for
+people who know CLOS. It should be written entirely for a person who
+has never seen CLOS. It is ok to include compatibility notes
+describing differences from CLOS, as in the Emacs Lisp Reference
+Manual. These should come after, not before, the material
+described (consider section 1.2).
+
+It needs a lot of proofreading. Words are capitalized in
+mid-sentence. Symbols appear without @code. Variable names
+are in all caps, sometimes with @var and sometimes without.
+The name "Lisp" is written in lower case.
+
+The text uses nonstandard terminology such as "throw an error" and
+"must be quoted in". I can understand them, but this manual should
+use the normal Emacs terminology found in the Emacs Lisp Reference
+Manual.
+
+The topics should be ordered from most conceptually essential to
+least. For instance, the default ancestor class is a comparatively
+unimportant topic. Most users don't need to know about it. So put it
+near the end. Constructors are essential basic, so they should come
+earlier.
+
+The functions initialize-instance are rather unimportant details and
+should go near the end; however, I don't see that they relate to the
+default ancestor class, so grouping them under that heading does not seem
+right.
+
+The methods used in case of errors are also rather minor side
+issues, so they should go late in the manual. They belong with
+the new condition names. (The correct term is "condition names",
+not "signal types".)
+
+In general, the examples are not indented right, perhaps because they
+use tabs. You must not have tab characters in Texinfo.
+eieio-default-superclass has unmatched parens.
+
+Some specific points:
+
+There are two mysterious references to something called
+`lambda-default' that is not explained. I can't understand it.
+
+I am not sure how initializing slots with :initform relates to
+initializing slots with oset-default. That needs to be better explained.
+
+There seems to be a fundamental difference in usage between slots
+initialized using :initform and slots that are not initialized.
+This needs to be stated loud and clear in the explanation of defclass,
+before you get into the specific slot list attributes.
+
+The term "superclass" seems to be used in two inconsistent meanings.
+In defclass it is synonymous with "parent class" (this is the
+traditional meaning), but section 4 gives it a different meaning.
+Please choose another term for the latter meaning, such as "orphan
+class". This would mean renaming eieio-default-superclass.
+
+ Creates a new class called @code{class-name}. The created
+ variable's documentation string is set to a modified version of
+ the doc string found in @var{options-or-doc}.
+
+What is "the created variable"?
+
+ Every slot in
+ parent is replicated in the new class.
+
+Do you mean, "Every slot that appears in any parent class
+is replicated in the new class"?
+
+ The parent class for @code{class-name} is
+
+Shouldn't that be @var? That is not the only place.
+Also, it seems strange to speak of "the" parent class
+given that there can be more than one.
+
+ @var{slot-list} is a list of lists. Each sublist defines an attribute.
+ These lists are of the form @code{(name :tag1 value1 :tag2 value2 :tagn
+ valuen)}.
+
+All those parts that can vary need @var.
+
+ @item :initarg
+ The argument used during initialization. @xref{Making New Objects}.
+
+The node Making New Objects does not explain :initarg.
+
+ A lisp expression used to generate the default value for this slot.
+ If :initform is left out, that slot defaults to being unbound.
+ The value passed to initform is automatically quoted. Thus,
+ @example
+:initform (1 2 3)
+
+(1 2 3) is not a valid Lisp expression: evaluating it would get an
+error. Do you mean "a Lisp object"?
+
+ A function like this:
+ @example
+:initform +
+ @end example
+ is quoted in as a symbol.
+
+That is really confusing. What does "a function like this" refer to?
+
+ "Default class used as parent class for superclasses. It's
+ slots are automatically adopted by such superclasses but not stored
+
+The possessive of "it" is "its". In English, the possessive pronouns
+have no apostrophe. My, our, your, his, her, their, its.
+
+ When creating an object of any type, you can use it's constructor, or
+ @code{make-instance}.
+
+Same problem. Please check every occurrence of "it's".
+
+Also, you need to explain what a constructor is. Otherwise, this is
+completely confusing to a reader who does not know. The manual does
+not explain "constructor" anywhere. When it describes how to use
+constructors, it does not use that term.
+
+ @defun initialize-instance obj &rest slots
+ Initialize @var{obj}. Sets slots of @var{obj} with @var{slots} which
+ is a list of name/value pairs. These are actually just passed to
+ @code{shared-initialize}.
+ @end defun
+
+ @defun shared-initialize obj &rest slots
+ Sets slots of @var{obj} with @var{slots} which is a list of name/value
+ pairs.
+ @end defun
+
+It needs to say when the programmer should call initialize-instance
+and when person should call shared-initialize.
+
+ @defun clone obj &rest params
+ Make a deep copy of @var{obj}.
+
+"Deep copy" is not defined Emacs terminology, so it needs a precise
+definition. I have a general idea what you probably mean, but I
+cannot be sure of details. Does this copy cons cells? Does it copy
+vectors? Does it copy hash tables? Does it copy symbols? The manual
+must say.
+
+ @defun object-print obj &rest strings
+ Construct a printing lisp symbol for @var{OBJ}.
+
+Should that be @var{obj}?
+
+ Once we have defined our classes, it's time to create objects with the
+ specified structure. After we call @code{defclass} two new functions
+ are created, one of which is @code{classname}.
+
+I don't think there is a function named `classname'. The eieio sources
+do not define one. Do you mean its name is the name of the class?
+If so, use @var{classname}.
+
+ @defun classname object-name &rest slots
+
+The symbol after @defun is the literal name of a function
+you are describing. You can't use @defun for this.
+
+ wish to preset. Any slot set as such WILL NOT get it's default value,
+
+That should be @emph{will not}. Also, "its" is misspelled here too.
+
+ and any side effects from an attributes default function will not occur.
+
+I am not sure what an "attributes default function" is, and I cannot
+find anything in the manual that explains it. There should be a
+cross-reference here to an explanation elsewhere.
+
+ @defun defmethod method [:BEFORE | :PRIMARY | :AFTER | :STATIC ] arglist [doc-string] forms
+
+This needs to be @defmac. Also, you may need to use @code inside it.
+
+It is really confusing that names such as :BEFORE are upper-case.
+Is that what CL does?
+
+ @var{:BEFORE | :AFTER} represent when this form is to be called. If
+ neither of these symbols are present, then the default priority is,
+ before @var{:AFTER}, after @var{:BEFORE}, and is represented in CLOS as
+ @var{PRIMARY}.
+
+These names are keywords, not variables; @var is wrong for them.
+They should be in @code.
+
+ Never treat the first argument
+ of a STATIC method as an object, always used @code{oref-default} or
+ @code{oset-default}.
+
+I can't understand that. However, I am sure that "a STATIC method"
+needs some style change.
+
+ @code{arglist} is the argument list. Unlike CLOS, only the FIRST
+ argument may be type-cast,
+
+I have no idea what that means. "Type-cast" is not standard Emacs
+terminology, so you need to define it. The manual must explain this
+type-cast feature, assuming that the reader has never heard of it
+before.
+
+ If two @code{defmethod}s appear with arglists such as @code{(a b)}
+ and @code{(c d)} then one of the implementations will be overwritten,
+
+"will be overwritten" is not clear; I don't understand it.
+
+ When called, if there is a method cast against the object's parent
+ class, but not for that object's class, the parent class' method will be
+ called.
+
+I am not sure what a "method cast" is, or what it means for that to
+be "against" some class. The text has to explain this.
+
+ If multiple methods and generics are defined for the same method name,
+ they are executed in this order:
+
+ @table @asis
+ @item method :BEFORE
+ @item generic :BEFORE
+
+I can't understand that. What are these "generics", and how does one
+define them? Apparently not with defmethod, which defines methods.
+Apparently not with defgeneric, which defines a placeholder, not
+something that may need to be run.
+
+ If in any situation a method does not exist, but a generic does, then
+ the generic is called in place of the method.
+
+I can't make sense of that. According to the previous text it would
+run both of them, the method first. So if there's no method, it would
+naturally run just the generic, if the absence of a method isn't an
+error. So what information is this sentence meant to convey?
+I can't figure it out.
+
+ @defun call-next-method &rest replacement-args
+
+ While running inside a CLOS method, calling this function will call the
+ method associated with the parent of the class of the currently running
+ method with the same parameters.
+
+When would a program do this? Should methods normally do this?
+
+ @defun class-name class
+ Return a string of the form #<class myclassname>
+
+That needs @samp. Other places too.
+
+ opposed to a regular emacs list function.
+
+I think that should say "a regular Emacs Lisp function".
+
+ @defun object-assoc key slot list
+ Returns the first object in @var{list} for which @var{key} is in
+ @var{slot}.
+
+Is this as trivial as it sounds? If so, please include equivalent
+code not using the function, as an explanatory example. In the
+absence of that, I wonder "Is this doing something that I could not
+easily code for myself"?
+
+ In Emacs 20 a useful customization utility became available called
+ `custom'.
+
+If we install this in Emacs 21, we should take for granted that Emacs
+includes Custom, and not refer to the time when it was absent.
+
+ The below tips are things that I do when I program an EIEIO based
+ package.
+
+These are important, so they belong earlier, with defclass.
+
+ at end ignore
1.2 +85 -45 XEmacs/packages/xemacs-packages/eieio/linemark.el
Index: linemark.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/linemark.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- linemark.el 2002/08/09 21:54:36 1.1
+++ linemark.el 2007/11/26 15:01:06 1.2
@@ -5,7 +5,7 @@
;; Created: Dec 1999
;; Keywords: lisp
;;
-;; Copyright (C) 1999, 2001, 2002 Eric M. Ludlam
+;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
;;
;; 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
@@ -18,8 +18,9 @@
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;;
@@ -73,33 +74,42 @@
(defalias 'linemark-overlay-p 'overlayp)
))
+(defgroup linemark nil
+ "Line marking/highlighting."
+:group 'tools
+ )
+
(eval-and-compile
;; These faces need to exist to show up as valid default
;; entries in the classes defined below.
(defface linemark-stop-face '((((class color) (background light))
- (:background "red4"))
+ (:background "#ff8888"))
(((class color) (background dark))
(:background "red3")))
- "*Face used to indicate a STOP type line.")
+ "*Face used to indicate a STOP type line."
+:group 'linemark)
(defface linemark-caution-face '((((class color) (background light))
- (:background "yellow3"))
+ (:background "yellow"))
(((class color) (background dark))
- (:background "yellow" :foreground "black")))
- "*Face used to indicate a CAUTION type line.")
+ (:background "yellow4")))
+ "*Face used to indicate a CAUTION type line."
+:group 'linemark)
(defface linemark-go-face '((((class color) (background light))
- (:background "green4"))
+ (:background "#88ff88"))
(((class color) (background dark))
(:background "green4")))
- "*Face used to indicate a GO, or OK type line.")
+ "*Face used to indicate a GO, or OK type line."
+:group 'linemark)
(defface linemark-funny-face '((((class color) (background light))
(:background "cyan"))
(((class color) (background dark))
- (:background "blue")))
- "*Face used to indicate a GO, or OK type line.")
+ (:background "blue3")))
+ "*Face used for elements with no particular criticality."
+:group 'linemark)
)
@@ -111,6 +121,7 @@
:type number
:documentation "Line number where the mark is.")
(face :initarg :face
+; Something created w/ defface is not a face in XEmacs.
; :type face
:initform linemark-caution-face
:documentation "The face to use for display.")
@@ -129,6 +140,7 @@
:documentation "List of `linemark-entries'.")
(face :initarg :face
:initform linemark-funny-face
+; Something created w/ defface is not a face in XEmacs.
; :type (or null face)
:documentation "Default face used to create new `linemark-entries'.")
(active :initarg :active
@@ -143,21 +155,34 @@
"List of groups we need to track.")
(defun linemark-create-group (name &optional defaultface)
- "Create a group object for tracking linemark entries.
-Do not permit multiple groups with the same name."
- (let ((newgroup (if (facep defaultface)
- (linemark-group name :face defaultface)
- (linemark-group name)))
+ "*Obsolete*.
+Create a group object for tracking linemark entries.
+Do not permit multiple groups with the same NAME.
+Optional argument DEFAULTFACE is the :face slot for the object."
+ (linemark-new-group 'linemark-group name :face defaultface)
+ )
+
+(defun linemark-new-group (class name &rest args)
+ "Create a new linemark group based on the linemark CLASS.
+Give this group NAME. ARGS are slot/value pairs for
+the new instantiation."
+ (let ((newgroup nil)
(foundgroup nil)
(lmg linemark-groups))
+ ;; Find an old group.
(while (and (not foundgroup) lmg)
(if (string= name (object-name-string (car lmg)))
(setq foundgroup (car lmg)))
(setq lmg (cdr lmg)))
+ ;; Which group to use.
(if foundgroup
+ ;; Recycle the old group
(setq newgroup foundgroup)
- (setq linemark-groups (cons newgroup linemark-groups))
- newgroup)))
+ ;; Create a new group
+ (setq newgroup (apply 'make-instance class name args))
+ (setq linemark-groups (cons newgroup linemark-groups)))
+ ;; Return the group
+ newgroup))
(defun linemark-at-point (&optional pos group)
"Return the current variable `linemark-entry' at point.
@@ -223,9 +248,12 @@ Call the new entrie's activate method."
(let ((file (plist-get args :filename))
(line (plist-get args :line))
(face (plist-get args :face)))
- (if (not file) (setq file (buffer-file-name)))
- (if (not file) (error "You can only add marks to files."))
- (setq file (expand-file-name file))
+ (if (not file)
+ (progn
+ (setq file (buffer-file-name))
+ (if file
+ (setq file (expand-file-name file))
+ (setq file (buffer-name)))))
(when (not line)
(setq line (count-lines (point-min) (point)))
(if (bolp) (setq line (1+ line))))
@@ -233,10 +261,12 @@ Call the new entrie's activate method."
(setq args (plist-put args :line line))
(let ((new-entry (apply 'linemark-new-entry g args)))
(oset new-entry parent g)
- (oset new-entry face (oref g face))
+ (oset new-entry face (or face (oref g face)))
(oset g marks (cons new-entry (oref g marks)))
(if (oref g active)
- (linemark-display new-entry t)))))
+ (linemark-display new-entry t))
+ new-entry)
+ ))
(defmethod linemark-new-entry ((g linemark-group) &rest args)
"Create a new entry for G using init ARGS."
@@ -257,25 +287,33 @@ Call the new entrie's activate method."
(if (oref e overlay)
;; Already active
nil
- (if (get-file-buffer file)
- (save-excursion
- (set-buffer (get-file-buffer file))
- (goto-line (oref e line))
- (beginning-of-line)
- (oset e overlay
- (linemark-make-overlay (point)
- (save-excursion
- (end-of-line) (point))
- (current-buffer)))
- (with-slots (overlay) e
- (linemark-overlay-put overlay 'face (oref e face))
- (linemark-overlay-put overlay 'obj e)
- (linemark-overlay-put overlay 'tag 'linemark))))))
+ (let ((buffer))
+ (if (get-file-buffer file)
+ (setq buffer (get-file-buffer file))
+ (setq buffer (get-buffer file)))
+ (if buffer
+ (save-excursion
+ (set-buffer buffer)
+ (save-excursion
+ (goto-line (oref e line))
+ (beginning-of-line)
+ (oset e overlay
+ (linemark-make-overlay (point)
+ (save-excursion
+ (end-of-line) (point))
+ (current-buffer)))
+ (with-slots (overlay) e
+ (linemark-overlay-put overlay 'face (oref e face))
+ (linemark-overlay-put overlay 'obj e)
+ (linemark-overlay-put overlay 'tag 'linemark))))))))
;; Not active
(with-slots (overlay) e
(if overlay
(progn
- (linemark-delete-overlay overlay)
+ (condition-case nil
+ ;; During development of linemark programs, this is helpful
+ (linemark-delete-overlay overlay)
+ (error nil))
(oset e overlay nil))))))
(defmethod linemark-delete ((g linemark-group))
@@ -325,7 +363,7 @@ Call the new entrie's activate method."
;;; Demo mark tool: Emulate MS Visual Studio bookmarks
;;
-(defvar viss-bookmark-group (linemark-create-group "viss")
+(defvar viss-bookmark-group (linemark-new-group 'linemark-group "viss")
"The VISS bookmark group object.")
(defun viss-bookmark-toggle ()
@@ -352,7 +390,8 @@ Call the new entrie's activate method."
"Clear all bookmarks in this buffer."
(interactive)
(mapcar (lambda (e)
- (if (string= (oref e filename) (buffer-file-name))
+ (if (or (string= (oref e filename) (buffer-file-name))
+ (string= (oref e filename) (buffer-name)))
(linemark-delete e)))
(oref viss-bookmark-group marks)))
@@ -393,13 +432,14 @@ Call the new entrie's activate method."
;; (oref viss-bookmark-group marks)))
;;
+;;;###autoload
(defun enable-visual-studio-bookmarks ()
"Bind the viss bookmark functions to F2 related keys.
\\<global-map>
-\\[viss-bookmark-toggle] - Toggle a bookmark on this line.
-\\[viss-bookmark-next] - Move to the next bookmark.
-\\[viss-bookmark-prev] - Move to the previous bookmark.
-\\[viss-bookmark-clear-all] - Clear all bookmarks."
+\\[viss-bookmark-toggle] - To=ggle a bookmark on this line.
+\\[viss-bookmark-next-buffer] - Move to the next bookmark.
+\\[viss-bookmark-prev-buffer] - Move to the previous bookmark.
+\\[viss-bookmark-clear-all-buffer] - Clear all bookmarks."
(interactive)
(define-key global-map [(f2)] 'viss-bookmark-toggle)
(define-key global-map [(shift f2)] 'viss-bookmark-prev-buffer)
1.5 +1 -1 XEmacs/packages/xemacs-packages/eieio/package-info.in
Index: package-info.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/package-info.in,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- package-info.in 2002/08/09 21:54:36 1.4
+++ package-info.in 2007/11/26 15:01:07 1.5
@@ -13,7 +13,7 @@
filename FILENAME
md5sum MD5SUM
size SIZE
- provides (call-tree chart compare-strings eieio-base eieio-comp eieio-custom eieio-doc eieio-opt eieio-speedbar eieio-tests eieio linemark tree)
+ provides (eieio-comp eieio eieio-opt eieio-custom eieio-doc eieio-base tree call-tree chart eieio-speedbar linemark eieio-load lmcompile)
requires (REQUIRES)
type regular
))
1.4 +5 -8 XEmacs/packages/xemacs-packages/eieio/tree.el
Index: tree.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/eieio/tree.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- tree.el 2002/08/09 21:54:36 1.3
+++ tree.el 2007/11/26 15:01:07 1.4
@@ -1,10 +1,10 @@
;;; tree.el --- Draw a tree with text characters an manipulate it.
-;;; Copyright (C) 1996, 1998, 1999, 2001 Eric M. Ludlam
+;;; Copyright (C) 1996, 1998, 1999, 2001, 2005 Eric M. Ludlam
;;
;; Author: <zappo at gnu.org>
;; Version: 0.3
-;; RCS: $Id: tree.el,v 1.3 2002/08/09 21:54:36 youngs Exp $
+;; RCS: $Id: tree.el,v 1.4 2007/11/26 15:01:07 michaels Exp $
;; Keywords: OO, tree
;;
;; This program is free software; you can redistribute it and/or modify
@@ -18,12 +18,9 @@
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;
;; Please send bug reports, etc. to zappo at gnu.org
1.1 XEmacs/packages/xemacs-packages/eieio/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
2007-06-04 Eric M. Ludlam <zappo at gnu.org>
* eieio-base.el (eieio-persistent::eieio-persistent-path-relative):
Remove comment.
2007-03-18 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-default-superclass::object-write):
Optimize slot writer.
2007-02-18 Eric M. Ludlam <zappo at gnu.org>
* linemark.el (linemark): Added group to tools.
* eieio-speedbar.el:
(eieio-speedbar-find-nearest-object, eieio-speedbar-line-path):
Use string-to-number
* eieio.el (inversion): Add require.
* eieio-custom.el (eieio-widget-test): Add to a customize group
* eieio-base.el (eieio-instance-inheritor::clone): Use string-to-number
(eieio-persistent-read): Use insert-file-contents.
* chart.el (chart-space-usage): Use string-to-number
2007-01-09 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-default-superclass::clone):
Use string-to-number instead of string-to-int.
2006-02-09 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el ("eieio-test-methodinvoke.el"):
switch to load library.
2006-02-08 Eric M. Ludlam <zappo at gnu.org>
* Project.ede (:version): updated (removed means 1.0)
* Makefile (VERSION): updated
* eieio.el (eieio-version): Updated
2005-09-30 Eric M. Ludlam <zappo at gnu.org>
* tree.el, lmcompile.el, linemark.el, eieio-tests.el, eieio-test-methodinvoke.el, eieio-speedbar.el, eieio-opt.el, eieio-load.el, eieio.el, eieio-doc.el, eieio-custom.el, eieiocomp.el, eieio-comp.el, eieio-base.el, chart.el, call-tree.el:
Update all GPL headers with script from savannah.gnu.org.
2005-09-07 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el: Add test for setf through an :accessor.
* eieio.el (eieio-defclass):
Fix setf for accessor to access the correct slot name.
2005-09-01 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-default-superclass::object-write): if to when.
2005-06-30 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-version): Updated.
* Makefile (VERSION): Updated.
* Project.ede (:version): Updated.
2005-05-06 Eric M. Ludlam <zappo at gnu.org>
* Project.ede ("eieio"): Update version number
* Makefile (VERSION): Update version number
(autoloads, init, eieio, examples, test): Add quotes around EMACS.
2005-05-05 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el (class-fun-value-seq): Bind locally in let statement.
* eieio-test-methodinvoke.el (eieio-test-method-store):
Add :STATIC to things recorded.
(eieio-test-match): Updated error to be more telling.
(F): Also test 'call-next-method'
Fixup results for test based on new answers.
(C, C-base1, C-base2): New test for constructors.
* eieio.el (eieio-version): Updated to beta2
(eieio-generic-call-next-method-list): New state variable.
(eieio-generic-call): Create a setup the primary method list.
(next-method-p): Return eieio-generic-call-next-method-list.
(call-next-method): Call tne next method from the list.
Shorten the list.
2005-04-30 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-require-version):
Replace with an inversion implementatin.
2005-04-23 Eric M. Ludlam <zappo at gnu.org>
* Makefile (Misc_MISC): Added NEWS.
* Project.ede (Misc): Added NEWS file.
* NEWS: New News file.
2005-04-19 Eric M. Ludlam <zappo at gnu.org>
* Makefile (VERSION): Updated.
* Project.ede ("eieio"): Updated.
2005-04-17 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el (class-fun-value): New method ordering test.
* eieio-tests.el (static-method-class-method):
New tests to try against objects as
well as classes.
2005-04-14 Eric M. Ludlam <zappo at gnu.org>
* eieio-test-methodinvoke.el:
Add test for primary return val in presense of :AFTER methods.
* eieio.el (eieio-generic-call): Remove old static local variable.
If :PRIMARY results in no lambdas, do not put nil in the list.
If there are no lambdas found try finding static lambdas. (was
tlambdas which was wrong in code, right in previous checking msg.)
Remember only return vals for primary methods.
Track if we have a primary return val. Not sure what to do with it yet.
* eieio-tests.el: Test slot accessors on :class slots via class symbol.
* eieio.el (eieio-defclass):
Make accessor on :class allocated slots static.
* eieio-test-methodinvoke.el:
Test that an object call call a static method.
* eieio.el (eieio-generic-call):
Allow an object to also call into a static
method.
* eieio-test-methodinvoke.el:
Add test A+,G to test holes between before/after methods.
* eieio.el (eieiomt-method-list):
Prevent the optimization array from providing
duplicates while making lists of before/after methods.
* Makefile: Update to support eieio 1.135.
* Project.ede: Add eieio-test-methodinvoke.el.
* eieio-tests.el, eieio-test-methodinvoke.el:
Fix for eieio version 1.135.
* eieio-base.el (slot-missing): Doc fix.
* eieio.el (call-next-method):
Restore original behavior of call-next-method.
It should only call the first method it encounters.
2005-04-03 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-version): Reset to a beta value
(eieio-generic-call): Handle new list returns from eieiomt-method-list.
(eieiomt-method-list): New function
(call-next-method): Disable :BEFORE or :AFTER methods to call in.
Call all next methods.
* eieio-tests.el: Fixed for new way call-next-method works.
* eieio-test-methodinvoke.el: New test file.
* eieio.texi (Introduction): Remove ref to old FTP location.
2005-02-04 Eric M. Ludlam <zappo at gnu.org>
* eieio.texi:
Add comments from RMS on how to improve the manual to the end of the
manual so they are not forgotten.
2005-02-03 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-version): Update version number
* Makefile (VERSION): Updated version number
* Project.ede (eieio): Updated version number
2005-01-20 Eric M. Ludlam <zappo at gnu.org>
* eieio-speedbar.el (eieio-speedbar-key-map): Initialize to a value.
(eieio-speedbar-make-map): Move. Return a keymap.
(eieio-speedbar-customization-line): Add todo item.
2004-11-19 Eric M. Ludlam <zappo at gnu.org>
* chart.el (chart-space-usage): Use shell-file-name instead of "csh".
2004-10-14 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el: doc update.
* lmcompile.el (lmcompile-do-highlight):
Allow hits in buffers without file names.
* linemark.el (linemark-add-entry):
Allow entries in buffers not associated with files.
(linemark-display): Allow display in buffers not associated with files.
(viss-bookmark-clear-all-buffer): Clear bookmarks in buffers not
associated with files.
2004-08-03 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el (lmcompile-do-highlight):
Updated to work with my CVS Emacs.
Now handles a compile entry of (<errmark> . <destmark>)
2004-07-20 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el (lmcompile-do-highlight):
After switching buffers, protect against
moving the cursor.
2004-07-13 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el (lmcompile-reinitialize-errors): New alias
(lmcompile-do-highlight): Use alias.
* eieio-base.el (initialize-instance):
Use memq instead of member when testing for a
pre-existing symbol.
(eieio-persistent); comment update.
2004-06-13 Eric M. Ludlam <zappo at gnu.org>
* eieio.texi (eieio-persistent):
Fix typo in `eieio-persistent-save' method name.
2004-04-11 Eric M. Ludlam <zappo at gnu.org>
* Makefile (dist): Add autoloads
2004-04-06 Eric M. Ludlam <zappo at gnu.org>
* Makefile (dist): Distribute the autoload file
2004-03-30 Eric M. Ludlam <zappo at gnu.org>
* Makefile (clean): Update info garbage pattern.
2004-03-28 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-defclass): whitespace removal.
* eieio-doc.el (eieiodoc-one-node):
Limit the amount of subclassing allowed.
2004-03-01 Eric M. Ludlam <zappo at gnu.org>
* eieio-doc.el (eieiodoc-class): Fix doc string.
Handle cases where the code is executed from inside @ignore section.
2004-02-29 Eric M. Ludlam <zappo at gnu.org>
* INSTALL: Revamped. We are a part of a CEDET install now.
2004-02-21 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el (lmcompile-do-highlight): add autoload cookie.
* linemark.el (enable-visual-studio-bookmarks): add autoload cookie.
2004-02-12 Eric M. Ludlam <zappo at gnu.org>
* Makefile (VERSION): Updated.
* Project.ede (version): Updated.
* eieio.el (eieio-version): Updated.
(edebug-setup-hook): Removed
(cedet-edebug): New eval-after-load segement to replace old
edebug setup.
2003-12-11 Eric M. Ludlam <zappo at gnu.org>
* eieio-opt.el (eieio-class-button): Correct a space issue.
2003-10-02 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Now a meta-subproject.
* Makefile (dist): Remove local creation of tar file.
2003-10-01 David Ponce <david at dponce.com>
* compare-strings.el: Remove. Replaced by common/cedet-compat.el.
2003-09-24 Eric M. Ludlam <zappo at gnu.org>
* Makefile, Project.ede: Update version to 0.18beta1.
* eieio.el: Update version to 0.18beta1.
(eieiomt-get): Remove.
2003-09-18 David Ponce <david at dponce.com>
* Makefile: Re-generated.
* Project.ede (init): New target.
2003-09-17 David Ponce <david at dponce.com>
* Makefile: Re-generated.
* Project.ede (autoloads): Change eieio-defs.el by eieio-loaddefs.el.
* eieio-load.el: New file.
2003-09-16 David Ponce <david at dponce.com>
* Makefile: Re-generated.
2003-09-10 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el (prot-0): New class
(prot0-slot-2): New method.
Call above method in testing harness.
2003-09-10 David Ponce <david at dponce.com>
* Makefile: Re-generated.
* Project.ede (eieio target):
Add speedbar to aux-packages to ensure that eieio
will be byte-compiled with the speedbar library in cedet.
2003-09-09 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-field-name-index):
API change to accept and OBJ field.
If slot is protected and OBJ inherits from the declaritive class,
then it is ok.
(eieio-oref, eieio-oref-default, eieio-oset, eieio-oset-default):
Change to use above new API.
2003-09-07 Eric M. Ludlam <zappo at gnu.org>
* Makefile (LOADDEFS): New
(all): Add eieio-defs.el
(eieio-defs.el): New
(dist): Added LOADDEFS
* Project.ede ("autoloads"): New
("test"): named object.
* eieio-opt.el (eieio-browse): autoload cookie
2003-03-03 Eric M. Ludlam <zappo at gnu.org>
* lmcompile.el (lmcompile-linemark-entry): Add errmsg slot.
(linemark-display:lmcompile-linemark-entry): Remove code now in
create routine.
(lmcompile-error-group): Use new linemark creation routine
(lmcompile-do-highlight): Get the face and error text. Add it into
the object at creation time.
* linemark.el (linemark-create-group):
Now obsolete. Call linemark-new-group.
(linemark-new-group): New generic group creation routine.
(linemark-add-entry): Allow passing in of :face arg. Return created entry.
(viss-bookmark-group): Use new creation routine.
2003-03-02 Eric M. Ludlam <zappo at gnu.org>
* eieio-custom.el:
Changes submitted by: "Ben Menasha" <bmenasha at benmenasha.net>
(eieio-custom-ignore-eieio-co): New variable
(eieio-object-value-get): Save all groups of objects edited inline of
another object.
2003-02-25 Eric M. Ludlam <zappo at gnu.org>
* Makefile: *** empty log message ***
* Project.ede (eieio): Version update
(examples): Added lmcompile.el
* eieio.texi (Introduction): Added lmcompile
* eieio.el (eieio-version): update to 0.18
* lmcompile.el: Emacs Compilation hit highlighting.
* linemark.el (linemark): New group
(linemark-stop-face, linemark-caution-face, linemark-go-face):
Changed default colors.
(linemark-funny-face): New default colors. Doc fix.
(linemark-entry): Comment about XEmacs
2003-02-22 David Ponce <david at dponce.com>
* eieio-speedbar.el (eieio-speedbar-create-engine):
Replaced `speedbar-line-path' with
`speedbar-line-directory' used since speedbar 0.15.
2003-01-23 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-defclass): Better defsetf for accessors
(eieio-defgeneric): Initialize method tree via eieiomt-install.
Better error message when turning an existing function into a method.
(eieiomt-install): New function from eieiomt-add.
(eieiomt-add): Remove old install into eieiomt-install.
Assume tables are always available.
* eieio-tests.el (generic1): tests for defgeneric.
* eieio.el: Remove CL related hooks from end. Just do it.
(eieio-defclass): Remove cl loading from hook of defclass.
Enable setf on set methods.
(eieio-defgeneric): Add comment about not repeating a task.
Add fake `defun' so that emacs can find methods.
(eieio-unbind-method-implemenations): Function to reset a symbol as a
method.
2002-12-10 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el: Test cloning.
More equivalence tests on singletons.
* eieio.el (make-instance): Support symbol's as names of an object.
(describe-variable): Fix doc.
* eieio-opt.el (eieio-help-mode-augmentation-maybee):
Add an unused argument for
XEmacs compatibility.
2002-09-07 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-add-new-field):
Support overriding the :initarg for subclasses.
2002-09-04 Eric M. Ludlam <zappo at gnu.org>
* eieio.el (eieio-version): 0.17.1
(eieio-defgeneric): Allow overwriting of an autoload.
(eieio-defmethod): Always call eieio-defgeneric.
(eieio-generic-call): If passed in arg 1 is an autoloaded symbol,
load it's file.
2002-09-03 Eric M. Ludlam <zappo at gnu.org>
* eieio-opt.el (eieio-describe-class):
Fixed display of commas between parents.
Handle STATIC keywords.
(eieio-describe-generic): Handle STATIC keywords.
(eieio-help-mode-augmentation-maybee): Highlight STATIC keywords.
2002-08-28 Eric M. Ludlam <zappo at gnu.org>
* linemark.el (linemark-go-face): light background, use green.
* linemark.el: Overlay compatibility layer moved.
(linemark-entry): Don't specify a type for faces
(linemark-group): Don't specify a type for faces
(linemark-display): Don't error if overlay deleted before class.
(enable-visual-studio-bookmarks): Doc fix.
2002-08-20 Eric M. Ludlam <zappo at gnu.org>
* eieio-base.el (constructor::eieio-singleton):
Fix to handle unbound case instead of nil.
2002-08-17 Eric M. Ludlam <zappo at gnu.org>
* eieio-tests.el: Add test for inheritance/overload and static methods.
2002-08-08 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Removed compare-strings.el from distribution.
* eieio-base.el: Do not require `compare-strings'.
2002-08-07 Eric M. Ludlam <zappo at gnu.org>
* eieio.texi (Base Classes): Added `eieio-singleton' and `eieio-named'
(eieio-singleton): New section
(eieio-named): New section
* eieio.texi (Writing Methods):
Added information about :STATIC methods.
* Project.ede: Updated version number.
2002-07-11 Eric M. Ludlam <zappo at gnu.org>
* linemark.el (linemark-next-in-buffer):
Correctly start search when going backward.
(linemark-end): Fix doc.
2002-06-27 Eric M. Ludlam <zappo at gnu.org>
* eieio.el ("cl-macs"): Load silently.
(eieio-defclass): Removed old bootstrapping messages.
* eieio-base.el (eieio-singleton): New class.
(constructor::eieio-singleton): New method.
* linemark.el (linemark-next-in-buffer):
Accounts for extra embedded overlays.
(linemark-begin, linemark-end): New methods.
* eieio-tests.el: Added messages to method dispatch test.
Added test for static methods.
Added test