;;; eieio-base.el --- Base classes for EIEIO.
-;; Copyright (C) 2000, 2001 Eric M. Ludlam
+;; Copyright (C) 2000, 2001 Eric M. Ludlam
;; Author: <firstname.lastname@example.org>
-(if (not (fboundp 'compare-strings))
- (require 'compare-strings))
;; error if a slot is unbound.
(defclass eieio-instance-inheritor ()
((parent-instance :initarg :parent-instance
- :type eieio-instance-inheritor
+ :type eieio-instance-inheritor-
"The parent of this instance.
If a slot of this class is reference, and is unbound, then the parent
"This special class can enable instance inheritance.
Use `clone' to make a new object that does instance inheritance from
a parent instance. When a slot in the child is referenced, and has
-not been set, use values from the parent.")
+not been set, use values from the parent."
(defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn)
"If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal.
;; symbol is then used to contain these objects.
(defclass eieio-instance-tracker ()
((tracking-symbol :type symbol
"The symbol used to maintain a list of our instances.
The instance list is treated as a variable, with new instances added to it.")
"This special class enables instance tracking.
Inheritors from this class must overload `tracking-symbol' which is
-a variable symbol used to store a list of all instances.")
+a variable symbol used to store a list of all instances."
(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
Returns the first match."
(object-assoc key field (symbol-value list-symbol)))
+;; The singleton Design Pattern specifies that there is but one object
+;; of a given class ever created. The EIEIO singleton base class defines
+;; a CLASS allocated slot which contains the instance used. All calls to
+;; `make-instance' will either create a new instance and store it in this
+;; slot, or it will just return what is there.
+(defclass eieio-singleton ()
+ ((singleton :type eieio-singleton
+ "The only instance of this class that will be instantiated.
+Multiple calls to `make-instance' will return this object."))
+ "This special class causes subclasses to be singletons.
+A singleton is a class which will only ever have one instace."
+(defmethod constructor :STATIC ((class eieio-singleton) name &rest fields)
+ "Constructor for singleton CLASS.
+NAME and FIELDS initialize the new object.
+This constructor guarantees that no matter how many you request,
+only one object ever exists."
+ (let ((old (oref-default class singleton)))
+ (or old (call-next-method))))
"The save file for this persistent object.
This must be a string, and must be specified when the new object is
+ (extension :type string
+ "Extension of files saved by this object.
+Enables auto-choosing nice file names based on name.")
(file-header-line :type string
:initform ";; EIEIO PERSISTENT OBJECT"
"Header line for the save file.
This is used with the `object-write' method."))
- "This special class enables persistence through save files.
-Use the `object-save' method to write this object to disk.")
+ "This special class enables persistence through save files
+Use the `object-save' method to write this object to disk. The save
+format is Emacs Lisp code which calls the constructor for the saved
+object. For this reason, only slots which do not have an `:initarg'
+specified will not be saved."
+(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
+ "Perpare to save THIS. Use in an `interactive' statement.
+Query user for file name with PROMPT if THIS does not yet specify
+a file. Optional argument NAME specifies a default file name."
+ (unless (slot-boundp this 'file)
+ (read-file-name prompt nil
+ (concat name (oref this extension))
(defun eieio-persistent-read (filename)
"Read a persistent object from FILENAME."
(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
"For object THIS, make absolute file name FILE relative."
- (let* ((src (expand-file-name file))
- (dest (file-name-directory (oref this file)))
- (cs1 (compare-strings src 0 nil dest 0 nil))
- ;; Find the common directory part
- (setq diff (substring src 0 cs1))
- (setq cs1 (split-string diff "[\\/]"))
- (setq cs1 (length (nth (1- (length cs1)) cs1)))
- (setq diff (substring diff 0 (- (length diff) cs1)))
- ;; Get the uncommon bits from dest and src.
- (setq abdest (substring dest (length diff))
- absrc (substring src (length diff)))
- ;; Find number if dirs in absrc, and add those as ".." to dest.
- ;; Rember we have a file name, so that is the 1-.
- (setq cs1 (1- (length (split-string absrc "[\\/]"))))
- (setq abdest (concat "../" abdest)
+ ;; Woah! Look at `file-relative-name' as a solution.
+ (file-relative-name (expand-file-name file)
+ (file-name-directory (oref this file))))
(defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
"Save persistent object THIS to disk.
;; Restore :file, and kill the tmp buffer
+ (setq buffer-file-name nil)
;; Notes on the persistent object:
;; It should also set up some hooks to help it keep itself up to date.
+;; Named objects use the objects `name' as a slot, and that slot
+;; is accessed with the `object-name' symbol.
+(defclass eieio-named ()
+Name storage already occurs in an object. This object provides get/set
+(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.
+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'.
+NEW-VALUE is the value that was being set into SLOT if OPERATION were
+ (if (or (eq slot-name 'object-name)
+ (eq slot-name :object-name))
+ (cond ((eq operation 'oset)
+ (if (not (stringp new-value))
+ (signal 'invalid-slot-type
+ (list obj slot-name 'string new-value)))
+ (object-set-name-string obj new-value))
+ (t (object-name-string obj)))