Mercurial > emacs
annotate lisp/emacs-lisp/eieio.el @ 104487:5fabb7947fa5
* emacs-lisp/autoload.el (make-autoload): Handle defclass form.
* emacs-lisp/eieio.el (eieio-defclass-autoload): Autoload.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 07 Sep 2009 18:01:27 +0000 |
parents | a64f3429f0ac |
children | 25e047f7f6a2 |
rev | line source |
---|---|
104431
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1 ;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2 ;;; or maybe Eric's Implementation of Emacs Intrepreted Objects |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
3 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
4 ;;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
5 ;;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
6 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
7 ;; Author: Eric M. Ludlam <zappo@gnu.org> |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
8 ;; Version: 0.2 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
9 ;; Keywords: OO, lisp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
10 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
11 ;; This file is part of GNU Emacs. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
12 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
14 ;; it under the terms of the GNU General Public License as published by |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
16 ;; (at your option) any later version. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
17 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
18 ;; GNU Emacs is distributed in the hope that it will be useful, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
21 ;; GNU General Public License for more details. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
22 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
23 ;; You should have received a copy of the GNU General Public License |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
25 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
26 ;;; Commentary: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
27 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
28 ;; EIEIO is a series of Lisp routines which implements a subset of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
29 ;; CLOS, the Common Lisp Object System. In addition, EIEIO also adds |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
30 ;; a few new features which help it integrate more strongly with the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
31 ;; Emacs running environment. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
32 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
33 ;; See eieio.texi for complete documentation on using this package. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
34 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
35 ;; There is funny stuff going on with typep and deftype. This |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
36 ;; is the only way I seem to be able to make this stuff load properly. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
37 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
38 ;; @TODO - fix :initform to be a form, not a quoted value |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
39 ;; @TODO - For API calls like `object-p', replace with something |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
40 ;; that does not conflict with "object", meaning a lisp object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
41 ;; @TODO - Prefix non-clos functions with `eieio-'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
42 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
43 ;;; Code: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
44 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
45 (defvar eieio-version "1.2" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
46 "Current version of EIEIO.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
47 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
48 (require 'cl) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
49 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
50 (defun eieio-version () |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
51 "Display the current version of EIEIO." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
52 (interactive) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
53 (message eieio-version)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
54 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
55 (eval-and-compile |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
56 ;; Abount the above. EIEIO must process it's own code when it compiles |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
57 ;; itself, thus, by eval-and-compiling outselves, we solve the problem. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
58 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
59 ;; Compatibility |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
60 (if (fboundp 'compiled-function-arglist) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
61 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
62 ;; XEmacs can only access a compiled functions arglist like this: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
63 (defalias 'eieio-compiled-function-arglist 'compiled-function-arglist) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
64 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
65 ;; Emacs doesn't have this function, but since FUNC is a vector, we can just |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
66 ;; grab the appropriate element. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
67 (defun eieio-compiled-function-arglist (func) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
68 "Return the argument list for the compiled function FUNC." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
69 (aref func 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
70 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
71 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
72 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
73 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
74 ;;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
75 ;; Variable declarations. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
76 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
77 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
78 (defvar eieio-hook nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
79 "*This hook is executed, then cleared each time `defclass' is called.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
80 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
81 (defvar eieio-error-unsupported-class-tags nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
82 "*Non nil to throw an error if an encountered tag us unsupported. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
83 This may prevent classes from CLOS applications from being used with EIEIO |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
84 since EIEIO does not support all CLOS tags.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
85 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
86 (defvar eieio-skip-typecheck nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
87 "*If non-nil, skip all slot typechecking. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
88 Set this to t permanently if a program is functioning well to get a |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
89 small speed increase. This variable is also used internally to handle |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
90 default setting for optimization purposes.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
91 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
92 (defvar eieio-optimize-primary-methods-flag t |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
93 "Non-nil means to optimize the method dispatch on primary methods.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
94 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
95 ;; State Variables |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
96 (defvar this nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
97 "Inside a method, this variable is the object in question. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
98 DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
99 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
100 Note: Embedded methods are no longer supported. The variable THIS is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
101 still set for CLOS methods for the sake of routines like |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
102 `call-next-method'") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
103 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
104 (defvar scoped-class nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
105 "This is set to a class when a method is running. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
106 This is so we know we are allowed to check private parts or how to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
107 execute a `call-next-method'. DO NOT SET THIS YOURSELF!") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
108 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
109 (defvar eieio-initializing-object nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
110 "Set to non-nil while initializing an object.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
111 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
112 (defconst eieio-unbound (make-symbol "unbound") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
113 "Uninterned symbol representing an unbound slot in an object.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
114 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
115 ;; This is a bootstrap for eieio-default-superclass so it has a value |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
116 ;; while it is being built itself. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
117 (defvar eieio-default-superclass nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
118 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
119 (defconst class-symbol 1 "Class's symbol (self-referencing.).") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
120 (defconst class-parent 2 "Class parent slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
121 (defconst class-children 3 "Class children class slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
122 (defconst class-symbol-obarray 4 "Obarray permitting fast access to variable position indexes.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
123 ;; @todo |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
124 ;; the word "public" here is leftovers from the very first version. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
125 ;; Get rid of it! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
126 (defconst class-public-a 5 "Class attribute index.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
127 (defconst class-public-d 6 "Class attribute defaults index.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
128 (defconst class-public-doc 7 "Class documentation strings for attributes.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
129 (defconst class-public-type 8 "Class type for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
130 (defconst class-public-custom 9 "Class custom type for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
131 (defconst class-public-custom-label 10 "Class custom group for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
132 (defconst class-public-custom-group 11 "Class custom group for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
133 (defconst class-public-printer 12 "Printer for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
134 (defconst class-protection 13 "Class protection for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
135 (defconst class-initarg-tuples 14 "Class initarg tuples list.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
136 (defconst class-class-allocation-a 15 "Class allocated attributes.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
137 (defconst class-class-allocation-doc 16 "Class allocated documentation.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
138 (defconst class-class-allocation-type 17 "Class allocated value type.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
139 (defconst class-class-allocation-custom 18 "Class allocated custom descriptor.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
140 (defconst class-class-allocation-custom-label 19 "Class allocated custom descriptor.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
141 (defconst class-class-allocation-custom-group 20 "Class allocated custom group.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
142 (defconst class-class-allocation-printer 21 "Class allocated printer for a slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
143 (defconst class-class-allocation-protection 22 "Class allocated protection list.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
144 (defconst class-class-allocation-values 23 "Class allocated value vector.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
145 (defconst class-default-object-cache 24 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
146 "Cache index of what a newly created object would look like. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
147 This will speed up instantiation time as only a `copy-sequence' will |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
148 be needed, instead of looping over all the values and setting them |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
149 from the default.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
150 (defconst class-options 25 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
151 "Storage location of tagged class options. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
152 Stored outright without modifications or stripping.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
153 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
154 (defconst class-num-slots 26 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
155 "Number of slots in the class definition object.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
156 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
157 (defconst object-class 1 "Index in an object vector where the class is stored.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
158 (defconst object-name 2 "Index in an object where the name is stored.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
159 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
160 (defconst method-static 0 "Index into :static tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
161 (defconst method-before 1 "Index into :before tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
162 (defconst method-primary 2 "Index into :primary tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
163 (defconst method-after 3 "Index into :after tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
164 (defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
165 (defconst method-generic-before 4 "Index into generic :before tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
166 (defconst method-generic-primary 5 "Index into generic :primary tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
167 (defconst method-generic-after 6 "Index into generic :after tag on a method.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
168 (defconst method-num-slots 7 "Number of indexes into a method's vector.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
169 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
170 ;; How to specialty compile stuff. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
171 (autoload 'byte-compile-file-form-defmethod "eieio-comp" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
172 "This function is used to byte compile methods in a nice way.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
173 (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
174 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
175 (eval-when-compile (require 'eieio-comp)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
176 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
177 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
178 ;;; Important macros used in eieio. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
179 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
180 (defmacro class-v (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
181 "Internal: Return the class vector from the CLASS symbol." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
182 ;; No check: If eieio gets this far, it's probably been checked already. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
183 `(get ,class 'eieio-class-definition)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
184 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
185 (defmacro class-p (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
186 "Return t if CLASS is a valid class vector. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
187 CLASS is a symbol." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
188 ;; this new method is faster since it doesn't waste time checking lots of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
189 ;; things. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
190 `(condition-case nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
191 (eq (aref (class-v ,class) 0) 'defclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
192 (error nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
193 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
194 ;;;###autoload |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
195 (defmacro eieio-object-p (obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
196 "Return non-nil if OBJ is an EIEIO object." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
197 `(condition-case nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
198 (let ((tobj ,obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
199 (and (eq (aref tobj 0) 'object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
200 (class-p (aref tobj object-class)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
201 (error nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
202 (defalias 'object-p 'eieio-object-p) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
203 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
204 (defmacro class-constructor (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
205 "Return the symbol representing the constructor of CLASS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
206 `(aref (class-v ,class) class-symbol)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
207 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
208 (defmacro generic-p (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
209 "Return t if symbol METHOD is a generic function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
210 Only methods have the symbol `eieio-method-obarray' as a property (which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
211 contains a list of all bindings to that method type.)" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
212 `(and (fboundp ,method) (get ,method 'eieio-method-obarray))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
213 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
214 (defun generic-primary-only-p (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
215 "Return t if symbol METHOD is a generic function with only primary methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
216 Only methods have the symbol `eieio-method-obarray' as a property (which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
217 contains a list of all bindings to that method type.) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
218 Methods with only primary implementations are executed in an optimized way." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
219 (and (generic-p method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
220 (let ((M (get method 'eieio-method-tree))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
221 (and (< 0 (length (aref M method-primary))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
222 (not (aref M method-static)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
223 (not (aref M method-before)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
224 (not (aref M method-after)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
225 (not (aref M method-generic-before)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
226 (not (aref M method-generic-primary)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
227 (not (aref M method-generic-after)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
228 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
229 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
230 (defun generic-primary-only-one-p (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
231 "Return t if symbol METHOD is a generic function with only primary methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
232 Only methods have the symbol `eieio-method-obarray' as a property (which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
233 contains a list of all bindings to that method type.) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
234 Methods with only primary implementations are executed in an optimized way." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
235 (and (generic-p method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
236 (let ((M (get method 'eieio-method-tree))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
237 (and (= 1 (length (aref M method-primary))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
238 (not (aref M method-static)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
239 (not (aref M method-before)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
240 (not (aref M method-after)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
241 (not (aref M method-generic-before)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
242 (not (aref M method-generic-primary)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
243 (not (aref M method-generic-after)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
244 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
245 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
246 (defmacro class-option-assoc (list option) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
247 "Return from LIST the found OPTION. Nil if it doesn't exist." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
248 `(car-safe (cdr (memq ,option ,list)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
249 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
250 (defmacro class-option (class option) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
251 "Return the value stored for CLASS' OPTION. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
252 Return nil if that option doesn't exist." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
253 `(class-option-assoc (aref (class-v ,class) class-options) ',option)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
254 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
255 (defmacro class-abstract-p (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
256 "Return non-nil if CLASS is abstract. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
257 Abstract classes cannot be instantiated." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
258 `(class-option ,class :abstract)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
259 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
260 (defmacro class-method-invocation-order (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
261 "Return the invocation order of CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
262 Abstract classes cannot be instantiated." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
263 `(or (class-option ,class :method-invocation-order) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
264 :breadth-first)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
265 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
266 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
267 ;;; Defining a new class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
268 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
269 (defmacro defclass (name superclass slots &rest options-and-doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
270 "Define NAME as a new class derived from SUPERCLASS with SLOTS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
271 OPTIONS-AND-DOC is used as the class' options and base documentation. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
272 SUPERCLASS is a list of superclasses to inherit from, with SLOTS |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
273 being the slots residing in that class definition. NOTE: Currently |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
274 only one slot may exist in SUPERCLASS as multiple inheritance is not |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
275 yet supported. Supported tags are: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
276 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
277 :initform - initializing form |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
278 :initarg - tag used during initialization |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
279 :accessor - tag used to create a function to access this slot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
280 :allocation - specify where the value is stored. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
281 defaults to `:instance', but could also be `:class' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
282 :writer - a function symbol which will `write' an object's slot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
283 :reader - a function symbol which will `read' an object |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
284 :type - the type of data allowed in this slot (see `typep') |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
285 :documentation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
286 - A string documenting use of this slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
287 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
288 The following are extensions on CLOS: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
289 :protection - Specify protection for this slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
290 Defaults to `:public'. Also use `:protected', or `:private' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
291 :custom - When customizing an object, the custom :type. Public only. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
292 :label - A text string label used for a slot when customizing. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
293 :group - Name of a customization group this slot belongs in. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
294 :printer - A function to call to print the value of a slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
295 See `eieio-override-prin1' as an example. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
296 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
297 A class can also have optional options. These options happen in place |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
298 of documentation, (including a :documentation tag) in addition to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
299 documentation, or not at all. Supported options are: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
300 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
301 :documentation - The doc-string used for this class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
302 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
303 Options added to EIEIO: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
304 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
305 :allow-nil-initform - Non-nil to skip typechecking of initforms if nil. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
306 :custom-groups - List of custom group names. Organizes slots into |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
307 reasonable groups for customizations. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
308 :abstract - Non-nil to prevent instances of this class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
309 If a string, use as an error string if someone does |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
310 try to make an instance. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
311 :method-invocation-order |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
312 - Control the method invokation order if there is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
313 multiple inheritance. Valid values are: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
314 :breadth-first - The default. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
315 :depth-first |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
316 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
317 Options in CLOS not supported in EIEIO: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
318 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
319 :metaclass - Class to use in place of `standard-class' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
320 :default-initargs - Initargs to use when initializing new objects of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
321 this class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
322 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
323 Due to the way class options are set up, you can add any tags in you |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
324 wish, and reference them using the function `class-option'." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
325 ;; We must `eval-and-compile' this so that when we byte compile |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
326 ;; an eieio program, there is no need to load it ahead of time. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
327 ;; It also provides lots of nice debugging errors at compile time. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
328 `(eval-and-compile |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
329 (eieio-defclass ',name ',superclass ',slots ',options-and-doc))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
330 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
331 (defvar eieio-defclass-autoload-map (make-vector 7 nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
332 "Symbol map of superclasses we find in autoloads.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
333 |
104487
5fabb7947fa5
* emacs-lisp/autoload.el (make-autoload): Handle defclass form.
Chong Yidong <cyd@stupidchicken.com>
parents:
104431
diff
changeset
|
334 ;;;###autoload |
104431
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
335 (defun eieio-defclass-autoload (cname superclasses filename doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
336 "Create autoload symbols for the EIEIO class CNAME. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
337 SUPERCLASSES are the superclasses that CNAME inherites from. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
338 DOC is the docstring for CNAME. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
339 This function creates a mock-class for CNAME and adds it into |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
340 SUPERCLASSES as children. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
341 It creates an autoload function for CNAME's constructor." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
342 ;; Assume we've already debugged inputs. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
343 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
344 (let* ((oldc (when (class-p cname) (class-v cname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
345 (newc (make-vector class-num-slots nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
346 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
347 (if oldc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
348 nil ;; Do nothing if we already have this class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
349 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
350 ;; Create the class in NEWC, but don't fill anything else in. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
351 (aset newc 0 'defclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
352 (aset newc class-symbol cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
353 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
354 (let ((clear-parent nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
355 ;; No parents? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
356 (when (not superclasses) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
357 (setq superclasses '(eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
358 clear-parent t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
359 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
360 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
361 ;; Hook our new class into the existing structures so we can |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
362 ;; autoload it later. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
363 (dolist (SC superclasses) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
364 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
365 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
366 ;; TODO - If we create an autoload that is in the map, that |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
367 ;; map needs to be cleared! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
368 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
369 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
370 ;; Does our parent exist? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
371 (if (not (class-p SC)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
372 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
373 ;; Create a symbol for this parent, and then store this |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
374 ;; parent on that symbol. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
375 (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
376 (if (not (boundp sym)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
377 (set sym (list cname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
378 (add-to-list sym cname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
379 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
380 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
381 ;; We have a parent, save the child in there. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
382 (when (not (member cname (aref (class-v SC) class-children))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
383 (aset (class-v SC) class-children |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
384 (cons cname (aref (class-v SC) class-children))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
385 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
386 ;; save parent in child |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
387 (aset newc class-parent (cons SC (aref newc class-parent))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
388 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
389 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
390 ;; turn this into a useable self-pointing symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
391 (set cname cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
392 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
393 ;; Store the new class vector definition into the symbol. We need to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
394 ;; do this first so that we can call defmethod for the accessor. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
395 ;; The vector will be updated by the following while loop and will not |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
396 ;; need to be stored a second time. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
397 (put cname 'eieio-class-definition newc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
398 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
399 ;; Clear the parent |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
400 (if clear-parent (aset newc class-parent nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
401 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
402 ;; Create an autoload on top of our constructor function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
403 (autoload cname filename doc nil nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
404 (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
405 (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
406 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
407 )))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
408 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
409 (defsubst eieio-class-un-autoload (cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
410 "If class CNAME is in an autoload state, load it's file." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
411 (when (eq (car-safe (symbol-function cname)) 'autoload) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
412 (load-library (car (cdr (symbol-function cname)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
413 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
414 (defun eieio-defclass (cname superclasses slots options-and-doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
415 "See `defclass' for more information. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
416 Define CNAME as a new subclass of SUPERCLASSES, with SLOTS being the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
417 slots residing in that class definition, and with options or documentation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
418 OPTIONS-AND-DOC as the toplevel documentation for this class." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
419 ;; Run our eieio-hook each time, and clear it when we are done. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
420 ;; This way people can add hooks safely if they want to modify eieio |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
421 ;; or add definitions when eieio is loaded or something like that. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
422 (run-hooks 'eieio-hook) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
423 (setq eieio-hook nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
424 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
425 (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
426 (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
427 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
428 (let* ((pname (if superclasses superclasses nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
429 (newc (make-vector class-num-slots nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
430 (oldc (when (class-p cname) (class-v cname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
431 (groups nil) ;; list of groups id'd from slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
432 (options nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
433 (clearparent nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
434 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
435 (aset newc 0 'defclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
436 (aset newc class-symbol cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
437 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
438 ;; If this class already existed, and we are updating it's structure, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
439 ;; make sure we keep the old child list. This can cause bugs, but |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
440 ;; if no new slots are created, it also saves time, and prevents |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
441 ;; method table breakage, particularly when the users is only |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
442 ;; byte compiling an EIEIO file. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
443 (if oldc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
444 (aset newc class-children (aref oldc class-children)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
445 ;; If the old class did not exist, but did exist in the autoload map, then adopt those children. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
446 ;; This is like the above, but deals with autoloads nicely. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
447 (let ((sym (intern-soft (symbol-name cname) eieio-defclass-autoload-map))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
448 (when sym |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
449 (condition-case nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
450 (aset newc class-children (symbol-value sym)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
451 (error nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
452 (unintern (symbol-name cname) eieio-defclass-autoload-map) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
453 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
454 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
455 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
456 (cond ((and (stringp (car options-and-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
457 (/= 1 (% (length options-and-doc) 2))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
458 (error "Too many arguments to `defclass'")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
459 ((and (symbolp (car options-and-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
460 (/= 0 (% (length options-and-doc) 2))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
461 (error "Too many arguments to `defclass'")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
462 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
463 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
464 (setq options |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
465 (if (stringp (car options-and-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
466 (cons :documentation options-and-doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
467 options-and-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
468 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
469 (if pname |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
470 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
471 (while pname |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
472 (if (and (car pname) (symbolp (car pname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
473 (if (not (class-p (car pname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
474 ;; bad class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
475 (error "Given parent class %s is not a class" (car pname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
476 ;; good parent class... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
477 ;; save new child in parent |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
478 (when (not (member cname (aref (class-v (car pname)) class-children))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
479 (aset (class-v (car pname)) class-children |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
480 (cons cname (aref (class-v (car pname)) class-children)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
481 ;; Get custom groups, and store them into our local copy. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
482 (mapc (lambda (g) (add-to-list 'groups g)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
483 (class-option (car pname) :custom-groups)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
484 ;; save parent in child |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
485 (aset newc class-parent (cons (car pname) (aref newc class-parent)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
486 (error "Invalid parent class %s" pname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
487 (setq pname (cdr pname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
488 ;; Reverse the list of our parents so that they are prioritized in |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
489 ;; the same order as specified in the code. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
490 (aset newc class-parent (nreverse (aref newc class-parent))) ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
491 ;; If there is nothing to loop over, then inherit from the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
492 ;; default superclass. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
493 (unless (eq cname 'eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
494 ;; adopt the default parent here, but clear it later... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
495 (setq clearparent t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
496 ;; save new child in parent |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
497 (if (not (member cname (aref (class-v 'eieio-default-superclass) class-children))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
498 (aset (class-v 'eieio-default-superclass) class-children |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
499 (cons cname (aref (class-v 'eieio-default-superclass) class-children)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
500 ;; save parent in child |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
501 (aset newc class-parent (list eieio-default-superclass)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
502 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
503 ;; turn this into a useable self-pointing symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
504 (set cname cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
505 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
506 ;; These two tests must be created right away so we can have self- |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
507 ;; referencing classes. ei, a class whose slot can contain only |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
508 ;; pointers to itself. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
509 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
510 ;; Create the test function |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
511 (let ((csym (intern (concat (symbol-name cname) "-p")))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
512 (fset csym |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
513 (list 'lambda (list 'obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
514 (format "Test OBJ to see if it an object of type %s" cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
515 (list 'and '(eieio-object-p obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
516 (list 'same-class-p 'obj cname))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
517 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
518 ;; Make sure the method invocation order is a valid value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
519 (let ((io (class-option-assoc options :method-invocation-order))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
520 (when (and io (not (member io '(:depth-first :breadth-first)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
521 (error "Method invocation order %s is not allowed" io) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
522 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
523 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
524 ;; Create a handy child test too |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
525 (let ((csym (intern (concat (symbol-name cname) "-child-p")))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
526 (fset csym |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
527 `(lambda (obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
528 ,(format |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
529 "Test OBJ to see if it an object is a child of type %s" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
530 cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
531 (and (eieio-object-p obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
532 (object-of-class-p obj ,cname)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
533 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
534 ;; When using typep, (typep OBJ 'myclass) returns t for objects which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
535 ;; are subclasses of myclass. For our predicates, however, it is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
536 ;; important for EIEIO to be backwards compatible, where |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
537 ;; myobject-p, and myobject-child-p are different. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
538 ;; "cl" uses this technique to specify symbols with specific typep |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
539 ;; test, so we can let typep have the CLOS documented behavior |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
540 ;; while keeping our above predicate clean. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
541 (eval `(deftype ,cname () |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
542 '(satisfies |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
543 ,(intern (concat (symbol-name cname) "-child-p"))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
544 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
545 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
546 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
547 ;; before adding new slots, lets add all the methods and classes |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
548 ;; in from the parent class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
549 (eieio-copy-parents-into-subclass newc superclasses) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
550 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
551 ;; Store the new class vector definition into the symbol. We need to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
552 ;; do this first so that we can call defmethod for the accessor. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
553 ;; The vector will be updated by the following while loop and will not |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
554 ;; need to be stored a second time. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
555 (put cname 'eieio-class-definition newc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
556 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
557 ;; Query each slot in the declaration list and mangle into the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
558 ;; class structure I have defined. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
559 (while slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
560 (let* ((slot1 (car slots)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
561 (name (car slot1)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
562 (slot (cdr slot1)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
563 (acces (plist-get slot ':accessor)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
564 (init (or (plist-get slot ':initform) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
565 (if (member ':initform slot) nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
566 eieio-unbound))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
567 (initarg (plist-get slot ':initarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
568 (docstr (plist-get slot ':documentation)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
569 (prot (plist-get slot ':protection)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
570 (reader (plist-get slot ':reader)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
571 (writer (plist-get slot ':writer)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
572 (alloc (plist-get slot ':allocation)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
573 (type (plist-get slot ':type)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
574 (custom (plist-get slot ':custom)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
575 (label (plist-get slot ':label)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
576 (customg (plist-get slot ':group)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
577 (printer (plist-get slot ':printer)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
578 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
579 (skip-nil (class-option-assoc options :allow-nil-initform)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
580 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
581 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
582 (if eieio-error-unsupported-class-tags |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
583 (let ((tmp slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
584 (while tmp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
585 (if (not (member (car tmp) '(:accessor |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
586 :initform |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
587 :initarg |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
588 :documentation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
589 :protection |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
590 :reader |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
591 :writer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
592 :allocation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
593 :type |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
594 :custom |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
595 :label |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
596 :group |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
597 :printer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
598 :allow-nil-initform |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
599 :custom-groups))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
600 (signal 'invalid-slot-type (list (car tmp)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
601 (setq tmp (cdr (cdr tmp)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
602 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
603 ;; Clean up the meaning of protection. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
604 (cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
605 ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
606 ((or (eq prot 'private) (eq prot :private)) (setq prot 'private)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
607 ((eq prot nil) nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
608 (t (signal 'invalid-slot-type (list ':protection prot)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
609 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
610 ;; Make sure the :allocation parameter has a valid value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
611 (if (not (or (not alloc) (eq alloc :class) (eq alloc :instance))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
612 (signal 'invalid-slot-type (list ':allocation alloc))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
613 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
614 ;; The default type specifier is supposed to be t, meaning anything. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
615 (if (not type) (setq type t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
616 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
617 ;; Label is nil, or a string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
618 (if (not (or (null label) (stringp label))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
619 (signal 'invalid-slot-type (list ':label label))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
620 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
621 ;; Is there an initarg, but allocation of class? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
622 (if (and initarg (eq alloc :class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
623 (message "Class allocated slots do not need :initarg")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
624 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
625 ;; intern the symbol so we can use it blankly |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
626 (if initarg (set initarg initarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
627 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
628 ;; The customgroup should be a list of symbols |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
629 (cond ((null customg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
630 (setq customg '(default))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
631 ((not (listp customg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
632 (setq customg (list customg)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
633 ;; The customgroup better be a symbol, or list of symbols. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
634 (mapc (lambda (cg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
635 (if (not (symbolp cg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
636 (signal 'invalid-slot-type (list ':group cg)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
637 customg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
638 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
639 ;; First up, add this slot into our new class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
640 (eieio-add-new-slot newc name init docstr type custom label customg printer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
641 prot initarg alloc 'defaultoverride skip-nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
642 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
643 ;; We need to id the group, and store them in a group list attribute. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
644 (mapc (lambda (cg) (add-to-list 'groups cg)) customg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
645 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
646 ;; anyone can have an accessor function. This creates a function |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
647 ;; of the specified name, and also performs a `defsetf' if applicable |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
648 ;; so that users can `setf' the space returned by this function |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
649 (if acces |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
650 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
651 (eieio-defmethod acces |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
652 (list (if (eq alloc :class) :static :primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
653 (list (list 'this cname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
654 (format |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
655 "Retrieves the slot `%s' from an object of class `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
656 name cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
657 (list 'if (list 'slot-boundp 'this (list 'quote name)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
658 (list 'eieio-oref 'this (list 'quote name)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
659 ;; Else - Some error? nil? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
660 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
661 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
662 ;; Thanks Pascal Bourguignon <pjb@informatimago.com> |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
663 ;; For this complex macro. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
664 (eval (macroexpand |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
665 (list 'defsetf acces '(widget) '(store) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
666 (list 'list ''eieio-oset 'widget |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
667 (list 'quote (list 'quote name)) 'store)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
668 ;;`(defsetf ,acces (widget) (store) (eieio-oset widget ',cname store)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
669 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
670 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
671 ;; If a writer is defined, then create a generic method of that |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
672 ;; name whose purpose is to set the value of the slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
673 (if writer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
674 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
675 (eieio-defmethod writer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
676 (list (list (list 'this cname) 'value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
677 (format "Set the slot `%s' of an object of class `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
678 name cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
679 `(setf (slot-value this ',name) value))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
680 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
681 ;; If a reader is defined, then create a generic method |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
682 ;; of that name whose purpose is to access this slot value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
683 (if reader |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
684 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
685 (eieio-defmethod reader |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
686 (list (list (list 'this cname)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
687 (format "Access the slot `%s' from object of class `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
688 name cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
689 `(slot-value this ',name))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
690 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
691 (setq slots (cdr slots))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
692 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
693 ;; Now that everything has been loaded up, all our lists are backwards! Fix that up now. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
694 (aset newc class-public-a (nreverse (aref newc class-public-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
695 (aset newc class-public-d (nreverse (aref newc class-public-d))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
696 (aset newc class-public-doc (nreverse (aref newc class-public-doc))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
697 (aset newc class-public-type |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
698 (apply 'vector (nreverse (aref newc class-public-type)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
699 (aset newc class-public-custom (nreverse (aref newc class-public-custom))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
700 (aset newc class-public-custom-label (nreverse (aref newc class-public-custom-label))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
701 (aset newc class-public-custom-group (nreverse (aref newc class-public-custom-group))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
702 (aset newc class-public-printer (nreverse (aref newc class-public-printer))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
703 (aset newc class-protection (nreverse (aref newc class-protection))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
704 (aset newc class-initarg-tuples (nreverse (aref newc class-initarg-tuples))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
705 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
706 ;; The storage for class-class-allocation-type needs to be turned into |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
707 ;; a vector now. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
708 (aset newc class-class-allocation-type |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
709 (apply 'vector (aref newc class-class-allocation-type))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
710 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
711 ;; Also, take class allocated values, and vectorize them for speed. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
712 (aset newc class-class-allocation-values |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
713 (apply 'vector (aref newc class-class-allocation-values))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
714 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
715 ;; Attach slot symbols into an obarray, and store the index of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
716 ;; this slot as the variable slot in this new symbol. We need to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
717 ;; know about primes, because obarrays are best set in vectors of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
718 ;; prime number length, and we also need to make our vector small |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
719 ;; to save space, and also optimal for the number of items we have. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
720 (let* ((cnt 0) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
721 (pubsyms (aref newc class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
722 (prots (aref newc class-protection)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
723 (l (length pubsyms)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
724 (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
725 53 59 61 67 71 73 79 83 89 97 101 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
726 (while (and primes (< (car primes) l)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
727 (setq primes (cdr primes))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
728 (car primes))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
729 (oa (make-vector vl 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
730 (newsym)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
731 (while pubsyms |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
732 (setq newsym (intern (symbol-name (car pubsyms)) oa)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
733 (set newsym cnt) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
734 (setq cnt (1+ cnt)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
735 (if (car prots) (put newsym 'protection (car prots))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
736 (setq pubsyms (cdr pubsyms) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
737 prots (cdr prots))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
738 (aset newc class-symbol-obarray oa) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
739 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
740 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
741 ;; Create the constructor function |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
742 (if (class-option-assoc options :abstract) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
743 ;; Abstract classes cannot be instantiated. Say so. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
744 (let ((abs (class-option-assoc options :abstract))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
745 (if (not (stringp abs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
746 (setq abs (format "Class %s is abstract" cname))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
747 (fset cname |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
748 `(lambda (&rest stuff) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
749 ,(format "You cannot create a new object of type %s" cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
750 (error ,abs)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
751 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
752 ;; Non-abstract classes need a constructor. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
753 (fset cname |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
754 `(lambda (newname &rest slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
755 ,(format "Create a new object with name NAME of class type %s" cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
756 (apply 'constructor ,cname newname slots))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
757 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
758 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
759 ;; Set up a specialized doc string. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
760 ;; Use stored value since it is calculated in a non-trivial way |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
761 (put cname 'variable-documentation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
762 (class-option-assoc options :documentation)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
763 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
764 ;; We have a list of custom groups. Store them into the options. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
765 (let ((g (class-option-assoc options :custom-groups))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
766 (mapc (lambda (cg) (add-to-list 'g cg)) groups) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
767 (if (memq :custom-groups options) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
768 (setcar (cdr (memq :custom-groups options)) g) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
769 (setq options (cons :custom-groups (cons g options))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
770 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
771 ;; Set up the options we have collected. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
772 (aset newc class-options options) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
773 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
774 ;; if this is a superclass, clear out parent (which was set to the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
775 ;; default superclass eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
776 (if clearparent (aset newc class-parent nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
777 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
778 ;; Create the cached default object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
779 (let ((cache (make-vector (+ (length (aref newc class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
780 3) nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
781 (aset cache 0 'object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
782 (aset cache object-class cname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
783 (aset cache object-name 'default-cache-object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
784 (let ((eieio-skip-typecheck t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
785 ;; All type-checking has been done to our satisfaction |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
786 ;; before this call. Don't waste our time in this call.. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
787 (eieio-set-defaults cache t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
788 (aset newc class-default-object-cache cache)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
789 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
790 ;; Return our new class object |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
791 ;; newc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
792 cname |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
793 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
794 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
795 (defun eieio-perform-slot-validation-for-default (slot spec value skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
796 "For SLOT, signal if SPEC does not match VALUE. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
797 If SKIPNIL is non-nil, then if VALUE is nil, return t." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
798 (let ((val (eieio-default-eval-maybe value))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
799 (if (and (not eieio-skip-typecheck) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
800 (not (and skipnil (null val))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
801 (not (eieio-perform-slot-validation spec val))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
802 (signal 'invalid-slot-type (list slot spec val))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
803 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
804 (defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
805 &optional defaultoverride skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
806 "Add into NEWC attribute A. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
807 If A already exists in NEWC, then do nothing. If it doesn't exist, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
808 then also add in D (defualt), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
809 Argument ALLOC specifies if the slot is allocated per instance, or per class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
810 If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
811 we must override it's value for a default. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
812 Optional argument SKIPNIL indicates if type checking should be skipped |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
813 if default value is nil." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
814 ;; Make sure we duplicate those items that are sequences. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
815 (condition-case nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
816 (if (sequencep d) (setq d (copy-sequence d))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
817 ;; This copy can fail on a cons cell with a non-cons in the cdr. Lets skip it if it doesn't work. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
818 (error nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
819 (if (sequencep type) (setq type (copy-sequence type))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
820 (if (sequencep cust) (setq cust (copy-sequence cust))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
821 (if (sequencep custg) (setq custg (copy-sequence custg))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
822 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
823 ;; To prevent override information w/out specification of storage, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
824 ;; we need to do this little hack. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
825 (if (member a (aref newc class-class-allocation-a)) (setq alloc ':class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
826 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
827 (if (or (not alloc) (and (symbolp alloc) (eq alloc ':instance))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
828 ;; In this case, we modify the INSTANCE version of a given slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
829 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
830 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
831 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
832 ;; Only add this element if it is so-far unique |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
833 (if (not (member a (aref newc class-public-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
834 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
835 (eieio-perform-slot-validation-for-default a type d skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
836 (aset newc class-public-a (cons a (aref newc class-public-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
837 (aset newc class-public-d (cons d (aref newc class-public-d))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
838 (aset newc class-public-doc (cons doc (aref newc class-public-doc))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
839 (aset newc class-public-type (cons type (aref newc class-public-type))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
840 (aset newc class-public-custom (cons cust (aref newc class-public-custom))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
841 (aset newc class-public-custom-label (cons label (aref newc class-public-custom-label))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
842 (aset newc class-public-custom-group (cons custg (aref newc class-public-custom-group))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
843 (aset newc class-public-printer (cons print (aref newc class-public-printer))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
844 (aset newc class-protection (cons prot (aref newc class-protection))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
845 (aset newc class-initarg-tuples (cons (cons init a) (aref newc class-initarg-tuples))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
846 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
847 ;; When defaultoverride is true, we are usually adding new local |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
848 ;; attributes which must override the default value of any slot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
849 ;; passed in by one of the parent classes. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
850 (when defaultoverride |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
851 ;; There is a match, and we must override the old value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
852 (let* ((ca (aref newc class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
853 (np (member a ca)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
854 (num (- (length ca) (length np))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
855 (dp (if np (nthcdr num (aref newc class-public-d)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
856 nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
857 (tp (if np (nth num (aref newc class-public-type)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
858 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
859 (if (not np) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
860 (error "Eieio internal error overriding default value for %s" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
861 a) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
862 ;; If type is passed in, is it the same? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
863 (if (not (eq type t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
864 (if (not (equal type tp)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
865 (error |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
866 "Child slot type `%s' does not match inherited type `%s' for `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
867 type tp a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
868 ;; If we have a repeat, only update the initarg... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
869 (unless (eq d eieio-unbound) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
870 (eieio-perform-slot-validation-for-default a tp d skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
871 (setcar dp d)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
872 ;; If we have a new initarg, check for it. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
873 (when init |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
874 (let* ((inits (aref newc class-initarg-tuples)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
875 (inita (rassq a inits))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
876 ;; Replace the CAR of the associate INITA. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
877 ;;(message "Initarg: %S replace %s" inita init) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
878 (setcar inita init) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
879 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
880 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
881 ;; PLN Tue Jun 26 11:57:06 2007 : The protection is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
882 ;; checked and SHOULD match the superclass |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
883 ;; protection. Otherwise an error is thrown. However |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
884 ;; I wonder if a more flexible schedule might be |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
885 ;; implemented. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
886 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
887 ;; EML - We used to have (if prot... here, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
888 ;; but a prot of 'nil means public. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
889 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
890 (let ((super-prot (nth num (aref newc class-protection))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
891 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
892 (if (not (eq prot super-prot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
893 (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
894 prot super-prot a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
895 ;; End original PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
896 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
897 ;; PLN Tue Jun 26 11:57:06 2007 : |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
898 ;; We do a non redundant combination of ancient |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
899 ;; custom groups and new ones using the common lisp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
900 ;; `union' method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
901 (when custg |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
902 (let ((where-groups |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
903 (nthcdr num (aref newc class-public-custom-group)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
904 (setcar where-groups |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
905 (union (car where-groups) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
906 (if (listp custg) custg (list custg)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
907 ;; End PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
908 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
909 ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
910 ;; set, simply replaces the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
911 (when cust |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
912 ;; (message "Custom type redefined to %s" cust) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
913 (setcar (nthcdr num (aref newc class-public-custom)) cust)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
914 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
915 ;; If a new label is specified, it simply replaces |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
916 ;; the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
917 (when label |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
918 ;; (message "Custom label redefined to %s" label) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
919 (setcar (nthcdr num (aref newc class-public-custom-label)) label)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
920 ;; End PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
921 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
922 ;; PLN Sat Jun 30 17:24:42 2007 : when a new |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
923 ;; doc is specified, simply replaces the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
924 (when doc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
925 ;;(message "Documentation redefined to %s" doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
926 (setcar (nthcdr num (aref newc class-public-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
927 doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
928 ;; End PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
929 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
930 ;; If a new printer is specified, it simply replaces |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
931 ;; the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
932 (when print |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
933 ;; (message "printer redefined to %s" print) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
934 (setcar (nthcdr num (aref newc class-public-printer)) print)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
935 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
936 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
937 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
938 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
939 ;; CLASS ALLOCATED SLOTS |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
940 (let ((value (eieio-default-eval-maybe d))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
941 (if (not (member a (aref newc class-class-allocation-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
942 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
943 (eieio-perform-slot-validation-for-default a type value skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
944 ;; Here we have found a :class version of a slot. This |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
945 ;; requires a very different aproach. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
946 (aset newc class-class-allocation-a (cons a (aref newc class-class-allocation-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
947 (aset newc class-class-allocation-doc (cons doc (aref newc class-class-allocation-doc))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
948 (aset newc class-class-allocation-type (cons type (aref newc class-class-allocation-type))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
949 (aset newc class-class-allocation-custom (cons cust (aref newc class-class-allocation-custom))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
950 (aset newc class-class-allocation-custom-label (cons label (aref newc class-class-allocation-custom-label))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
951 (aset newc class-class-allocation-custom-group (cons custg (aref newc class-class-allocation-custom-group))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
952 (aset newc class-class-allocation-protection (cons prot (aref newc class-class-allocation-protection))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
953 ;; Default value is stored in the 'values section, since new objects |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
954 ;; can't initialize from this element. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
955 (aset newc class-class-allocation-values (cons value (aref newc class-class-allocation-values)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
956 (when defaultoverride |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
957 ;; There is a match, and we must override the old value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
958 (let* ((ca (aref newc class-class-allocation-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
959 (np (member a ca)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
960 (num (- (length ca) (length np))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
961 (dp (if np |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
962 (nthcdr num |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
963 (aref newc class-class-allocation-values)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
964 nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
965 (tp (if np (nth num (aref newc class-class-allocation-type)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
966 nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
967 (if (not np) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
968 (error "Eieio internal error overriding default value for %s" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
969 a) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
970 ;; If type is passed in, is it the same? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
971 (if (not (eq type t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
972 (if (not (equal type tp)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
973 (error |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
974 "Child slot type `%s' does not match inherited type `%s' for `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
975 type tp a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
976 ;; EML - Note: the only reason to override a class bound slot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
977 ;; is to change the default, so allow unbound in. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
978 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
979 ;; If we have a repeat, only update the vlaue... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
980 (eieio-perform-slot-validation-for-default a tp value skipnil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
981 (setcar dp value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
982 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
983 ;; PLN Tue Jun 26 11:57:06 2007 : The protection is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
984 ;; checked and SHOULD match the superclass |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
985 ;; protection. Otherwise an error is thrown. However |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
986 ;; I wonder if a more flexible schedule might be |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
987 ;; implemented. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
988 (let ((super-prot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
989 (car (nthcdr num (aref newc class-class-allocation-protection))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
990 (if (not (eq prot super-prot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
991 (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
992 prot super-prot a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
993 ;; We do a non redundant combination of ancient |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
994 ;; custom groups and new ones using the common lisp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
995 ;; `union' method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
996 (when custg |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
997 (let ((where-groups |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
998 (nthcdr num (aref newc class-class-allocation-custom-group)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
999 (setcar where-groups |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1000 (union (car where-groups) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1001 (if (listp custg) custg (list custg)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1002 ;; End PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1003 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1004 ;; PLN Sat Jun 30 17:24:42 2007 : when a new |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1005 ;; doc is specified, simply replaces the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1006 (when doc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1007 ;;(message "Documentation redefined to %s" doc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1008 (setcar (nthcdr num (aref newc class-class-allocation-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1009 doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1010 ;; End PLN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1011 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1012 ;; If a new printer is specified, it simply replaces |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1013 ;; the old one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1014 (when print |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1015 ;; (message "printer redefined to %s" print) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1016 (setcar (nthcdr num (aref newc class-class-allocation-printer)) print)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1017 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1018 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1019 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1020 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1021 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1022 (defun eieio-copy-parents-into-subclass (newc parents) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1023 "Copy into NEWC the slots of PARENTS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1024 Follow the rules of not overwritting early parents when applying to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1025 the new child class." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1026 (let ((ps (aref newc class-parent)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1027 (sn (class-option-assoc (aref newc class-options) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1028 ':allow-nil-initform))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1029 (while ps |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1030 ;; First, duplicate all the slots of the parent. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1031 (let ((pcv (class-v (car ps)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1032 (let ((pa (aref pcv class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1033 (pd (aref pcv class-public-d)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1034 (pdoc (aref pcv class-public-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1035 (ptype (aref pcv class-public-type)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1036 (pcust (aref pcv class-public-custom)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1037 (plabel (aref pcv class-public-custom-label)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1038 (pcustg (aref pcv class-public-custom-group)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1039 (printer (aref pcv class-public-printer)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1040 (pprot (aref pcv class-protection)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1041 (pinit (aref pcv class-initarg-tuples)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1042 (i 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1043 (while pa |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1044 (eieio-add-new-slot newc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1045 (car pa) (car pd) (car pdoc) (aref ptype i) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1046 (car pcust) (car plabel) (car pcustg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1047 (car printer) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1048 (car pprot) (car-safe (car pinit)) nil nil sn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1049 ;; Increment each value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1050 (setq pa (cdr pa) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1051 pd (cdr pd) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1052 pdoc (cdr pdoc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1053 i (1+ i) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1054 pcust (cdr pcust) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1055 plabel (cdr plabel) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1056 pcustg (cdr pcustg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1057 printer (cdr printer) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1058 pprot (cdr pprot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1059 pinit (cdr pinit)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1060 )) ;; while/let |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1061 ;; Now duplicate all the class alloc slots. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1062 (let ((pa (aref pcv class-class-allocation-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1063 (pdoc (aref pcv class-class-allocation-doc)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1064 (ptype (aref pcv class-class-allocation-type)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1065 (pcust (aref pcv class-class-allocation-custom)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1066 (plabel (aref pcv class-class-allocation-custom-label)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1067 (pcustg (aref pcv class-class-allocation-custom-group)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1068 (printer (aref pcv class-class-allocation-printer)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1069 (pprot (aref pcv class-class-allocation-protection)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1070 (pval (aref pcv class-class-allocation-values)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1071 (i 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1072 (while pa |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1073 (eieio-add-new-slot newc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1074 (car pa) (aref pval i) (car pdoc) (aref ptype i) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1075 (car pcust) (car plabel) (car pcustg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1076 (car printer) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1077 (car pprot) nil ':class sn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1078 ;; Increment each value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1079 (setq pa (cdr pa) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1080 pdoc (cdr pdoc) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1081 pcust (cdr pcust) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1082 plabel (cdr plabel) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1083 pcustg (cdr pcustg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1084 printer (cdr printer) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1085 pprot (cdr pprot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1086 i (1+ i)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1087 ))) ;; while/let |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1088 ;; Loop over each parent class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1089 (setq ps (cdr ps))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1090 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1091 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1092 ;;; CLOS style implementation of object creators. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1093 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1094 (defun make-instance (class &rest initargs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1095 "Make a new instance of CLASS based on INITARGS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1096 CLASS is a class symbol. For example: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1097 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1098 (make-instance 'foo) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1099 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1100 INITARGS is a property list with keywords based on the :initarg |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1101 for each slot. For example: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1102 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1103 (make-instance 'foo :slot1 value1 :slotN valueN) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1104 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1105 Compatability note: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1106 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1107 If the first element of INITARGS is a string, it is used as the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1108 name of the class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1109 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1110 In EIEIO, the class' constructor requires a name for use when printing. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1111 `make-instance' in CLOS doesn't use names the way Emacs does, so the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1112 class is used as the name slot instead when INITARGS doesn't start with |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1113 a string." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1114 (if (and (car initargs) (stringp (car initargs))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1115 (apply (class-constructor class) initargs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1116 (apply (class-constructor class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1117 (cond ((symbolp class) (symbol-name class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1118 (t (format "%S" class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1119 initargs))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1120 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1121 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1122 ;;; CLOS methods and generics |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1123 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1124 (defmacro defgeneric (method args &optional doc-string) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1125 "Create a generic function METHOD. ARGS is ignored. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1126 DOC-STRING is the base documentation for this class. A generic |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1127 function has no body, as it's purpose is to decide which method body |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1128 is appropriate to use. Use `defmethod' to create methods, and it |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1129 calls defgeneric for you. With this implementation the arguments are |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1130 currently ignored. You can use `defgeneric' to apply specialized |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1131 top level documentation to a method." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1132 `(eieio-defgeneric (quote ,method) ,doc-string)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1133 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1134 (defun eieio-defgeneric-form (method doc-string) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1135 "The lambda form that would be used as the function defined on METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1136 All methods should call the same EIEIO function for dispatch. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1137 DOC-STRING is the documentation attached to METHOD." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1138 `(lambda (&rest local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1139 ,doc-string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1140 (eieio-generic-call (quote ,method) local-args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1141 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1142 (defsubst eieio-defgeneric-reset-generic-form (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1143 "Setup METHOD to call the generic form." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1144 (let ((doc-string (documentation method))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1145 (fset method (eieio-defgeneric-form method doc-string)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1146 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1147 (defun eieio-defgeneric-form-primary-only (method doc-string) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1148 "The lambda form that would be used as the function defined on METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1149 All methods should call the same EIEIO function for dispatch. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1150 DOC-STRING is the documentation attached to METHOD." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1151 `(lambda (&rest local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1152 ,doc-string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1153 (eieio-generic-call-primary-only (quote ,method) local-args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1154 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1155 (defsubst eieio-defgeneric-reset-generic-form-primary-only (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1156 "Setup METHOD to call the generic form." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1157 (let ((doc-string (documentation method))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1158 (fset method (eieio-defgeneric-form-primary-only method doc-string)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1159 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1160 (defun eieio-defgeneric-form-primary-only-one (method doc-string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1161 class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1162 impl |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1163 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1164 "The lambda form that would be used as the function defined on METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1165 All methods should call the same EIEIO function for dispatch. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1166 DOC-STRING is the documentation attached to METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1167 CLASS is the class symbol needed for private method access. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1168 IMPL is the symbol holding the method implementation." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1169 ;; NOTE: I tried out byte compiling this little fcn. Turns out it |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1170 ;; is faster to execute this for not byte-compiled. ie, install this, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1171 ;; then measure calls going through here. I wonder why. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1172 (require 'bytecomp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1173 (let ((byte-compile-free-references nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1174 (byte-compile-warnings nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1175 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1176 (byte-compile-lambda |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1177 `(lambda (&rest local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1178 ,doc-string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1179 ;; This is a cool cheat. Usually we need to look up in the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1180 ;; method table to find out if there is a method or not. We can |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1181 ;; instead make that determination at load time when there is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1182 ;; only one method. If the first arg is not a child of the class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1183 ;; of that one implementation, then clearly, there is no method def. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1184 (if (not (eieio-object-p (car local-args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1185 ;; Not an object. Just signal. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1186 (signal 'no-method-definition (list ,(list 'quote method) local-args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1187 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1188 ;; We do have an object. Make sure it is the right type. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1189 (if ,(if (eq class eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1190 nil ; default superclass means just an obj. Already asked. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1191 `(not (child-of-class-p (aref (car local-args) object-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1192 ,(list 'quote class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1193 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1194 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1195 ;; If not the right kind of object, call no applicable |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1196 (apply 'no-applicable-method (car local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1197 ,(list 'quote method) local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1198 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1199 ;; It is ok, do the call. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1200 ;; Fill in inter-call variables then evaluate the method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1201 (let ((scoped-class ,(list 'quote class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1202 (eieio-generic-call-next-method-list nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1203 (eieio-generic-call-key method-primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1204 (eieio-generic-call-methodname ,(list 'quote method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1205 (eieio-generic-call-arglst local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1206 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1207 (apply ,(list 'quote impl) local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1208 ;(,impl local-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1209 )))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1210 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1211 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1212 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1213 (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1214 "Setup METHOD to call the generic form." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1215 (let* ((doc-string (documentation method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1216 (M (get method 'eieio-method-tree)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1217 (entry (car (aref M method-primary))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1218 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1219 (fset method (eieio-defgeneric-form-primary-only-one |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1220 method doc-string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1221 (car entry) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1222 (cdr entry) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1223 )))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1224 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1225 (defun eieio-defgeneric (method doc-string) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1226 "Engine part to `defgeneric' macro defining METHOD with DOC-STRING." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1227 (if (and (fboundp method) (not (generic-p method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1228 (or (byte-code-function-p (symbol-function method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1229 (not (eq 'autoload (car (symbol-function method))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1230 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1231 (error "You cannot create a generic/method over an existing symbol: %s" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1232 method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1233 ;; Don't do this over and over. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1234 (unless (fboundp 'method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1235 ;; This defun tells emacs where the first definition of this |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1236 ;; method is defined. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1237 `(defun ,method nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1238 ;; Make sure the method tables are installed. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1239 (eieiomt-install method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1240 ;; Apply the actual body of this function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1241 (fset method (eieio-defgeneric-form method doc-string)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1242 ;; Return the method |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1243 'method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1244 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1245 (defun eieio-unbind-method-implementations (method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1246 "Make the generic method METHOD have no implementations.. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1247 It will leave the original generic function in place, but remove |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1248 reference to all implementations of METHOD." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1249 (put method 'eieio-method-tree nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1250 (put method 'eieio-method-obarray nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1251 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1252 (defmacro defmethod (method &rest args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1253 "Create a new METHOD through `defgeneric' with ARGS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1254 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1255 The second optional argument KEY is a specifier that |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1256 modifies how the method is called, including: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1257 :before - Method will be called before the :primary |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1258 :primary - The default if not specified. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1259 :after - Method will be called after the :primary |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1260 :static - First arg could be an object or class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1261 The next argument is the ARGLIST. The ARGLIST specifies the arguments |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1262 to the method as with `defun'. The first argument can have a type |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1263 specifier, such as: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1264 ((VARNAME CLASS) ARG2 ...) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1265 where VARNAME is the name of the local variable for the method being |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1266 created. The CLASS is a class symbol for a class made with `defclass'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1267 A DOCSTRING comes after the ARGLIST, and is optional. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1268 All the rest of the args are the BODY of the method. A method will |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1269 return the value of the last form in the BODY. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1270 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1271 Summary: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1272 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1273 (defmethod mymethod [:before | :primary | :after | :static] |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1274 ((typearg class-name) arg2 &optional opt &rest rest) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1275 \"doc-string\" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1276 body)" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1277 `(eieio-defmethod (quote ,method) (quote ,args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1278 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1279 (defun eieio-defmethod (method args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1280 "Work part of the `defmethod' macro defining METHOD with ARGS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1281 (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1282 ;; find optional keys |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1283 (setq key |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1284 (cond ((or (eq ':BEFORE (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1285 (eq ':before (car args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1286 (setq args (cdr args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1287 method-before) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1288 ((or (eq ':AFTER (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1289 (eq ':after (car args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1290 (setq args (cdr args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1291 method-after) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1292 ((or (eq ':PRIMARY (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1293 (eq ':primary (car args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1294 (setq args (cdr args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1295 method-primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1296 ((or (eq ':STATIC (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1297 (eq ':static (car args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1298 (setq args (cdr args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1299 method-static) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1300 ;; Primary key |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1301 (t method-primary))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1302 ;; get body, and fix contents of args to be the arguments of the fn. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1303 (setq body (cdr args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1304 args (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1305 (setq loopa args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1306 ;; Create a fixed version of the arguments |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1307 (while loopa |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1308 (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1309 argfix)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1310 (setq loopa (cdr loopa))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1311 ;; make sure there is a generic |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1312 (eieio-defgeneric |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1313 method |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1314 (if (stringp (car body)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1315 (car body) (format "Generically created method `%s'" method))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1316 ;; create symbol for property to bind to. If the first arg is of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1317 ;; the form (varname vartype) and `vartype' is a class, then |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1318 ;; that class will be the type symbol. If not, then it will fall |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1319 ;; under the type `primary' which is a non-specific calling of the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1320 ;; function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1321 (setq firstarg (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1322 (if (listp firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1323 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1324 (setq argclass (nth 1 firstarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1325 (if (not (class-p argclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1326 (error "Unknown class type %s in method parameters" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1327 (nth 1 firstarg)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1328 (if (= key -1) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1329 (signal 'wrong-type-argument (list :static 'non-class-arg))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1330 ;; generics are higher |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1331 (setq key (+ key 3))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1332 ;; Put this lambda into the symbol so we can find it |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1333 (if (byte-code-function-p (car-safe body)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1334 (eieiomt-add method (car-safe body) key argclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1335 (eieiomt-add method (append (list 'lambda (reverse argfix)) body) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1336 key argclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1337 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1338 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1339 (when eieio-optimize-primary-methods-flag |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1340 ;; Optimizing step: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1341 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1342 ;; If this method, after this setup, only has primary methods, then |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1343 ;; we can setup the generic that way. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1344 (if (generic-primary-only-p method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1345 ;; If there is only one primary method, then we can go one more |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1346 ;; optimization step. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1347 (if (generic-primary-only-one-p method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1348 (eieio-defgeneric-reset-generic-form-primary-only-one method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1349 (eieio-defgeneric-reset-generic-form-primary-only method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1350 (eieio-defgeneric-reset-generic-form method))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1351 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1352 method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1353 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1354 ;;; Slot type validation |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1355 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1356 (defun eieio-perform-slot-validation (spec value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1357 "Return non-nil if SPEC does not match VALUE." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1358 ;; typep is in cl-macs |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1359 (or (eq spec t) ; t always passes |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1360 (eq value eieio-unbound) ; unbound always passes |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1361 (typep value spec))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1362 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1363 (defun eieio-validate-slot-value (class slot-idx value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1364 "Make sure that for CLASS referencing SLOT-IDX, that VALUE is valid. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1365 Checks the :type specifier. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1366 SLOT is the slot that is being checked, and is only used when throwing |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1367 and error." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1368 (if eieio-skip-typecheck |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1369 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1370 ;; Trim off object IDX junk added in for the object index. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1371 (setq slot-idx (- slot-idx 3)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1372 (let ((st (aref (aref (class-v class) class-public-type) slot-idx))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1373 (if (not (eieio-perform-slot-validation st value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1374 (signal 'invalid-slot-type (list class slot st value)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1375 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1376 (defun eieio-validate-class-slot-value (class slot-idx value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1377 "Make sure that for CLASS referencing SLOT-IDX, that VALUE is valid. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1378 Checks the :type specifier. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1379 SLOT is the slot that is being checked, and is only used when throwing |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1380 and error." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1381 (if eieio-skip-typecheck |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1382 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1383 (let ((st (aref (aref (class-v class) class-class-allocation-type) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1384 slot-idx))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1385 (if (not (eieio-perform-slot-validation st value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1386 (signal 'invalid-slot-type (list class slot st value)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1387 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1388 (defun eieio-barf-if-slot-unbound (value instance slotname fn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1389 "Throw a signal if VALUE is a representation of an UNBOUND slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1390 INSTANCE is the object being referenced. SLOTNAME is the offending |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1391 slot. If the slot is ok, return VALUE. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1392 Argument FN is the function calling this verifier." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1393 (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1394 (slot-unbound instance (object-class instance) slotname fn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1395 value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1396 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1397 ;;; Missing types that are useful to me. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1398 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1399 (defun boolean-p (bool) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1400 "Return non-nil if BOOL is nil or t." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1401 (or (null bool) (eq bool t))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1402 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1403 ;;; Get/Set slots in an object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1404 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1405 (defmacro oref (obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1406 "Retrieve the value stored in OBJ in the slot named by SLOT. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1407 Slot is the name of the slot when created by `defclass' or the label |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1408 created by the :initarg tag." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1409 `(eieio-oref ,obj (quote ,slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1410 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1411 (defun eieio-oref (obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1412 "Return the value in OBJ at SLOT in the object vector." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1413 (if (not (or (eieio-object-p obj) (class-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1414 (signal 'wrong-type-argument (list '(or eieio-object-p class-p) obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1415 (if (not (symbolp slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1416 (signal 'wrong-type-argument (list 'symbolp slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1417 (if (class-p obj) (eieio-class-un-autoload obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1418 (let* ((class (if (class-p obj) obj (aref obj object-class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1419 (c (eieio-slot-name-index class obj slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1420 (if (not c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1421 ;; It might be missing because it is a :class allocated slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1422 ;; Lets check that info out. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1423 (if (setq c (eieio-class-slot-name-index class slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1424 ;; Oref that slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1425 (aref (aref (class-v class) class-class-allocation-values) c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1426 ;; The slot-missing method is a cool way of allowing an object author |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1427 ;; to intercept missing slot definitions. Since it is also the LAST |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1428 ;; thing called in this fn, it's return value would be retrieved. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1429 (slot-missing obj slot 'oref) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1430 ;;(signal 'invalid-slot-name (list (object-name obj) slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1431 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1432 (if (not (eieio-object-p obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1433 (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1434 (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1435 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1436 (defalias 'slot-value 'eieio-oref) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1437 (defalias 'set-slot-value 'eieio-oset) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1438 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1439 (defmacro oref-default (obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1440 "Gets the default value of OBJ (maybe a class) for SLOT. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1441 The default value is the value installed in a class with the :initform |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1442 tag. SLOT can be the slot name, or the tag specified by the :initarg |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1443 tag in the `defclass' call." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1444 `(eieio-oref-default ,obj (quote ,slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1445 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1446 (defun eieio-oref-default (obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1447 "Does the work for the macro `oref-default' with similar parameters. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1448 Fills in OBJ's SLOT with it's default value." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1449 (if (not (or (eieio-object-p obj) (class-p obj))) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1450 (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1451 (let* ((cl (if (eieio-object-p obj) (aref obj object-class) obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1452 (c (eieio-slot-name-index cl obj slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1453 (if (not c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1454 ;; It might be missing because it is a :class allocated slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1455 ;; Lets check that info out. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1456 (if (setq c |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1457 (eieio-class-slot-name-index cl slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1458 ;; Oref that slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1459 (aref (aref (class-v cl) class-class-allocation-values) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1460 c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1461 (slot-missing obj slot 'oref-default) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1462 ;;(signal 'invalid-slot-name (list (class-name cl) slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1463 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1464 (eieio-barf-if-slot-unbound |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1465 (let ((val (nth (- c 3) (aref (class-v cl) class-public-d)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1466 (eieio-default-eval-maybe val)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1467 obj cl 'oref-default)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1468 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1469 (defun eieio-default-eval-maybe (val) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1470 "Check VAL, and return what `oref-default' would provide." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1471 ;; check for quoted things, and unquote them |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1472 (if (and (listp val) (eq (car val) 'quote)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1473 (car (cdr val)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1474 ;; return it verbatim |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1475 val)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1476 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1477 ;;; Object Set macros |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1478 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1479 (defmacro oset (obj slot value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1480 "Set the value in OBJ for slot SLOT to VALUE. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1481 SLOT is the slot name as specified in `defclass' or the tag created |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1482 with in the :initarg slot. VALUE can be any Lisp object." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1483 `(eieio-oset ,obj (quote ,slot) ,value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1484 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1485 (defun eieio-oset (obj slot value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1486 "Does the work for the macro `oset'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1487 Fills in OBJ's SLOT with VALUE." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1488 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1489 (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1490 (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1491 (if (not c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1492 ;; It might be missing because it is a :class allocated slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1493 ;; Lets check that info out. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1494 (if (setq c |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1495 (eieio-class-slot-name-index (aref obj object-class) slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1496 ;; Oset that slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1497 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1498 (eieio-validate-class-slot-value (object-class-fast obj) c value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1499 (aset (aref (class-v (aref obj object-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1500 class-class-allocation-values) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1501 c value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1502 ;; See oref for comment on `slot-missing' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1503 (slot-missing obj slot 'oset value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1504 ;;(signal 'invalid-slot-name (list (object-name obj) slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1505 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1506 (eieio-validate-slot-value (object-class-fast obj) c value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1507 (aset obj c value)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1508 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1509 (defmacro oset-default (class slot value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1510 "Set the default slot in CLASS for SLOT to VALUE. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1511 The default value is usually set with the :initform tag during class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1512 creation. This allows users to change the default behavior of classes |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1513 after they are created." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1514 `(eieio-oset-default ,class (quote ,slot) ,value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1515 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1516 (defun eieio-oset-default (class slot value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1517 "Does the work for the macro `oset-default'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1518 Fills in the default value in CLASS' in SLOT with VALUE." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1519 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1520 (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1521 (let* ((scoped-class class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1522 (c (eieio-slot-name-index class nil slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1523 (if (not c) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1524 ;; It might be missing because it is a :class allocated slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1525 ;; Lets check that info out. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1526 (if (setq c (eieio-class-slot-name-index class slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1527 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1528 ;; Oref that slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1529 (eieio-validate-class-slot-value class c value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1530 (aset (aref (class-v class) class-class-allocation-values) c |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1531 value)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1532 (signal 'invalid-slot-name (list (class-name class) slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1533 (eieio-validate-slot-value class c value slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1534 ;; Set this into the storage for defaults. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1535 (setcar (nthcdr (- c 3) (aref (class-v class) class-public-d)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1536 value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1537 ;; Take the value, and put it into our cache object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1538 (eieio-oset (aref (class-v class) class-default-object-cache) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1539 slot value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1540 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1541 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1542 ;;; Handy CLOS macros |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1543 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1544 (defmacro with-slots (spec-list object &rest body) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1545 "Bind SPEC-LIST lexically to slot values in OBJECT, and execute BODY. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1546 This establishes a lexical environment for referring to the slots in |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1547 the instance named by the given slot-names as though they were |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1548 variables. Within such a context the value of the slot can be |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1549 specified by using its slot name, as if it were a lexically bound |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1550 variable. Both setf and setq can be used to set the value of the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1551 slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1552 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1553 SPEC-LIST is of a form similar to `let'. For example: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1554 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1555 ((VAR1 SLOT1) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1556 SLOT2 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1557 SLOTN |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1558 (VARN+1 SLOTN+1)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1559 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1560 Where each VAR is the local variable given to the associated |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1561 SLOT. A Slot specified without a variable name is given a |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1562 variable name of the same name as the slot." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1563 ;; Transform the spec-list into a symbol-macrolet spec-list. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1564 (let ((mappings (mapcar (lambda (entry) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1565 (let ((var (if (listp entry) (car entry) entry)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1566 (slot (if (listp entry) (cadr entry) entry))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1567 (list var `(slot-value ,object ',slot)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1568 spec-list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1569 (append (list 'symbol-macrolet mappings) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1570 body))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1571 (put 'with-slots 'lisp-indent-function 2) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1572 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1573 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1574 ;;; Simple generators, and query functions. None of these would do |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1575 ;; well embedded into an object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1576 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1577 (defmacro object-class-fast (obj) "Return the class struct defining OBJ with no check." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1578 `(aref ,obj object-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1579 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1580 (defun class-name (class) "Return a Lisp like symbol name for CLASS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1581 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1582 ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1583 ;; and I wanted a string. Arg! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1584 (format "#<class %s>" (symbol-name class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1585 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1586 (defun object-name (obj &optional extra) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1587 "Return a Lisp like symbol string for object OBJ. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1588 If EXTRA, include that in the string returned to represent the symbol." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1589 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1590 (format "#<%s %s%s>" (symbol-name (object-class-fast obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1591 (aref obj object-name) (or extra ""))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1592 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1593 (defun object-name-string (obj) "Return a string which is OBJ's name." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1594 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1595 (aref obj object-name)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1596 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1597 (defun object-set-name-string (obj name) "Set the string which is OBJ's NAME." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1598 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1599 (if (not (stringp name)) (signal 'wrong-type-argument (list 'stringp name))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1600 (aset obj object-name name)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1601 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1602 (defun object-class (obj) "Return the class struct defining OBJ." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1603 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1604 (object-class-fast obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1605 (defalias 'class-of 'object-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1606 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1607 (defun object-class-name (obj) "Return a Lisp like symbol name for OBJ's class." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1608 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1609 (class-name (object-class-fast obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1610 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1611 (defmacro class-parents-fast (class) "Return parent classes to CLASS with no check." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1612 `(aref (class-v ,class) class-parent)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1613 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1614 (defun class-parents (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1615 "Return parent classes to CLASS. (overload of variable). |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1616 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1617 The CLOS function `class-direct-superclasses' is aliased to this function." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1618 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1619 (class-parents-fast class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1620 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1621 (defmacro class-children-fast (class) "Return child classes to CLASS with no check." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1622 `(aref (class-v ,class) class-children)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1623 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1624 (defun class-children (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1625 "Return child classses to CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1626 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1627 The CLOS function `class-direct-subclasses' is aliased to this function." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1628 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1629 (class-children-fast class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1630 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1631 ;; Official CLOS functions. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1632 (defalias 'class-direct-superclasses 'class-parents) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1633 (defalias 'class-direct-subclasses 'class-children) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1634 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1635 (defmacro class-parent-fast (class) "Return first parent class to CLASS with no check." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1636 `(car (class-parents-fast ,class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1637 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1638 (defmacro class-parent (class) "Return first parent class to CLASS. (overload of variable)." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1639 `(car (class-parents ,class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1640 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1641 (defmacro same-class-fast-p (obj class) "Return t if OBJ is of class-type CLASS with no error checking." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1642 `(eq (aref ,obj object-class) ,class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1643 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1644 (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1645 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1646 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1647 (same-class-fast-p obj class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1648 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1649 (defun object-of-class-p (obj class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1650 "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1651 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1652 ;; class will be checked one layer down |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1653 (child-of-class-p (aref obj object-class) class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1654 ;; Backwards compatibility |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1655 (defalias 'obj-of-class-p 'object-of-class-p) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1656 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1657 (defun child-of-class-p (child class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1658 "If CHILD class is a subclass of CLASS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1659 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1660 (if (not (class-p child)) (signal 'wrong-type-argument (list 'class-p child))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1661 (let ((p nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1662 (while (and child (not (eq child class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1663 (setq p (append p (aref (class-v child) class-parent)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1664 child (car p) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1665 p (cdr p))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1666 (if child t))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1667 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1668 (defun object-slots (obj) "List of slots available in OBJ." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1669 (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1670 (aref (class-v (object-class-fast obj)) class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1671 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1672 (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1673 (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1674 (let ((ia (aref (class-v class) class-initarg-tuples)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1675 (f nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1676 (while (and ia (not f)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1677 (if (eq (cdr (car ia)) slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1678 (setq f (car (car ia)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1679 (setq ia (cdr ia))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1680 f)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1681 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1682 ;;; CLOS queries into classes and slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1683 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1684 (defun slot-boundp (object slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1685 "Non-nil if OBJECT's SLOT is bound. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1686 Setting a slot's value makes it bound. Calling `slot-makeunbound' will |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1687 make a slot unbound. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1688 OBJECT can be an instance or a class." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1689 ;; Skip typechecking while retrieving this value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1690 (let ((eieio-skip-typecheck t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1691 ;; Return nil if the magic symbol is in there. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1692 (if (eieio-object-p object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1693 (if (eq (eieio-oref object slot) eieio-unbound) nil t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1694 (if (class-p object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1695 (if (eq (eieio-oref-default object slot) eieio-unbound) nil t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1696 (signal 'wrong-type-argument (list 'eieio-object-p object)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1697 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1698 (defun slot-makeunbound (object slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1699 "In OBJECT, make SLOT unbound." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1700 (eieio-oset object slot eieio-unbound)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1701 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1702 (defun slot-exists-p (object-or-class slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1703 "Non-nil if OBJECT-OR-CLASS has SLOT." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1704 (let ((cv (class-v (cond ((eieio-object-p object-or-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1705 (object-class object-or-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1706 ((class-p object-or-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1707 object-or-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1708 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1709 (or (memq slot (aref cv class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1710 (memq slot (aref cv class-class-allocation-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1711 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1712 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1713 (defun find-class (symbol &optional errorp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1714 "Return the class that SYMBOL represents. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1715 If there is no class, nil is returned if ERRORP is nil. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1716 If ERRORP is non-nil, `wrong-argument-type' is signaled." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1717 (if (not (class-p symbol)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1718 (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1719 nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1720 (class-v symbol))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1721 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1722 ;;; Slightly more complex utility functions for objects |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1723 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1724 (defun object-assoc (key slot list) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1725 "Return an object if KEY is `equal' to SLOT's value of an object in LIST. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1726 LIST is a list of objects who's slots are searched. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1727 Objects in LIST do not need to have a slot named SLOT, nor does |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1728 SLOT need to be bound. If these errors occur, those objects will |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1729 be ignored." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1730 (if (not (listp list)) (signal 'wrong-type-argument (list 'listp list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1731 (while (and list (not (condition-case nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1732 ;; This prevents errors for missing slots. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1733 (equal key (eieio-oref (car list) slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1734 (error nil)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1735 (setq list (cdr list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1736 (car list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1737 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1738 (defun object-assoc-list (slot list) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1739 "Return an association list with the contents of SLOT as the key element. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1740 LIST must be a list of objects with SLOT in it. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1741 This is useful when you need to do completing read on an object group." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1742 (if (not (listp list)) (signal 'wrong-type-argument (list 'listp list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1743 (let ((assoclist nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1744 (while list |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1745 (setq assoclist (cons (cons (eieio-oref (car list) slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1746 (car list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1747 assoclist)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1748 (setq list (cdr list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1749 (nreverse assoclist))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1750 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1751 (defun object-assoc-list-safe (slot list) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1752 "Return an association list with the contents of SLOT as the key element. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1753 LIST must be a list of objects, but those objects do not need to have |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1754 SLOT in it. If it does not, then that element is left out of the association |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1755 list." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1756 (if (not (listp list)) (signal 'wrong-type-argument (list 'listp list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1757 (let ((assoclist nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1758 (while list |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1759 (if (slot-exists-p (car list) slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1760 (setq assoclist (cons (cons (eieio-oref (car list) slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1761 (car list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1762 assoclist))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1763 (setq list (cdr list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1764 (nreverse assoclist))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1765 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1766 (defun object-add-to-list (object slot item &optional append) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1767 "In OBJECT's SLOT, add ITEM to the list of elements. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1768 Optional argument APPEND indicates we need to append to the list. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1769 If ITEM already exists in the list in SLOT, then it is not added. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1770 Comparison is done with `equal' through the `member' function call. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1771 If SLOT is unbound, bind it to the list containing ITEM." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1772 (let (ov) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1773 ;; Find the originating list. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1774 (if (not (slot-boundp object slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1775 (setq ov (list item)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1776 (setq ov (eieio-oref object slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1777 ;; turn it into a list. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1778 (unless (listp ov) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1779 (setq ov (list ov))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1780 ;; Do the combination |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1781 (if (not (member item ov)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1782 (setq ov |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1783 (if append |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1784 (append ov (list item)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1785 (cons item ov))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1786 ;; Set back into the slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1787 (eieio-oset object slot ov))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1788 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1789 (defun object-remove-from-list (object slot item) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1790 "In OBJECT's SLOT, remove occurrences of ITEM. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1791 Deletion is done with `delete', which deletes by side effect |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1792 and comparisons are done with `equal'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1793 If SLOT is unbound, do nothing." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1794 (if (not (slot-boundp object slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1795 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1796 (eieio-oset object slot (delete item (eieio-oref object slot))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1797 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1798 ;;; EIEIO internal search functions |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1799 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1800 (defun eieio-slot-originating-class-p (start-class slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1801 "Return Non-nil if START-CLASS is the first class to define SLOT. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1802 This is for testing if `scoped-class' is the class that defines SLOT |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1803 so that we can protect private slots." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1804 (let ((par (class-parents start-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1805 (ret t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1806 (if (not par) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1807 t |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1808 (while (and par ret) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1809 (if (intern-soft (symbol-name slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1810 (aref (class-v (car par)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1811 class-symbol-obarray)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1812 (setq ret nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1813 (setq par (cdr par))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1814 ret))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1815 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1816 (defun eieio-slot-name-index (class obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1817 "In CLASS for OBJ find the index of the named SLOT. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1818 The slot is a symbol which is installed in CLASS by the `defclass' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1819 call. OBJ can be nil, but if it is an object, and the slot in question |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1820 is protected, access will be allowed if obj is a child of the currently |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1821 `scoped-class'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1822 If SLOT is the value created with :initarg instead, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1823 reverse-lookup that name, and recurse with the associated slot value." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1824 ;; Removed checks to outside this call |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1825 (let* ((fsym (intern-soft (symbol-name slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1826 (aref (class-v class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1827 class-symbol-obarray))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1828 (fsi (if (symbolp fsym) (symbol-value fsym) nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1829 (if (integerp fsi) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1830 (cond |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1831 ((not (get fsym 'protection)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1832 (+ 3 fsi)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1833 ((and (eq (get fsym 'protection) 'protected) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1834 scoped-class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1835 (or (child-of-class-p class scoped-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1836 (and (eieio-object-p obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1837 (child-of-class-p class (object-class obj))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1838 (+ 3 fsi)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1839 ((and (eq (get fsym 'protection) 'private) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1840 (or (and scoped-class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1841 (eieio-slot-originating-class-p scoped-class slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1842 eieio-initializing-object)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1843 (+ 3 fsi)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1844 (t nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1845 (let ((fn (eieio-initarg-to-attribute class slot))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1846 (if fn (eieio-slot-name-index class obj fn) nil))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1847 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1848 (defun eieio-class-slot-name-index (class slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1849 "In CLASS find the index of the named SLOT. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1850 The slot is a symbol which is installed in CLASS by the `defclass' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1851 call. If SLOT is the value created with :initarg instead, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1852 reverse-lookup that name, and recurse with the associated slot value." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1853 ;; This will happen less often, and with fewer slots. Do this the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1854 ;; storage cheap way. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1855 (let* ((a (aref (class-v class) class-class-allocation-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1856 (l1 (length a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1857 (af (memq slot a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1858 (l2 (length af))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1859 ;; Slot # is length of the total list, minus the remaining list of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1860 ;; the found slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1861 (if af (- l1 l2)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1862 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1863 ;;; CLOS generics internal function handling |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1864 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1865 (defvar eieio-generic-call-methodname nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1866 "When using `call-next-method', provides a context on how to do it.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1867 (defvar eieio-generic-call-arglst nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1868 "When using `call-next-method', provides a context for parameters.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1869 (defvar eieio-generic-call-key nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1870 "When using `call-next-method', provides a context for the current key. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1871 Keys are a number representing :before, :primary, and :after methods.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1872 (defvar eieio-generic-call-next-method-list nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1873 "When executing a PRIMARY or STATIC method, track the 'next-method'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1874 During executions, the list is first generated, then as each next method |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1875 is called, the next method is popped off the stack.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1876 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1877 (defvar eieio-pre-method-execution-hooks nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1878 "*Hooks run just before a method is executed. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1879 The hook function must accept on argument, this list of forms |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1880 about to be executed.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1881 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1882 (defun eieio-generic-call (method args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1883 "Call METHOD with ARGS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1884 ARGS provides the context on which implementation to use. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1885 This should only be called from a generic function." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1886 ;; We must expand our arguments first as they are always |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1887 ;; passed in as quoted symbols |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1888 (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1889 (eieio-generic-call-methodname method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1890 (eieio-generic-call-arglst args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1891 (firstarg nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1892 (primarymethodlist nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1893 ;; get a copy |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1894 (setq newargs args |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1895 firstarg (car newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1896 ;; Is the class passed in autoloaded? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1897 ;; Since class names are also constructors, they can be autoloaded |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1898 ;; via the autoload command. Check for this, and load them in. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1899 ;; It's ok if it doesn't turn out to be a class. Probably want that |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1900 ;; function loaded anyway. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1901 (if (and (symbolp firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1902 (fboundp firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1903 (listp (symbol-function firstarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1904 (eq 'autoload (car (symbol-function firstarg)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1905 (load (nth 1 (symbol-function firstarg)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1906 ;; Determine the class to use. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1907 (cond ((eieio-object-p firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1908 (setq mclass (object-class-fast firstarg))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1909 ((class-p firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1910 (setq mclass firstarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1911 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1912 ;; Make sure the class is a valid class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1913 ;; mclass can be nil (meaning a generic for should be used. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1914 ;; mclass cannot have a value that is not a class, however. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1915 (when (and (not (null mclass)) (not (class-p mclass))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1916 (error "Cannot dispatch method %S on class %S" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1917 method mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1918 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1919 ;; Now create a list in reverse order of all the calls we have |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1920 ;; make in order to successfully do this right. Rules: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1921 ;; 1) Only call generics if scoped-class is not defined |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1922 ;; This prevents multiple calls in the case of recursion |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1923 ;; 2) Only call static if this is a static method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1924 ;; 3) Only call specifics if the definition allows for them. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1925 ;; 4) Call in order based on :before, :primary, and :after |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1926 (when (eieio-object-p firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1927 ;; Non-static calls do all this stuff. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1928 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1929 ;; :after methods |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1930 (setq tlambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1931 (if mclass |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1932 (eieiomt-method-list method method-after mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1933 (list (eieio-generic-form method method-after nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1934 ;;(or (and mclass (eieio-generic-form method method-after mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1935 ;; (eieio-generic-form method method-after nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1936 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1937 (setq lambdas (append tlambdas lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1938 keys (append (make-list (length tlambdas) method-after) keys)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1939 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1940 ;; :primary methods |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1941 (setq tlambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1942 (or (and mclass (eieio-generic-form method method-primary mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1943 (eieio-generic-form method method-primary nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1944 (when tlambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1945 (setq lambdas (cons tlambdas lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1946 keys (cons method-primary keys) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1947 primarymethodlist |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1948 (eieiomt-method-list method method-primary mclass))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1949 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1950 ;; :before methods |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1951 (setq tlambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1952 (if mclass |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1953 (eieiomt-method-list method method-before mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1954 (list (eieio-generic-form method method-before nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1955 ;;(or (and mclass (eieio-generic-form method method-before mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1956 ;; (eieio-generic-form method method-before nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1957 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1958 (setq lambdas (append tlambdas lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1959 keys (append (make-list (length tlambdas) method-before) keys)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1960 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1961 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1962 ;; If there were no methods found, then there could be :static methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1963 (when (not lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1964 (setq tlambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1965 (eieio-generic-form method method-static mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1966 (setq lambdas (cons tlambdas lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1967 keys (cons method-static keys) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1968 primarymethodlist ;; Re-use even with bad name here |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1969 (eieiomt-method-list method method-static mclass))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1970 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1971 (run-hook-with-args 'eieio-pre-method-execution-hooks |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1972 primarymethodlist) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1973 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1974 ;; Now loop through all occurances forms which we must execute |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1975 ;; (which are happily sorted now) and execute them all! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1976 (let ((rval nil) (lastval nil) (rvalever nil) (found nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1977 (while lambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1978 (if (car lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1979 (let* ((scoped-class (cdr (car lambdas))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1980 (eieio-generic-call-key (car keys)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1981 (has-return-val |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1982 (or (= eieio-generic-call-key method-primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1983 (= eieio-generic-call-key method-static))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1984 (eieio-generic-call-next-method-list |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1985 ;; Use the cdr, as the first element is the fcn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1986 ;; we are calling right now. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1987 (when has-return-val (cdr primarymethodlist))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1988 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1989 (setq found t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1990 ;;(setq rval (apply (car (car lambdas)) newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1991 (setq lastval (apply (car (car lambdas)) newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1992 (when has-return-val |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1993 (setq rval lastval |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1994 rvalever t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1995 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1996 (setq lambdas (cdr lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1997 keys (cdr keys))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1998 (if (not found) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
1999 (if (eieio-object-p (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2000 (setq rval (apply 'no-applicable-method (car args) method args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2001 rvalever t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2002 (signal |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2003 'no-method-definition |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2004 (list method args)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2005 ;; Right Here... it could be that lastval is returned when |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2006 ;; rvalever is nil. Is that right? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2007 rval))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2008 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2009 (defun eieio-generic-call-primary-only (method args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2010 "Call METHOD with ARGS for methods with only :PRIMARY implementations. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2011 ARGS provides the context on which implementation to use. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2012 This should only be called from a generic function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2013 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2014 This method is like `eieio-generic-call', but only |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2015 implementations in the :PRIMARY slot are queried. After many |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2016 years of use, it appears that over 90% of methods in use |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2017 have :PRIMARY implementations only. We can therefore optimize |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2018 for this common case to improve performance." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2019 ;; We must expand our arguments first as they are always |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2020 ;; passed in as quoted symbols |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2021 (let ((newargs nil) (mclass nil) (lambdas nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2022 (eieio-generic-call-methodname method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2023 (eieio-generic-call-arglst args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2024 (firstarg nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2025 (primarymethodlist nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2026 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2027 ;; get a copy |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2028 (setq newargs args |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2029 firstarg (car newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2030 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2031 ;; Determine the class to use. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2032 (cond ((eieio-object-p firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2033 (setq mclass (object-class-fast firstarg))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2034 ((not firstarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2035 (error "Method %s called on nil" method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2036 ((not (eieio-object-p firstarg)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2037 (error "Primary-only method %s called on something not an object" method)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2038 (t |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2039 (error "EIEIO Error: Improperly classified method %s as primary only" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2040 method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2041 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2042 ;; Make sure the class is a valid class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2043 ;; mclass can be nil (meaning a generic for should be used. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2044 ;; mclass cannot have a value that is not a class, however. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2045 (when (null mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2046 (error "Cannot dispatch method %S on class %S" method mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2047 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2048 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2049 ;; :primary methods |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2050 (setq lambdas (eieio-generic-form method method-primary mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2051 (setq primarymethodlist ;; Re-use even with bad name here |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2052 (eieiomt-method-list method method-primary mclass)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2053 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2054 ;; Now loop through all occurances forms which we must execute |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2055 ;; (which are happily sorted now) and execute them all! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2056 (let* ((rval nil) (lastval nil) (rvalever nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2057 (scoped-class (cdr lambdas)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2058 (eieio-generic-call-key method-primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2059 ;; Use the cdr, as the first element is the fcn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2060 ;; we are calling right now. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2061 (eieio-generic-call-next-method-list (cdr primarymethodlist)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2062 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2063 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2064 (if (or (not lambdas) (not (car lambdas))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2065 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2066 ;; No methods found for this impl... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2067 (if (eieio-object-p (car args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2068 (setq rval (apply 'no-applicable-method (car args) method args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2069 rvalever t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2070 (signal |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2071 'no-method-definition |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2072 (list method args))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2073 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2074 ;; Do the regular implementation here. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2075 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2076 (run-hook-with-args 'eieio-pre-method-execution-hooks |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2077 lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2078 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2079 (setq lastval (apply (car lambdas) newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2080 (setq rval lastval |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2081 rvalever t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2082 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2083 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2084 ;; Right Here... it could be that lastval is returned when |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2085 ;; rvalever is nil. Is that right? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2086 rval))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2087 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2088 (defun eieiomt-method-list (method key class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2089 "Return an alist list of methods lambdas. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2090 METHOD is the method name. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2091 KEY represents either :before, or :after methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2092 CLASS is the starting class to search from in the method tree. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2093 If CLASS is nil, then an empty list of methods should be returned." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2094 ;; Note: eieiomt - the MT means MethodTree. See more comments below |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2095 ;; for the rest of the eieiomt methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2096 (let ((lambdas nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2097 (mclass (list class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2098 (while mclass |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2099 ;; Note: a nil can show up in the class list once we start |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2100 ;; searching through the method tree. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2101 (when (car mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2102 ;; lookup the form to use for the PRIMARY object for the next level |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2103 (let ((tmpl (eieio-generic-form method key (car mclass)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2104 (when (or (not lambdas) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2105 ;; This prevents duplicates coming out of the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2106 ;; class method optimizer. Perhaps we should |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2107 ;; just not optimize before/afters? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2108 (not (eq (car tmpl) (car (car lambdas))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2109 (setq lambdas (cons tmpl lambdas)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2110 (if (null (car lambdas)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2111 (setq lambdas (cdr lambdas)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2112 ;; Add new classes to mclass. Since our input might not be a class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2113 ;; protect against that. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2114 (if (car mclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2115 ;; If there is a class, append any methods it may provide |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2116 ;; to the remainder of the class list. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2117 (let ((io (class-method-invocation-order (car mclass)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2118 (if (eq io :depth-first) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2119 ;; Depth first. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2120 (setq mclass (append (eieiomt-next (car mclass)) (cdr mclass))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2121 ;; Breadth first. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2122 (setq mclass (append (cdr mclass) (eieiomt-next (car mclass))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2123 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2124 ;; Advance to next entry in mclass if it is nil. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2125 (setq mclass (cdr mclass))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2126 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2127 (if (eq key method-after) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2128 lambdas |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2129 (nreverse lambdas)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2130 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2131 (defun next-method-p () |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2132 "Non-nil if there is a next method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2133 Returns a list of lambda expressions which is the `next-method' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2134 order." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2135 eieio-generic-call-next-method-list) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2136 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2137 (defun call-next-method (&rest replacement-args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2138 "Call the superclass method from a subclass method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2139 The superclass method is specified in the current method list, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2140 and is called the next method. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2141 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2142 If REPLACEMENT-ARGS is non-nil, then use them instead of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2143 `eieio-generic-call-arglst'. The generic arg list are the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2144 arguments passed in at the top level. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2145 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2146 Use `next-method-p' to find out if there is a next method to call." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2147 (if (not scoped-class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2148 (error "Call-next-method not called within a class specific method")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2149 (if (and (/= eieio-generic-call-key method-primary) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2150 (/= eieio-generic-call-key method-static)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2151 (error "Cannot `call-next-method' except in :primary or :static methods") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2152 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2153 (let ((newargs (or replacement-args eieio-generic-call-arglst)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2154 (next (car eieio-generic-call-next-method-list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2155 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2156 (if (or (not next) (not (car next))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2157 (apply 'no-next-method (car newargs) (cdr newargs)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2158 (let* ((eieio-generic-call-next-method-list |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2159 (cdr eieio-generic-call-next-method-list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2160 (scoped-class (cdr next)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2161 (fcn (car next)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2162 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2163 (apply fcn newargs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2164 )))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2165 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2166 ;;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2167 ;; eieio-method-tree : eieiomt- |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2168 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2169 ;; Stored as eieio-method-tree in property list of a generic method |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2170 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2171 ;; (eieio-method-tree . [BEFORE PRIMARY AFTER |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2172 ;; genericBEFORE genericPRIMARY genericAFTER]) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2173 ;; and |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2174 ;; (eieio-method-obarray . [BEFORE PRIMARY AFTER |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2175 ;; genericBEFORE genericPRIMARY genericAFTER]) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2176 ;; where the association is a vector. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2177 ;; (aref 0 -- all static methods. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2178 ;; (aref 1 -- all methods classified as :before |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2179 ;; (aref 2 -- all methods classified as :primary |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2180 ;; (aref 3 -- all methods classified as :after |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2181 ;; (aref 4 -- a generic classified as :before |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2182 ;; (aref 5 -- a generic classified as :primary |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2183 ;; (aref 6 -- a generic classified as :after |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2184 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2185 (defvar eieiomt-optimizing-obarray nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2186 "While mapping atoms, this contain the obarray being optimized.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2187 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2188 (defun eieiomt-install (method-name) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2189 "Install the method tree, and obarray onto METHOD-NAME. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2190 Do not do the work if they already exist." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2191 (let ((emtv (get method-name 'eieio-method-tree)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2192 (emto (get method-name 'eieio-method-obarray))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2193 (if (or (not emtv) (not emto)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2194 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2195 (setq emtv (put method-name 'eieio-method-tree |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2196 (make-vector method-num-slots nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2197 emto (put method-name 'eieio-method-obarray |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2198 (make-vector method-num-slots nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2199 (aset emto 0 (make-vector 11 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2200 (aset emto 1 (make-vector 11 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2201 (aset emto 2 (make-vector 41 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2202 (aset emto 3 (make-vector 11 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2203 )))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2204 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2205 (defun eieiomt-add (method-name method key class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2206 "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2207 METHOD-NAME is the name created by a call to `defgeneric'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2208 METHOD are the forms for a given implementation. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2209 KEY is an integer (see comment in eieio.el near this function) which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2210 is associated with the :static :before :primary and :after tags. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2211 It also indicates if CLASS is defined or not. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2212 CLASS is the class this method is associated with." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2213 (if (or (> key method-num-slots) (< key 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2214 (error "Eieiomt-add: method key error!")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2215 (let ((emtv (get method-name 'eieio-method-tree)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2216 (emto (get method-name 'eieio-method-obarray))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2217 ;; Make sure the method tables are available. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2218 (if (or (not emtv) (not emto)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2219 (error "Programmer error: eieiomt-add")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2220 ;; only add new cells on if it doesn't already exist! |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2221 (if (assq class (aref emtv key)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2222 (setcdr (assq class (aref emtv key)) method) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2223 (aset emtv key (cons (cons class method) (aref emtv key)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2224 ;; Add function definition into newly created symbol, and store |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2225 ;; said symbol in the correct obarray, otherwise use the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2226 ;; other array to keep this stuff |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2227 (if (< key method-num-lists) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2228 (let ((nsym (intern (symbol-name class) (aref emto key)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2229 (fset nsym method))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2230 ;; Now optimize the entire obarray |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2231 (if (< key method-num-lists) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2232 (let ((eieiomt-optimizing-obarray (aref emto key))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2233 ;; @todo - Is this overkill? Should we just clear the symbol? |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2234 (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2235 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2236 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2237 (defun eieiomt-next (class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2238 "Return the next parent class for CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2239 If CLASS is a superclass, return variable `eieio-default-superclass'. If CLASS |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2240 is variable `eieio-default-superclass' then return nil. This is different from |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2241 function `class-parent' as class parent returns nil for superclasses. This |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2242 function performs no type checking!" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2243 ;; No type-checking because all calls are made from functions which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2244 ;; are safe and do checking for us. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2245 (or (class-parents-fast class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2246 (if (eq class 'eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2247 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2248 '(eieio-default-superclass)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2249 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2250 (defun eieiomt-sym-optimize (s) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2251 "Find the next class above S which has a function body for the optimizer." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2252 ;; (message "Optimizing %S" s) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2253 (let* ((es (intern-soft (symbol-name s))) ;external symbol of class |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2254 (io (class-method-invocation-order es)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2255 (ov nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2256 (cont t)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2257 ;; This converts ES from a single symbol to a list of parent classes. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2258 (setq es (eieiomt-next es)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2259 ;; Loop over ES, then it's children individually. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2260 ;; We can have multiple hits only at one level of the parent tree. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2261 (while (and es cont) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2262 (setq ov (intern-soft (symbol-name (car es)) eieiomt-optimizing-obarray)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2263 (if (fboundp ov) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2264 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2265 (set s ov) ;store ov as our next symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2266 (setq cont nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2267 (if (eq io :depth-first) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2268 ;; Pre-pend the subclasses of (car es) so we get |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2269 ;; DEPTH FIRST optimization. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2270 (setq es (append (eieiomt-next (car es)) (cdr es))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2271 ;; Else, we are breadth first. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2272 ;; (message "Class %s is breadth first" es) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2273 (setq es (append (cdr es) (eieiomt-next (car es)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2274 ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2275 ;; If there is no nearest call, then set our value to nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2276 (if (not es) (set s nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2277 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2278 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2279 (defun eieio-generic-form (method key class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2280 "Return the lambda form belonging to METHOD using KEY based upon CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2281 If CLASS is not a class then use `generic' instead. If class has no |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2282 form, but has a parent class, then trace to that parent class. The |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2283 first time a form is requested from a symbol, an optimized path is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2284 memoized for future faster use." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2285 (let ((emto (aref (get method 'eieio-method-obarray) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2286 (if class key (+ key 3))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2287 (if (class-p class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2288 ;; 1) find our symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2289 (let ((cs (intern-soft (symbol-name class) emto))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2290 (if (not cs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2291 ;; 2) If there isn't one, then make one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2292 ;; This can be slow since it only occurs once |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2293 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2294 (setq cs (intern (symbol-name class) emto)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2295 ;; 2.1) Cache it's nearest neighbor with a quick optimize |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2296 ;; which should only occur once for this call ever |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2297 (let ((eieiomt-optimizing-obarray emto)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2298 (eieiomt-sym-optimize cs)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2299 ;; 3) If it's bound return this one. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2300 (if (fboundp cs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2301 (cons cs (aref (class-v class) class-symbol)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2302 ;; 4) If it's not bound then this variable knows something |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2303 (if (symbol-value cs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2304 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2305 ;; 4.1) This symbol holds the next class in it's value |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2306 (setq class (symbol-value cs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2307 cs (intern-soft (symbol-name class) emto)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2308 ;; 4.2) The optimizer should always have chosen a |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2309 ;; function-symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2310 ;;(if (fboundp cs) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2311 (cons cs (aref (class-v (intern (symbol-name class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2312 class-symbol)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2313 ;;(error "EIEIO optimizer: erratic data loss!")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2314 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2315 ;; There never will be a funcall... |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2316 nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2317 ;; for a generic call, what is a list, is the function body we want. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2318 (let ((emtl (aref (get method 'eieio-method-tree) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2319 (if class key (+ key 3))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2320 (if emtl |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2321 ;; The car of EMTL is supposed to be a class, which in this |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2322 ;; case is nil, so skip it. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2323 (cons (cdr (car emtl)) nil) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2324 nil))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2325 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2326 ;;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2327 ;; Way to assign slots based on a list. Used for constructors, or |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2328 ;; even resetting an object at run-time |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2329 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2330 (defun eieio-set-defaults (obj &optional set-all) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2331 "Take object OBJ, and reset all slots to their defaults. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2332 If SET-ALL is non-nil, then when a default is nil, that value is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2333 reset. If SET-ALL is nil, the slots are only reset if the default is |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2334 not nil." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2335 (let ((scoped-class (aref obj object-class)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2336 (eieio-initializing-object t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2337 (pub (aref (class-v (aref obj object-class)) class-public-a))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2338 (while pub |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2339 (let ((df (eieio-oref-default obj (car pub)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2340 (if (or df set-all) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2341 (eieio-oset obj (car pub) df))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2342 (setq pub (cdr pub))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2343 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2344 (defun eieio-initarg-to-attribute (class initarg) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2345 "For CLASS, convert INITARG to the actual attribute name. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2346 If there is no translation, pass it in directly (so we can cheat if |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2347 need be.. May remove that later...)" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2348 (let ((tuple (assoc initarg (aref (class-v class) class-initarg-tuples)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2349 (if tuple |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2350 (cdr tuple) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2351 nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2352 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2353 (defun eieio-attribute-to-initarg (class attribute) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2354 "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2355 This is usually a symbol that starts with `:'." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2356 (let ((tuple (rassoc attribute (aref (class-v class) class-initarg-tuples)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2357 (if tuple |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2358 (car tuple) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2359 nil))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2360 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2361 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2362 ;;; Here are some special types of errors |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2363 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2364 (intern "no-method-definition") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2365 (put 'no-method-definition 'error-conditions '(no-method-definition error)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2366 (put 'no-method-definition 'error-message "No method definition") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2367 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2368 (intern "no-next-method") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2369 (put 'no-next-method 'error-conditions '(no-next-method error)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2370 (put 'no-next-method 'error-message "No next method") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2371 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2372 (intern "invalid-slot-name") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2373 (put 'invalid-slot-name 'error-conditions '(invalid-slot-name error)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2374 (put 'invalid-slot-name 'error-message "Invalid slot name") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2375 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2376 (intern "invalid-slot-type") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2377 (put 'invalid-slot-type 'error-conditions '(invalid-slot-type error nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2378 (put 'invalid-slot-type 'error-message "Invalid slot type") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2379 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2380 (intern "unbound-slot") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2381 (put 'unbound-slot 'error-conditions '(unbound-slot error nil)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2382 (put 'unbound-slot 'error-message "Unbound slot") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2383 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2384 ;;; Here are some CLOS items that need the CL package |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2385 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2386 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2387 (defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2388 (defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2389 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2390 ;; The below setf method was written by Arnd Kohrs <kohrs@acm.org> |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2391 (define-setf-method oref (obj slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2392 (let ((obj-temp (gensym)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2393 (slot-temp (gensym)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2394 (store-temp (gensym))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2395 (list (list obj-temp slot-temp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2396 (list obj `(quote ,slot)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2397 (list store-temp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2398 (list 'set-slot-value obj-temp slot-temp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2399 store-temp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2400 (list 'slot-value obj-temp slot-temp)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2401 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2402 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2403 ;;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2404 ;; We want all objects created by EIEIO to have some default set of |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2405 ;; behaviours so we can create object utilities, and allow various |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2406 ;; types of error checking. To do this, create the default EIEIO |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2407 ;; class, and when no parent class is specified, use this as the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2408 ;; default. (But don't store it in the other classes as the default, |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2409 ;; allowing for transparent support.) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2410 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2411 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2412 (defclass eieio-default-superclass nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2413 nil |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2414 "Default parent class for classes with no specified parent class. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2415 Its slots are automatically adopted by classes with no specified |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2416 parents. This class is not stored in the `parent' slot of a class vector." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2417 :abstract t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2418 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2419 (defalias 'standard-class 'eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2420 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2421 (defgeneric constructor (class newname &rest slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2422 "Default constructor for CLASS `eieio-defualt-superclass'.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2423 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2424 (defmethod constructor :static |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2425 ((class eieio-default-superclass) newname &rest slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2426 "Default constructor for CLASS `eieio-defualt-superclass'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2427 NEWNAME is the name to be given to the constructed object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2428 SLOTS are the initialization slots used by `shared-initialize'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2429 This static method is called when an object is constructed. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2430 It allocates the vector used to represent an EIEIO object, and then |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2431 calls `shared-initialize' on that object." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2432 (let* ((new-object (copy-sequence (aref (class-v class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2433 class-default-object-cache)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2434 ;; Update the name for the newly created object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2435 (aset new-object object-name newname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2436 ;; Call the initialize method on the new object with the slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2437 ;; that were passed down to us. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2438 (initialize-instance new-object slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2439 ;; Return the created object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2440 new-object)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2441 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2442 (defgeneric shared-initialize (obj slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2443 "Set slots of OBJ with SLOTS which is a list of name/value pairs. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2444 Called from the constructor routine.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2445 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2446 (defmethod shared-initialize ((obj eieio-default-superclass) slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2447 "Set slots of OBJ with SLOTS which is a list of name/value pairs. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2448 Called from the constructor routine." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2449 (let ((scoped-class (aref obj object-class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2450 (while slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2451 (let ((rn (eieio-initarg-to-attribute (object-class-fast obj) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2452 (car slots)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2453 (if (not rn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2454 (slot-missing obj (car slots) 'oset (car (cdr slots))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2455 (eieio-oset obj rn (car (cdr slots))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2456 (setq slots (cdr (cdr slots)))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2457 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2458 (defgeneric initialize-instance (this &optional slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2459 "Constructs the new object THIS based on SLOTS.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2460 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2461 (defmethod initialize-instance ((this eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2462 &optional slots) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2463 "Constructs the new object THIS based on SLOTS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2464 SLOTS is a tagged list where odd numbered elements are tags, and |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2465 even numbered elements are the values to store in the tagged slot. If |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2466 you overload the `initialize-instance', there you will need to call |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2467 `shared-initialize' yourself, or you can call `call-next-method' to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2468 have this constructor called automatically. If these steps are not |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2469 taken, then new objects of your class will not have their values |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2470 dynamically set from SLOTS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2471 ;; First, see if any of our defaults are `lambda', and |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2472 ;; re-evaluate them and apply the value to our slots. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2473 (let* ((scoped-class (class-v (aref this object-class))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2474 (slot (aref scoped-class class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2475 (defaults (aref scoped-class class-public-d))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2476 (while slot |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2477 (setq slot (cdr slot) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2478 defaults (cdr defaults)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2479 ;; Shared initialize will parse our slots for us. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2480 (shared-initialize this slots)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2481 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2482 (defgeneric slot-missing (object slot-name operation &optional new-value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2483 "Method invoked when an attempt to access a slot in OBJECT fails.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2484 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2485 (defmethod slot-missing ((object eieio-default-superclass) slot-name |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2486 operation &optional new-value) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2487 "Method invoked when an attempt to access a slot in OBJECT fails. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2488 SLOT-NAME is the name of the failed slot, OPERATION is the type of access |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2489 that was requested, and optional NEW-VALUE is the value that was desired |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2490 to be set. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2491 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2492 This method is called from `oref', `oset', and other functions which |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2493 directly reference slots in EIEIO objects." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2494 (signal 'invalid-slot-name (list (object-name object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2495 slot-name))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2496 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2497 (defgeneric slot-unbound (object class slot-name fn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2498 "Slot unbound is invoked during an attempt to reference an unbound slot.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2499 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2500 (defmethod slot-unbound ((object eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2501 class slot-name fn) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2502 "Slot unbound is invoked during an attempt to reference an unbound slot. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2503 OBJECT is the instance of the object being reference. CLASS is the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2504 class of OBJECT, and SLOT-NAME is the offending slot. This function |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2505 throws the signal `unbound-slot'. You can overload this function and |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2506 return the value to use in place of the unbound value. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2507 Argument FN is the function signaling this error. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2508 Use `slot-boundp' to determine if a slot is bound or not. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2509 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2510 In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2511 EIEIO can only dispatch on the first argument, so the first two are swapped." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2512 (signal 'unbound-slot (list (class-name class) (object-name object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2513 slot-name fn))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2514 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2515 (defgeneric no-applicable-method (object method &rest args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2516 "Called if there are no implementations for OBJECT in METHOD.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2517 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2518 (defmethod no-applicable-method ((object eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2519 method &rest args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2520 "Called if there are no implementations for OBJECT in METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2521 OBJECT is the object which has no method implementation. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2522 ARGS are the arguments that were passed to METHOD. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2523 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2524 Implement this for a class to block this signal. The return |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2525 value becomes the return value of the original method call." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2526 (signal 'no-method-definition (list method (object-name object))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2527 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2528 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2529 (defgeneric no-next-method (object &rest args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2530 "Called from `call-next-method' when no additional methods are available.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2531 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2532 (defmethod no-next-method ((object eieio-default-superclass) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2533 &rest args) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2534 "Called from `call-next-method' when no additional methods are available. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2535 OBJECT is othe object being called on `call-next-method'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2536 ARGS are the arguments it is called by. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2537 This method signals `no-next-method' by default. Override this |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2538 method to not throw an error, and it's return value becomes the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2539 return value of `call-next-method'." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2540 (signal 'no-next-method (list (object-name object) args)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2541 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2542 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2543 (defgeneric clone (obj &rest params) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2544 "Make a copy of OBJ, and then supply PARAMS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2545 PARAMS is a parameter list of the same form used by `initialize-instance'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2546 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2547 When overloading `clone', be sure to call `call-next-method' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2548 first and modify the returned object.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2549 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2550 (defmethod clone ((obj eieio-default-superclass) &rest params) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2551 "Make a copy of OBJ, and then apply PARAMS." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2552 (let ((nobj (copy-sequence obj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2553 (nm (aref obj object-name)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2554 (passname (and params (stringp (car params)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2555 (num 1)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2556 (if params (shared-initialize nobj (if passname (cdr params) params))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2557 (if (not passname) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2558 (save-match-data |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2559 (if (string-match "-\\([0-9]+\\)" nm) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2560 (setq num (1+ (string-to-number (match-string 1 nm))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2561 nm (substring nm 0 (match-beginning 0)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2562 (aset nobj object-name (concat nm "-" (int-to-string num)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2563 (aset nobj object-name (car params))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2564 nobj)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2565 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2566 (defgeneric destructor (this &rest params) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2567 "Destructor for cleaning up any dynamic links to our object.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2568 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2569 (defmethod destructor ((this eieio-default-superclass) &rest params) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2570 "Destructor for cleaning up any dynamic links to our object. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2571 Argument THIS is the object being destroyed. PARAMS are additional |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2572 ignored parameters." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2573 ;; No cleanup... yet. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2574 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2575 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2576 (defgeneric object-print (this &rest strings) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2577 "Pretty printer for object THIS. Call function `object-name' with STRINGS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2578 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2579 It is sometimes useful to put a summary of the object into the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2580 default #<notation> string when using eieio browsing tools. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2581 Implement this method to customize the summary.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2582 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2583 (defmethod object-print ((this eieio-default-superclass) &rest strings) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2584 "Pretty printer for object THIS. Call function `object-name' with STRINGS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2585 The default method for printing object THIS is to use the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2586 function `object-name'. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2587 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2588 It is sometimes useful to put a summary of the object into the |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2589 default #<notation> string when using eieio browsing tools. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2590 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2591 Implement this function and specify STRINGS in a call to |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2592 `call-next-method' to provide additional summary information. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2593 When passing in extra strings from child classes, always remember |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2594 to prepend a space." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2595 (object-name this (apply 'concat strings))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2596 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2597 (defvar eieio-print-depth 0 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2598 "When printing, keep track of the current indentation depth.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2599 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2600 (defgeneric object-write (this &optional comment) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2601 "Write out object THIS to the current stream. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2602 Optional COMMENDS will add comments to the beginning of the output.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2603 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2604 (defmethod object-write ((this eieio-default-superclass) &optional comment) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2605 "Write object THIS out to the current stream. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2606 This writes out the vector version of this object. Complex and recursive |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2607 object are discouraged from being written. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2608 If optional COMMENT is non-nil, include comments when outputting |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2609 this object." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2610 (when comment |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2611 (princ ";; Object ") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2612 (princ (object-name-string this)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2613 (princ "\n") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2614 (princ comment) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2615 (princ "\n")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2616 (let* ((cl (object-class this)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2617 (cv (class-v cl))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2618 ;; Now output readable lisp to recreate this object |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2619 ;; It should look like this: |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2620 ;; (<constructor> <name> <slot> <slot> ... ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2621 ;; Each slot's slot is writen using its :writer. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2622 (princ (make-string (* eieio-print-depth 2) ? )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2623 (princ "(") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2624 (princ (symbol-name (class-constructor (object-class this)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2625 (princ " \"") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2626 (princ (object-name-string this)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2627 (princ "\"\n") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2628 ;; Loop over all the public slots |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2629 (let ((publa (aref cv class-public-a)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2630 (publd (aref cv class-public-d)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2631 (publp (aref cv class-public-printer)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2632 (eieio-print-depth (1+ eieio-print-depth))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2633 (while publa |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2634 (when (slot-boundp this (car publa)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2635 (let ((i (class-slot-initarg cl (car publa))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2636 (v (eieio-oref this (car publa))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2637 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2638 (unless (or (not i) (equal v (car publd))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2639 (princ (make-string (* eieio-print-depth 2) ? )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2640 (princ (symbol-name i)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2641 (princ " ") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2642 (if (car publp) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2643 ;; Use our public printer |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2644 (funcall (car publp) v) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2645 ;; Use our generic override prin1 function. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2646 (eieio-override-prin1 v)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2647 (princ "\n")))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2648 (setq publa (cdr publa) publd (cdr publd) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2649 publp (cdr publp))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2650 (princ (make-string (* eieio-print-depth 2) ? ))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2651 (princ ")\n"))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2652 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2653 (defun eieio-override-prin1 (thing) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2654 "Perform a prin1 on THING taking advantage of object knowledge." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2655 (cond ((eieio-object-p thing) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2656 (object-write thing)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2657 ((listp thing) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2658 (eieio-list-prin1 thing)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2659 ((class-p thing) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2660 (princ (class-name thing))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2661 ((symbolp thing) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2662 (princ (concat "'" (symbol-name thing)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2663 (t (prin1 thing)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2664 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2665 (defun eieio-list-prin1 (list) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2666 "Display LIST where list may contain objects." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2667 (if (not (eieio-object-p (car list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2668 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2669 (princ "'") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2670 (prin1 list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2671 (princ "(list ") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2672 (if (eieio-object-p (car list)) (princ "\n ")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2673 (while list |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2674 (if (eieio-object-p (car list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2675 (object-write (car list)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2676 (princ "'") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2677 (prin1 (car list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2678 (princ " ") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2679 (setq list (cdr list))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2680 (princ (make-string (* eieio-print-depth 2) ? )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2681 (princ ")"))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2682 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2683 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2684 ;;; Unimplemented functions from CLOS |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2685 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2686 (defun change-class (obj class) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2687 "Change the class of OBJ to type CLASS. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2688 This may create or delete slots, but does not affect the return value |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2689 of `eq'." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2690 (error "Eieio: `change-class' is unimplemented")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2691 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2692 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2693 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2694 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2695 ;;; Interfacing with edebug |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2696 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2697 (defun eieio-edebug-prin1-to-string (object &optional noescape) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2698 "Display eieio OBJECT in fancy format. Overrides the edebug default. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2699 Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2700 (cond ((class-p object) (class-name object)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2701 ((eieio-object-p object) (object-print object)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2702 ((and (listp object) (or (class-p (car object)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2703 (eieio-object-p (car object)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2704 (concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")")) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2705 (t (prin1-to-string object noescape)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2706 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2707 (add-hook 'edebug-setup-hook |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2708 (lambda () |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2709 (def-edebug-spec defmethod |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2710 (&define ; this means we are defining something |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2711 [&or name ("setf" :name setf name)] |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2712 ;; ^^ This is the methods symbol |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2713 [ &optional symbolp ] ; this is key :before etc |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2714 list ; arguments |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2715 [ &optional stringp ] ; documentation string |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2716 def-body ; part to be debugged |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2717 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2718 ;; The rest of the macros |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2719 (def-edebug-spec oref (form quote)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2720 (def-edebug-spec oref-default (form quote)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2721 (def-edebug-spec oset (form quote form)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2722 (def-edebug-spec oset-default (form quote form)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2723 (def-edebug-spec class-v form) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2724 (def-edebug-spec class-p form) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2725 (def-edebug-spec eieio-object-p form) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2726 (def-edebug-spec class-constructor form) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2727 (def-edebug-spec generic-p form) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2728 (def-edebug-spec with-slots (list list def-body)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2729 ;; I suspect this isn't the best way to do this, but when |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2730 ;; cust-print was used on my system all my objects |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2731 ;; appeared as "#1 =" which was not useful. This allows |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2732 ;; edebug to print my objects in the nice way they were |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2733 ;; meant to with `object-print' and `class-name' |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2734 ;; (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2735 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2736 ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2737 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2738 (eval-after-load "cedet-edebug" |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2739 '(progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2740 (cedet-edebug-add-print-override '(class-p object) '(class-name object) ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2741 (cedet-edebug-add-print-override '(eieio-object-p object) '(object-print object) ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2742 (cedet-edebug-add-print-override '(and (listp object) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2743 (or (class-p (car object)) (eieio-object-p (car object)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2744 '(cedet-edebug-prin1-recurse object) ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2745 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2746 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2747 ;;; Interfacing with imenu in emacs lisp mode |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2748 ;; (Only if the expression is defined) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2749 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2750 (if (eval-when-compile (boundp 'list-imenu-generic-expression)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2751 (progn |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2752 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2753 (defun eieio-update-lisp-imenu-expression () |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2754 "Examine `lisp-imenu-generic-expression' and modify it to find `defmethod'." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2755 (let ((exp lisp-imenu-generic-expression)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2756 (while exp |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2757 ;; it's of the form '( ( title expr indx ) ... ) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2758 (let* ((subcar (cdr (car exp))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2759 (substr (car subcar))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2760 (if (and (not (string-match "|method\\\\" substr)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2761 (string-match "|advice\\\\" substr)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2762 (setcar subcar |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2763 (replace-match "|advice\\|method\\" t t substr 0)))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2764 (setq exp (cdr exp))))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2765 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2766 (eieio-update-lisp-imenu-expression) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2767 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2768 )) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2769 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2770 ;;; Autoloading some external symbols, and hooking into the help system |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2771 ;; |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2772 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2773 (autoload 'eieio-help-mode-augmentation-maybee "eieio-opt" "For buffers thrown into help mode, augment for eieio.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2774 (autoload 'eieio-browse "eieio-opt" "Create an object browser window" t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2775 (autoload 'eieio-describe-class "eieio-opt" "Describe CLASS defined by a string or symbol" t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2776 (autoload 'eieio-describe-constructor "eieio-opt" "Describe the constructor function FCN." t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2777 (autoload 'describe-class "eieio-opt" "Describe CLASS defined by a string or symbol" t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2778 (autoload 'eieio-describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol" t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2779 (autoload 'describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol" t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2780 (autoload 'eieiodoc-class "eieio-doc" "Create texinfo documentation about a class hierarchy." t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2781 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2782 (autoload 'customize-object "eieio-custom" "Create a custom buffer editing OBJ.") |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2783 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2784 ;; make sure this shows up after the help mode hook. |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2785 (add-hook 'temp-buffer-show-hook 'eieio-help-mode-augmentation-maybee t) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2786 ;; (require 'advice) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2787 ;; (defadvice describe-variable (around eieio-describe activate) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2788 ;; "Display the full documentation of FUNCTION (a symbol). |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2789 ;; Returns the documentation as a string, also." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2790 ;; (if (class-p (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2791 ;; (eieio-describe-class (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2792 ;; ad-do-it)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2793 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2794 ;; (defadvice describe-function (around eieio-describe activate) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2795 ;; "Display the full documentation of VARIABLE (a symbol). |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2796 ;; Returns the documentation as a string, also." |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2797 ;; (if (generic-p (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2798 ;; (eieio-describe-generic (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2799 ;; (if (class-p (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2800 ;; (eieio-describe-constructor (ad-get-arg 0)) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2801 ;; ad-do-it))) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2802 |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2803 (provide 'eieio) |
a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
Chong Yidong <cyd@stupidchicken.com>
parents:
diff
changeset
|
2804 ;;; eieio ends here |