aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2015-01-07 23:11:58 -0500
committerStefan Monnier2015-01-07 23:11:58 -0500
commit1599688e95802c34f35819f5600a48a81248732c (patch)
tree30de69970ba2e145c374e78b3a1606a443169771
parentcb4db863192aed6c4d0b28e6490f08d5518ff3e7 (diff)
downloademacs-1599688e95802c34f35819f5600a48a81248732c.tar.gz
emacs-1599688e95802c34f35819f5600a48a81248732c.zip
lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var.
* lisp/cedet/ede/speedbar.el (ede-speedbar-compile-line) (ede-speedbar-get-top-project-for-line): * lisp/cedet/ede.el (ede-buffer-belongs-to-target-p) (ede-buffer-belongs-to-project-p, ede-build-forms-menu) (ede-add-project-to-global-list): * lisp/cedet/semantic/db-typecache.el (semanticdb-get-typecache): * lisp/cedet/semantic/db-file.el (semanticdb-load-database): * lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym->tag): * lisp/cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper): * lisp/cedet/ede/project-am.el (project-am-preferred-target-type): * lisp/cedet/ede/proj.el (ede-proj-load): * lisp/cedet/ede/custom.el (ede-customize-current-target, ede-customize-target): * lisp/cedet/semantic/ede-grammar.el ("semantic grammar"): * lisp/cedet/semantic/scope.el (semantic-scope-reset-cache) (semantic-calculate-scope): * lisp/cedet/srecode/map.el (srecode-map-update-map): * lisp/cedet/srecode/insert.el (srecode-insert-show-error-report) (srecode-insert-method, srecode-insert-include-lookup) (srecode-insert-method): * lisp/cedet/srecode/fields.el (srecode-active-template-region): * lisp/cedet/srecode/compile.el (srecode-flush-active-templates) (srecode-compile-inserter): Don't use <class> as a variable. Use `oref-default' for class slots. * lisp/cedet/semantic/grammar.el (semantic-grammar-eldoc-last-data): New var. (semantic-grammar-eldoc-get-macro-docstring): Use it instead of eldoc-last-data. * lisp/cedet/semantic/fw.el (semantic-exit-on-input): Use `declare'. (semantic-throw-on-input): Use `with-current-buffer'. * lisp/cedet/semantic/db.el (semanticdb-abstract-table-list): Define if not pre-defined. * lisp/cedet/semantic/db-find.el (semanticdb-find-tags-collector): Use save-current-buffer. (semanticdb-find-tags-collector): Don't use <class> as a variable. * lisp/cedet/semantic/complete.el (semantic-complete-active-default) (semantic-complete-current-matched-tag): Declare. (semantic-complete-inline-custom-type): Don't use <class> as a variable. * lisp/cedet/semantic/bovine/make.el (semantic-analyze-possible-completions): Use with-current-buffer. * lisp/cedet/semantic.el (semantic-parser-warnings): Declare. * lisp/cedet/ede/base.el (ede-target-list): Define if not pre-defined. (ede-with-projectfile): Prefer find-file-noselect over save-window-excursion. * lisp/emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): Don't use <class> as a variable. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Improve error messages. (eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as well as user-defined types. Emit errors for legacy types like <class>-child and <class>-list, if not eieio-backward-compatibility. * lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var. (eieio-defclass-autoload): Obey it. (eieio--class-object): Improve error behavior. (eieio-class-children-fast, same-class-fast-p): Remove. Inline at every use site. (eieio--defgeneric-form-primary-only): Rename from eieio-defgeneric-form-primary-only; update all callers. (eieio--defgeneric-form-primary-only-one): Rename from eieio-defgeneric-form-primary-only-one; update all callers. (eieio-defgeneric-reset-generic-form) (eieio-defgeneric-reset-generic-form-primary-only) (eieio-defgeneric-reset-generic-form-primary-only-one): Remove. (eieio--method-optimize-primary): New function to replace them. (eieio--defmethod, eieio-defmethod): Use it. (eieio--perform-slot-validation): Rename from eieio-perform-slot-validation; update all callers. (eieio--validate-slot-value): Rename from eieio-validate-slot-value. Change `class' to be a class object. Update all callers. (eieio--validate-class-slot-value): Rename from eieio-validate-class-slot-value. Change `class' to be a class object. Update all callers. (eieio-oset-default): Accept class object as well. (eieio--generic-call-primary-only): Rename from eieio-generic-call-primary-only. Update all callers. * lisp/emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove. (eieio-read-generic): Use `generic-p' instead. * lisp/emacs-lisp/eieio.el (same-class-p): Accept class object as well. (call-next-method): Simplify. (clone): Obey eieio-backward-compatibility. * lisp/gnus/registry.el: Don't use <class> as a variable. * test/automated/eieio-test-methodinvoke.el (eieio-test-method-order-list-4): Don't use <class> as a variable. * test/automated/eieio-test-persist.el (persistent-with-objs-list-slot): Don't use <class>-list type. * test/automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable. Don't use <class>-list types and <class>-list-p predicates.
-rw-r--r--lisp/ChangeLog45
-rw-r--r--lisp/cedet/ChangeLog51
-rw-r--r--lisp/cedet/ede.el12
-rw-r--r--lisp/cedet/ede/base.el23
-rw-r--r--lisp/cedet/ede/custom.el6
-rw-r--r--lisp/cedet/ede/proj.el4
-rw-r--r--lisp/cedet/ede/project-am.el10
-rw-r--r--lisp/cedet/ede/speedbar.el10
-rw-r--r--lisp/cedet/semantic.el89
-rw-r--r--lisp/cedet/semantic/analyze.el2
-rw-r--r--lisp/cedet/semantic/bovine/make.el7
-rw-r--r--lisp/cedet/semantic/complete.el6
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el4
-rw-r--r--lisp/cedet/semantic/db-el.el4
-rw-r--r--lisp/cedet/semantic/db-file.el5
-rw-r--r--lisp/cedet/semantic/db-find.el8
-rw-r--r--lisp/cedet/semantic/db-typecache.el4
-rw-r--r--lisp/cedet/semantic/db.el6
-rw-r--r--lisp/cedet/semantic/ede-grammar.el4
-rw-r--r--lisp/cedet/semantic/fw.el21
-rw-r--r--lisp/cedet/semantic/grammar.el11
-rw-r--r--lisp/cedet/semantic/ia.el2
-rw-r--r--lisp/cedet/semantic/idle.el2
-rw-r--r--lisp/cedet/semantic/scope.el6
-rw-r--r--lisp/cedet/srecode/compile.el10
-rw-r--r--lisp/cedet/srecode/fields.el4
-rw-r--r--lisp/cedet/srecode/insert.el12
-rw-r--r--lisp/cedet/srecode/map.el4
-rw-r--r--lisp/emacs-lisp/chart.el10
-rw-r--r--lisp/emacs-lisp/eieio-base.el24
-rw-r--r--lisp/emacs-lisp/eieio-core.el193
-rw-r--r--lisp/emacs-lisp/eieio-opt.el10
-rw-r--r--lisp/emacs-lisp/eieio.el19
-rw-r--r--lisp/gnus/ChangeLog6
-rw-r--r--lisp/gnus/registry.el4
-rw-r--r--test/ChangeLog14
-rw-r--r--test/automated/eieio-test-methodinvoke.el2
-rw-r--r--test/automated/eieio-test-persist.el2
-rw-r--r--test/automated/eieio-tests.el52
39 files changed, 416 insertions, 292 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 971253b3014..808fab10ff8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,46 @@
12015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie):
4 Don't use <class> as a variable.
5
6 * emacs-lisp/eieio.el (same-class-p): Accept class object as well.
7 (call-next-method): Simplify.
8 (clone): Obey eieio-backward-compatibility.
9
10 * emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove.
11 (eieio-read-generic): Use `generic-p' instead.
12
13 * emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var.
14 (eieio-defclass-autoload): Obey it.
15 (eieio--class-object): Improve error behavior.
16 (eieio-class-children-fast, same-class-fast-p): Remove. Inline at
17 every use site.
18 (eieio--defgeneric-form-primary-only): Rename from
19 eieio-defgeneric-form-primary-only; update all callers.
20 (eieio--defgeneric-form-primary-only-one): Rename from
21 eieio-defgeneric-form-primary-only-one; update all callers.
22 (eieio-defgeneric-reset-generic-form)
23 (eieio-defgeneric-reset-generic-form-primary-only)
24 (eieio-defgeneric-reset-generic-form-primary-only-one): Remove.
25 (eieio--method-optimize-primary): New function to replace them.
26 (eieio--defmethod, eieio-defmethod): Use it.
27 (eieio--perform-slot-validation): Rename from
28 eieio-perform-slot-validation; update all callers.
29 (eieio--validate-slot-value): Rename from eieio-validate-slot-value.
30 Change `class' to be a class object. Update all callers.
31 (eieio--validate-class-slot-value): Rename from
32 eieio-validate-class-slot-value. Change `class' to be a class object.
33 Update all callers.
34 (eieio-oset-default): Accept class object as well.
35 (eieio--generic-call-primary-only): Rename from
36 eieio-generic-call-primary-only. Update all callers.
37
38 * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
39 Improve error messages.
40 (eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as
41 well as user-defined types. Emit errors for legacy types like
42 <class>-child and <class>-list, if not eieio-backward-compatibility.
43
12015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> 442015-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
2 45
3 * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects. 46 * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects.
@@ -22547,7 +22590,7 @@ See ChangeLog.16 for earlier changes.
22547;; coding: utf-8 22590;; coding: utf-8
22548;; End: 22591;; End:
22549 22592
22550 Copyright (C) 2011-2014 Free Software Foundation, Inc. 22593 Copyright (C) 2011-2015 Free Software Foundation, Inc.
22551 22594
22552 This file is part of GNU Emacs. 22595 This file is part of GNU Emacs.
22553 22596
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index a43e94c5686..b5591adcefc 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,52 @@
12015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Don't use <class> as a variable and don't assume that <class>-list-p is
4 automatically defined.
5
6 * ede/speedbar.el (ede-speedbar-compile-line)
7 (ede-speedbar-get-top-project-for-line):
8 * ede.el (ede-buffer-belongs-to-target-p)
9 (ede-buffer-belongs-to-project-p, ede-build-forms-menu)
10 (ede-add-project-to-global-list):
11 * semantic/db-typecache.el (semanticdb-get-typecache):
12 * semantic/db-file.el (semanticdb-load-database):
13 * semantic/db-el.el (semanticdb-elisp-sym->tag):
14 * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper):
15 * ede/project-am.el (project-am-preferred-target-type):
16 * ede/proj.el (ede-proj-load):
17 * ede/custom.el (ede-customize-current-target, ede-customize-target):
18 * semantic/ede-grammar.el ("semantic grammar"):
19 * semantic/scope.el (semantic-scope-reset-cache)
20 (semantic-calculate-scope):
21 * srecode/map.el (srecode-map-update-map):
22 * srecode/insert.el (srecode-insert-show-error-report)
23 (srecode-insert-method, srecode-insert-include-lookup)
24 (srecode-insert-method):
25 * srecode/fields.el (srecode-active-template-region):
26 * srecode/compile.el (srecode-flush-active-templates)
27 (srecode-compile-inserter): Don't use <class> as a variable.
28 Use `oref-default' for class slots.
29
30 * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var.
31 (semantic-grammar-eldoc-get-macro-docstring): Use it instead of
32 eldoc-last-data.
33 * semantic/fw.el (semantic-exit-on-input): Use `declare'.
34 (semantic-throw-on-input): Use `with-current-buffer'.
35 * semantic/db.el (semanticdb-abstract-table-list): Define if not
36 pre-defined.
37 * semantic/db-find.el (semanticdb-find-tags-collector):
38 Use save-current-buffer.
39 (semanticdb-find-tags-collector): Don't use <class> as a variable.
40 * semantic/complete.el (semantic-complete-active-default)
41 (semantic-complete-current-matched-tag): Declare.
42 (semantic-complete-inline-custom-type): Don't use <class> as a variable.
43 * semantic/bovine/make.el (semantic-analyze-possible-completions):
44 Use with-current-buffer.
45 * semantic.el (semantic-parser-warnings): Declare.
46 * ede/base.el (ede-target-list): Define if not pre-defined.
47 (ede-with-projectfile): Prefer find-file-noselect over
48 save-window-excursion.
49
12014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> 502014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
2 51
3 * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children. 52 * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children.
@@ -3379,7 +3428,7 @@
3379;; coding: utf-8 3428;; coding: utf-8
3380;; End: 3429;; End:
3381 3430
3382 Copyright (C) 2009-2014 Free Software Foundation, Inc. 3431 Copyright (C) 2009-2015 Free Software Foundation, Inc.
3383 3432
3384 This file is part of GNU Emacs. 3433 This file is part of GNU Emacs.
3385 3434
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 55dff1ac441..87cfb85b2c2 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,6 +1,6 @@
1;;; ede.el --- Emacs Development Environment gloss 1;;; ede.el --- Emacs Development Environment gloss
2 2
3;; Copyright (C) 1998-2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: project, make 6;; Keywords: project, make
@@ -248,12 +248,12 @@ Argument LIST-O-O is the list of objects to choose from."
248 (let ((obj ede-object)) 248 (let ((obj ede-object))
249 (if (consp obj) 249 (if (consp obj)
250 (setq obj (car obj))) 250 (setq obj (car obj)))
251 (and obj (obj-of-class-p obj ede-target)))) 251 (and obj (obj-of-class-p obj 'ede-target))))
252 252
253(defun ede-buffer-belongs-to-project-p () 253(defun ede-buffer-belongs-to-project-p ()
254 "Return non-nil if this buffer belongs to at least one project." 254 "Return non-nil if this buffer belongs to at least one project."
255 (if (or (null ede-object) (consp ede-object)) nil 255 (if (or (null ede-object) (consp ede-object)) nil
256 (obj-of-class-p ede-object-project ede-project))) 256 (obj-of-class-p ede-object-project 'ede-project)))
257 257
258(defun ede-menu-obj-of-class-p (class) 258(defun ede-menu-obj-of-class-p (class)
259 "Return non-nil if some member of `ede-object' is a child of CLASS." 259 "Return non-nil if some member of `ede-object' is a child of CLASS."
@@ -281,7 +281,7 @@ Argument MENU-DEF is the menu definition to use."
281 ;; First, collect the build items from the project 281 ;; First, collect the build items from the project
282 (setq newmenu (append newmenu (ede-menu-items-build obj t))) 282 (setq newmenu (append newmenu (ede-menu-items-build obj t)))
283 ;; Second, declare the current target menu items 283 ;; Second, declare the current target menu items
284 (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) 284 (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target))
285 (while ede-obj 285 (while ede-obj
286 (setq newmenu (append newmenu 286 (setq newmenu (append newmenu
287 (ede-menu-items-build (car ede-obj) t)) 287 (ede-menu-items-build (car ede-obj) t))
@@ -1078,7 +1078,7 @@ On success, return the added project."
1078 (error "No project created to add to master list")) 1078 (error "No project created to add to master list"))
1079 (when (not (eieio-object-p proj)) 1079 (when (not (eieio-object-p proj))
1080 (error "Attempt to add non-object to master project list")) 1080 (error "Attempt to add non-object to master project list"))
1081 (when (not (obj-of-class-p proj ede-project-placeholder)) 1081 (when (not (obj-of-class-p proj 'ede-project-placeholder))
1082 (error "Attempt to add a non-project to the ede projects list")) 1082 (error "Attempt to add a non-project to the ede projects list"))
1083 (add-to-list 'ede-projects proj) 1083 (add-to-list 'ede-projects proj)
1084 proj) 1084 proj)
@@ -1099,6 +1099,8 @@ Flush the dead projects from the project cache."
1099 (ede-delete-project-from-global-list D)) 1099 (ede-delete-project-from-global-list D))
1100 )) 1100 ))
1101 1101
1102(defvar ede--disable-inode) ;Defined in ede/files.el.
1103
1102(defun ede-global-list-sanity-check () 1104(defun ede-global-list-sanity-check ()
1103 "Perform a sanity check to make sure there are no duplicate projects." 1105 "Perform a sanity check to make sure there are no duplicate projects."
1104 (interactive) 1106 (interactive)
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 4183ff4c61a..ce7857b53a3 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,6 +1,6 @@
1;;; ede/base.el --- Baseclasses for EDE. 1;;; ede/base.el --- Baseclasses for EDE.
2 2
3;; Copyright (C) 2010-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
@@ -159,6 +159,9 @@ and querying them will cause the actual project to get loaded.")
159;; Projects can also affect how EDE works, by changing what appears in 159;; Projects can also affect how EDE works, by changing what appears in
160;; the EDE menu, or how some keys are bound. 160;; the EDE menu, or how some keys are bound.
161;; 161;;
162(unless (fboundp 'ede-target-list-p)
163 (cl-deftype ede-target-list () '(list-of ede-target)))
164
162(defclass ede-project (ede-project-placeholder) 165(defclass ede-project (ede-project-placeholder)
163 ((subproj :initform nil 166 ((subproj :initform nil
164 :type list 167 :type list
@@ -287,16 +290,18 @@ All specific project types must derive from this project."
287;; 290;;
288(defmacro ede-with-projectfile (obj &rest forms) 291(defmacro ede-with-projectfile (obj &rest forms)
289 "For the project in which OBJ resides, execute FORMS." 292 "For the project in which OBJ resides, execute FORMS."
290 `(save-window-excursion 293 (declare (indent 1))
291 (let* ((pf (if (obj-of-class-p ,obj ede-target) 294 (unless (symbolp obj)
292 (ede-target-parent ,obj) 295 (message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
293 ,obj)) 296 `(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
294 (dbka (get-file-buffer (oref pf file)))) 297 (ede-target-parent ,obj)
295 (if (not dbka) (find-file (oref pf file)) 298 ,obj))
296 (switch-to-buffer dbka)) 299 (dbka (get-file-buffer (oref pf file))))
300 (with-current-buffer
301 (if (not dbka) (find-file-noselect (oref pf file))
302 dbka)
297 ,@forms 303 ,@forms
298 (if (not dbka) (kill-buffer (current-buffer)))))) 304 (if (not dbka) (kill-buffer (current-buffer))))))
299(put 'ede-with-projectfile 'lisp-indent-function 1)
300 305
301;;; The EDE persistent cache. 306;;; The EDE persistent cache.
302;; 307;;
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index ca36e1dc7c6..a39b4880283 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,6 +1,6 @@
1;;; ede/custom.el --- customization of EDE projects. 1;;; ede/custom.el --- customization of EDE projects.
2 2
3;; Copyright (C) 2010-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
@@ -61,7 +61,7 @@
61 "Edit fields of the current target through EIEIO & Custom." 61 "Edit fields of the current target through EIEIO & Custom."
62 (interactive) 62 (interactive)
63 (require 'eieio-custom) 63 (require 'eieio-custom)
64 (if (not (obj-of-class-p ede-object ede-target)) 64 (if (not (obj-of-class-p ede-object 'ede-target))
65 (error "Current file is not part of a target")) 65 (error "Current file is not part of a target"))
66 (ede-customize-target ede-object)) 66 (ede-customize-target ede-object))
67 67
@@ -72,7 +72,7 @@
72 "Edit fields of the current target through EIEIO & Custom. 72 "Edit fields of the current target through EIEIO & Custom.
73OBJ is the target object to customize." 73OBJ is the target object to customize."
74 (require 'eieio-custom) 74 (require 'eieio-custom)
75 (if (and obj (not (obj-of-class-p obj ede-target))) 75 (if (and obj (not (obj-of-class-p obj 'ede-target)))
76 (error "No logical target to customize")) 76 (error "No logical target to customize"))
77 (ede-customize obj)) 77 (ede-customize obj))
78 78
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 7f3b186f504..fd789b3857d 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,6 +1,6 @@
1;;; ede/proj.el --- EDE Generic Project file driver 1;;; ede/proj.el --- EDE Generic Project file driver
2 2
3;; Copyright (C) 1998-2003, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2003, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: project, make 6;; Keywords: project, make
@@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that
297the PROJECT being read in is the root project." 297the PROJECT being read in is the root project."
298 (save-excursion 298 (save-excursion
299 (let ((ret (eieio-persistent-read (concat project "Project.ede") 299 (let ((ret (eieio-persistent-read (concat project "Project.ede")
300 ede-proj-project)) 300 'ede-proj-project))
301 (subdirs (directory-files project nil "[^.].*" nil))) 301 (subdirs (directory-files project nil "[^.].*" nil)))
302 (if (not (object-of-class-p ret 'ede-proj-project)) 302 (if (not (object-of-class-p ret 'ede-proj-project))
303 (error "Corrupt project file")) 303 (error "Corrupt project file"))
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 3e7a97cc94c..a68412edf8b 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,6 +1,6 @@
1;;; project-am.el --- A project management scheme based on automake files. 1;;; project-am.el --- A project management scheme based on automake files.
2 2
3;; Copyright (C) 1998-2000, 2003, 2005, 2007-2014 3;; Copyright (C) 1998-2000, 2003, 2005, 2007-2015
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Eric M. Ludlam <zappo@gnu.org> 6;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -853,13 +853,13 @@ Argument FILE is the file to extract the end directory name from."
853(defun project-am-preferred-target-type (file) 853(defun project-am-preferred-target-type (file)
854 "For FILE, return the preferred type for that file." 854 "For FILE, return the preferred type for that file."
855 (cond ((string-match "\\.texi?\\(nfo\\)$" file) 855 (cond ((string-match "\\.texi?\\(nfo\\)$" file)
856 project-am-texinfo) 856 'project-am-texinfo)
857 ((string-match "\\.[0-9]$" file) 857 ((string-match "\\.[0-9]$" file)
858 project-am-man) 858 'project-am-man)
859 ((string-match "\\.el$" file) 859 ((string-match "\\.el$" file)
860 project-am-lisp) 860 'project-am-lisp)
861 (t 861 (t
862 project-am-program))) 862 'project-am-program)))
863 863
864(defmethod ede-buffer-header-file((this project-am-objectcode) buffer) 864(defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
865 "There are no default header files." 865 "There are no default header files."
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index ded9c78cf40..e08562a3738 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,6 +1,6 @@
1;;; ede/speedbar.el --- Speedbar viewing of EDE projects 1;;; ede/speedbar.el --- Speedbar viewing of EDE projects
2 2
3;; Copyright (C) 1998-2001, 2003, 2005, 2007-2014 Free Software 3;; Copyright (C) 1998-2001, 2003, 2005, 2007-2015 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Author: Eric M. Ludlam <zappo@gnu.org> 6;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects."
121 (let ((obj (eieio-speedbar-find-nearest-object))) 121 (let ((obj (eieio-speedbar-find-nearest-object)))
122 (if (not (eieio-object-p obj)) 122 (if (not (eieio-object-p obj))
123 nil 123 nil
124 (cond ((obj-of-class-p obj ede-project) 124 (cond ((obj-of-class-p obj 'ede-project)
125 (project-compile-project obj)) 125 (project-compile-project obj))
126 ((obj-of-class-p obj ede-target) 126 ((obj-of-class-p obj 'ede-target)
127 (project-compile-target obj)) 127 (project-compile-target obj))
128 (t (error "Error in speedbar structure")))))) 128 (t (error "Error in speedbar structure"))))))
129 129
@@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects."
133 (let ((obj (eieio-speedbar-find-nearest-object))) 133 (let ((obj (eieio-speedbar-find-nearest-object)))
134 (if (not (eieio-object-p obj)) 134 (if (not (eieio-object-p obj))
135 (error "Error in speedbar or ede structure") 135 (error "Error in speedbar or ede structure")
136 (if (obj-of-class-p obj ede-target) 136 (if (obj-of-class-p obj 'ede-target)
137 (setq obj (ede-target-parent obj))) 137 (setq obj (ede-target-parent obj)))
138 (if (obj-of-class-p obj ede-project) 138 (if (obj-of-class-p obj 'ede-project)
139 obj 139 obj
140 (error "Error in speedbar or ede structure"))))) 140 (error "Error in speedbar or ede structure")))))
141 141
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 50e2082600b..81a97884554 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,6 +1,6 @@
1;;; semantic.el --- Semantic buffer evaluator. 1;;; semantic.el --- Semantic buffer evaluator.
2 2
3;; Copyright (C) 1999-2014 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: syntax tools 6;; Keywords: syntax tools
@@ -573,6 +573,7 @@ string."
573;; The best way to call the parser from programs is via 573;; The best way to call the parser from programs is via
574;; `semantic-fetch-tags'. This, in turn, uses other internal 574;; `semantic-fetch-tags'. This, in turn, uses other internal
575;; API functions which plug-in parsers can take advantage of. 575;; API functions which plug-in parsers can take advantage of.
576(defvar semantic-parser-warnings)
576 577
577(defun semantic-fetch-tags () 578(defun semantic-fetch-tags ()
578 "Fetch semantic tags from the current buffer. 579 "Fetch semantic tags from the current buffer.
@@ -602,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache."
602 (garbage-collect) 603 (garbage-collect)
603 (cond 604 (cond
604 605
605;;;; Try the incremental parser to do a fast update. 606 ;; Try the incremental parser to do a fast update.
606 ((semantic-parse-tree-needs-update-p) 607 ((semantic-parse-tree-needs-update-p)
607 (setq res (semantic-parse-changes)) 608 (setq res (semantic-parse-changes))
608 (if (semantic-parse-tree-needs-rebuild-p) 609 (if (semantic-parse-tree-needs-rebuild-p)
609 ;; If the partial reparse fails, jump to a full reparse. 610 ;; If the partial reparse fails, jump to a full reparse.
610 (semantic-fetch-tags) 611 (semantic-fetch-tags)
611 ;; Clear the cache of unmatched syntax tokens 612 ;; Clear the cache of unmatched syntax tokens
612 ;; 613 ;;
613 ;; NOTE TO SELF: 614 ;; NOTE TO SELF:
614 ;; 615 ;;
615 ;; Move this into the incremental parser. This is a bug. 616 ;; Move this into the incremental parser. This is a bug.
616 ;; 617 ;;
617 (semantic-clear-unmatched-syntax-cache) 618 (semantic-clear-unmatched-syntax-cache)
618 (run-hook-with-args ;; Let hooks know the updated tags 619 (run-hook-with-args ;; Let hooks know the updated tags
619 'semantic-after-partial-cache-change-hook res)) 620 'semantic-after-partial-cache-change-hook res))
620 (setq semantic--completion-cache nil)) 621 (setq semantic--completion-cache nil))
621 622
622;;;; Parse the whole system. 623 ;; Parse the whole system.
623 ((semantic-parse-tree-needs-rebuild-p) 624 ((semantic-parse-tree-needs-rebuild-p)
624 ;; Use Emacs's built-in progress-reporter (only interactive). 625 ;; Use Emacs's built-in progress-reporter (only interactive).
625 (if noninteractive 626 (if noninteractive
626 (setq res (semantic-parse-region (point-min) (point-max))) 627 (setq res (semantic-parse-region (point-min) (point-max)))
627 (let ((semantic--progress-reporter 628 (let ((semantic--progress-reporter
628 (and (>= (point-max) semantic-minimum-working-buffer-size) 629 (and (>= (point-max) semantic-minimum-working-buffer-size)
629 (eq semantic-working-type 'percent) 630 (eq semantic-working-type 'percent)
630 (make-progress-reporter 631 (make-progress-reporter
631 (semantic-parser-working-message (buffer-name)) 632 (semantic-parser-working-message (buffer-name))
632 0 100)))) 633 0 100))))
633 (setq res (semantic-parse-region (point-min) (point-max))) 634 (setq res (semantic-parse-region (point-min) (point-max)))
634 (if semantic--progress-reporter 635 (if semantic--progress-reporter
635 (progress-reporter-done semantic--progress-reporter)))) 636 (progress-reporter-done semantic--progress-reporter))))
636 637
637 ;; Clear the caches when we see there were no errors. 638 ;; Clear the caches when we see there were no errors.
638 ;; But preserve the unmatched syntax cache and warnings! 639 ;; But preserve the unmatched syntax cache and warnings!
639 (let (semantic-unmatched-syntax-cache 640 (let (semantic-unmatched-syntax-cache
640 semantic-unmatched-syntax-cache-check 641 semantic-unmatched-syntax-cache-check
641 semantic-parser-warnings) 642 semantic-parser-warnings)
642 (semantic-clear-toplevel-cache)) 643 (semantic-clear-toplevel-cache))
643 ;; Set up the new overlays 644 ;; Set up the new overlays
644 (semantic--tag-link-list-to-buffer res) 645 (semantic--tag-link-list-to-buffer res)
645 ;; Set up the cache with the new results 646 ;; Set up the cache with the new results
646 (semantic--set-buffer-cache res) 647 (semantic--set-buffer-cache res)
647 )))) 648 ))))
648 649
649 ;; Always return the current parse tree. 650 ;; Always return the current parse tree.
650 semantic--buffer-cache) 651 semantic--buffer-cache)
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index 77e091721c8..846501e13cc 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,6 +1,6 @@
1;;; semantic/analyze.el --- Analyze semantic tags against local context 1;;; semantic/analyze.el --- Analyze semantic tags against local context
2 2
3;; Copyright (C) 2000-2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 56a520334ec..c001a4dab5f 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,6 +1,6 @@
1;;; semantic/bovine/make.el --- Makefile parsing rules. 1;;; semantic/bovine/make.el --- Makefile parsing rules.
2 2
3;; Copyright (C) 2000-2004, 2008-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2004, 2008-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
@@ -178,9 +178,8 @@ This is the same as a regular prototype."
178 makefile-mode (context) 178 makefile-mode (context)
179 "Return a list of possible completions in a Makefile. 179 "Return a list of possible completions in a Makefile.
180Uses default implementation, and also gets a list of filenames." 180Uses default implementation, and also gets a list of filenames."
181 (save-excursion 181 (require 'semantic/analyze/complete)
182 (require 'semantic/analyze/complete) 182 (with-current-buffer (oref context buffer)
183 (set-buffer (oref context buffer))
184 (let* ((normal (semantic-analyze-possible-completions-default context)) 183 (let* ((normal (semantic-analyze-possible-completions-default context))
185 (classes (oref context :prefixclass)) 184 (classes (oref context :prefixclass))
186 (filetags nil)) 185 (filetags nil))
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 91f9daf7547..3f726ee56fd 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,6 +1,6 @@
1;;; semantic/complete.el --- Routines for performing tag completion 1;;; semantic/complete.el --- Routines for performing tag completion
2 2
3;; Copyright (C) 2003-2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: syntax 6;; Keywords: syntax
@@ -188,6 +188,8 @@ Value should be a ... what?")
188 "Default history variable for any unhistoried prompt. 188 "Default history variable for any unhistoried prompt.
189Keeps STRINGS only in the history.") 189Keeps STRINGS only in the history.")
190 190
191(defvar semantic-complete-active-default)
192(defvar semantic-complete-current-matched-tag)
191 193
192(defun semantic-complete-read-tag-engine (collector displayor prompt 194(defun semantic-complete-read-tag-engine (collector displayor prompt
193 default-tag initial-input 195 default-tag initial-input
@@ -1871,7 +1873,7 @@ completion text in ghost text."
1871 (list 'const 1873 (list 'const
1872 :tag doc1 1874 :tag doc1
1873 C))) 1875 C)))
1874 (eieio-build-class-alist semantic-displayor-abstract t)) 1876 (eieio-build-class-alist 'semantic-displayor-abstract t))
1875 ) 1877 )
1876 "Possible options for inline completion displayors. 1878 "Possible options for inline completion displayors.
1877Use this to enable custom editing.") 1879Use this to enable custom editing.")
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index f89c6a6878c..2590dd1208d 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,6 +1,6 @@
1;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. 1;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
2 2
3;; Copyright (C) 2005-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
4 4
5;; Authors: Eric M. Ludlam <zappo@gnu.org> 5;; Authors: Eric M. Ludlam <zappo@gnu.org>
6;; Joakim Verona 6;; Joakim Verona
@@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'."
192If DIRECTORY is found to be defunct, it won't load the DB, and will 192If DIRECTORY is found to be defunct, it won't load the DB, and will
193warn instead." 193warn instead."
194 (if (file-directory-p directory) 194 (if (file-directory-p directory)
195 (semanticdb-create-database semanticdb-project-database-ebrowse 195 (semanticdb-create-database 'semanticdb-project-database-ebrowse
196 directory) 196 directory)
197 (let* ((BF (semanticdb-ebrowse-file-for-directory directory)) 197 (let* ((BF (semanticdb-ebrowse-file-for-directory directory))
198 (BFL (concat BF "-load.el")) 198 (BFL (concat BF "-load.el"))
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index f37aa07ebe6..be9ffe31b87 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
1;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp 1;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
2 2
3;;; Copyright (C) 2002-2014 Free Software Foundation, Inc. 3;;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: tags 6;; Keywords: tags
@@ -225,7 +225,7 @@ TOKTYPE is a hint to the type of tag desired."
225 (semantic-elisp-desymbolify 225 (semantic-elisp-desymbolify
226 ;; FIXME: This only gives the instance slots and ignores the 226 ;; FIXME: This only gives the instance slots and ignores the
227 ;; class-allocated slots. 227 ;; class-allocated slots.
228 (eieio--class-public-a (find-class semanticdb-project-database))) ;; slots ;FIXME: eieio-- 228 (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio--
229 (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents 229 (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
230 )) 230 ))
231 ((not toktype) 231 ((not toktype)
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index 785b5c704d9..0360e0680e7 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
1;;; semantic/db-file.el --- Save a semanticdb to a cache file. 1;;; semantic/db-file.el --- Save a semanticdb to a cache file.
2 2
3;;; Copyright (C) 2000-2005, 2007-2014 Free Software Foundation, Inc. 3;;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: tags 6;; Keywords: tags
@@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one."
158(defun semanticdb-load-database (filename) 158(defun semanticdb-load-database (filename)
159 "Load the database FILENAME." 159 "Load the database FILENAME."
160 (condition-case foo 160 (condition-case foo
161 (let* ((r (eieio-persistent-read filename semanticdb-project-database-file)) 161 (let* ((r (eieio-persistent-read filename
162 'semanticdb-project-database-file))
162 (c (semanticdb-get-database-tables r)) 163 (c (semanticdb-get-database-tables r))
163 (tv (oref r semantic-tag-version)) 164 (tv (oref r semantic-tag-version))
164 (fv (oref r semanticdb-version)) 165 (fv (oref r semanticdb-version))
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 9134506ef40..dd36cc1a01e 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,6 +1,6 @@
1;;; semantic/db-find.el --- Searching through semantic databases. 1;;; semantic/db-find.el --- Searching through semantic databases.
2 2
3;; Copyright (C) 2000-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: tags 6;; Keywords: tags
@@ -1114,7 +1114,7 @@ for backward compatibility.
1114If optional argument BRUTISH is non-nil, then ignore include statements, 1114If optional argument BRUTISH is non-nil, then ignore include statements,
1115and search all tables in this project tree." 1115and search all tables in this project tree."
1116 (let (found match) 1116 (let (found match)
1117 (save-excursion 1117 (save-current-buffer
1118 ;; If path is a buffer, set ourselves up in that buffer 1118 ;; If path is a buffer, set ourselves up in that buffer
1119 ;; so that the override methods work correctly. 1119 ;; so that the override methods work correctly.
1120 (when (bufferp path) (set-buffer path)) 1120 (when (bufferp path) (set-buffer path))
@@ -1127,7 +1127,7 @@ and search all tables in this project tree."
1127 ;; databases and not associated with a file. 1127 ;; databases and not associated with a file.
1128 (unless (and find-file-match 1128 (unless (and find-file-match
1129 (obj-of-class-p 1129 (obj-of-class-p
1130 (car tableandtags) semanticdb-search-results-table)) 1130 (car tableandtags) 'semanticdb-search-results-table))
1131 (when (setq match (funcall function 1131 (when (setq match (funcall function
1132 (car tableandtags) (cdr tableandtags))) 1132 (car tableandtags) (cdr tableandtags)))
1133 (when find-file-match 1133 (when find-file-match
@@ -1144,7 +1144,7 @@ and search all tables in this project tree."
1144 ;; `semanticdb-search-results-table', since those are system 1144 ;; `semanticdb-search-results-table', since those are system
1145 ;; databases and not associated with a file. 1145 ;; databases and not associated with a file.
1146 (unless (and find-file-match 1146 (unless (and find-file-match
1147 (obj-of-class-p table semanticdb-search-results-table)) 1147 (obj-of-class-p table 'semanticdb-search-results-table))
1148 (when (and table (setq match (funcall function table nil))) 1148 (when (and table (setq match (funcall function table nil)))
1149 (semanticdb-find-log-activity table match) 1149 (semanticdb-find-log-activity table match)
1150 (when find-file-match 1150 (when find-file-match
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index fd45e79f306..723b7bd28bc 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,6 +1,6 @@
1;;; semantic/db-typecache.el --- Manage Datatypes 1;;; semantic/db-typecache.el --- Manage Datatypes
2 2
3;; Copyright (C) 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <eric@siege-engine.com> 5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 6
@@ -180,7 +180,7 @@ If there is no table, create one, and fill it in."
180(defmethod semanticdb-get-typecache ((db semanticdb-project-database)) 180(defmethod semanticdb-get-typecache ((db semanticdb-project-database))
181 "Retrieve the typecache from the semantic database DB. 181 "Retrieve the typecache from the semantic database DB.
182If there is no table, create one, and fill it in." 182If there is no table, create one, and fill it in."
183 (semanticdb-cache-get db semanticdb-database-typecache) 183 (semanticdb-cache-get db 'semanticdb-database-typecache)
184 ) 184 )
185 185
186 186
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 0732f225779..b2c1252c502 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,6 +1,6 @@
1;;; semantic/db.el --- Semantic tag database manager 1;;; semantic/db.el --- Semantic tag database manager
2 2
3;; Copyright (C) 2000-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: tags 6;; Keywords: tags
@@ -330,6 +330,10 @@ Adds the number of tags in this file to the object print name."
330 330
331;;; DATABASE BASE CLASS 331;;; DATABASE BASE CLASS
332;; 332;;
333(unless (fboundp 'semanticdb-abstract-table-list-p)
334 (cl-deftype semanticdb-abstract-table-list ()
335 '(list-of semanticdb-abstract-table)))
336
333(defclass semanticdb-project-database (eieio-instance-tracker) 337(defclass semanticdb-project-database (eieio-instance-tracker)
334 ((tracking-symbol :initform semanticdb-database-list) 338 ((tracking-symbol :initform semanticdb-database-list)
335 (reference-directory :type string 339 (reference-directory :type string
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 679c660e06c..67f0cfeea6d 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,6 @@
1;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files 1;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
2 2
3;; Copyright (C) 2003-2004, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: project, make 6;; Keywords: project, make
@@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff."
213;; "Target class for Emacs/Semantic grammar files." nil nil) 213;; "Target class for Emacs/Semantic grammar files." nil nil)
214 214
215(ede-proj-register-target "semantic grammar" 215(ede-proj-register-target "semantic grammar"
216 semantic-ede-proj-target-grammar) 216 'semantic-ede-proj-target-grammar)
217 217
218(provide 'semantic/ede-grammar) 218(provide 'semantic/ede-grammar)
219 219
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 9545dba703c..a0c36944d48 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
1;;; semantic/fw.el --- Framework for Semantic 1;;; semantic/fw.el --- Framework for Semantic
2 2
3;;; Copyright (C) 1999-2014 Free Software Foundation, Inc. 3;;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
@@ -378,11 +378,11 @@ If FORMS includes a call to `semantic-throw-on-input', then
378if a user presses any key during execution, this form macro 378if a user presses any key during execution, this form macro
379will exit with the value passed to `semantic-throw-on-input'. 379will exit with the value passed to `semantic-throw-on-input'.
380If FORMS completes, then the return value is the same as `progn'." 380If FORMS completes, then the return value is the same as `progn'."
381 (declare (indent 1))
381 `(let ((semantic-current-input-throw-symbol ,symbol) 382 `(let ((semantic-current-input-throw-symbol ,symbol)
382 (semantic--on-input-start-marker (point-marker))) 383 (semantic--on-input-start-marker (point-marker)))
383 (catch ,symbol 384 (catch ,symbol
384 ,@forms))) 385 ,@forms)))
385(put 'semantic-exit-on-input 'lisp-indent-function 1)
386 386
387(defmacro semantic-throw-on-input (from) 387(defmacro semantic-throw-on-input (from)
388 "Exit with `throw' when in `semantic-exit-on-input' on user input. 388 "Exit with `throw' when in `semantic-exit-on-input' on user input.
@@ -391,15 +391,14 @@ to pass to `throw'. It is recommended to use the name of the function
391calling this one." 391calling this one."
392 `(when (and semantic-current-input-throw-symbol 392 `(when (and semantic-current-input-throw-symbol
393 (or (input-pending-p) 393 (or (input-pending-p)
394 (save-excursion 394 (with-current-buffer
395 ;; Timers might run during accept-process-output. 395 ;; Timers might run during accept-process-output.
396 ;; If they redisplay, point must be where the user 396 ;; If they redisplay, point must be where the user
397 ;; expects. (Bug#15045) 397 ;; expects. (Bug#15045)
398 (set-buffer (marker-buffer 398 (marker-buffer semantic--on-input-start-marker)
399 semantic--on-input-start-marker)) 399 (save-excursion
400 (goto-char (marker-position 400 (goto-char semantic--on-input-start-marker)
401 semantic--on-input-start-marker)) 401 (accept-process-output)))))
402 (accept-process-output))))
403 (throw semantic-current-input-throw-symbol ,from))) 402 (throw semantic-current-input-throw-symbol ,from)))
404 403
405 404
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 625736d9998..7a92a12ed53 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,6 +1,6 @@
1;;; semantic/grammar.el --- Major mode framework for Semantic grammars 1;;; semantic/grammar.el --- Major mode framework for Semantic grammars
2 2
3;; Copyright (C) 2002-2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: David Ponce <david@dponce.com> 5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com> 6;; Maintainer: David Ponce <david@dponce.com>
@@ -1665,13 +1665,14 @@ Select the buffer containing the tag's definition, and move point there."
1665(declare-function eldoc-get-fnsym-args-string "eldoc") 1665(declare-function eldoc-get-fnsym-args-string "eldoc")
1666(declare-function eldoc-get-var-docstring "eldoc") 1666(declare-function eldoc-get-var-docstring "eldoc")
1667 1667
1668(defvar semantic-grammar-eldoc-last-data (cons nil nil))
1669
1668(defun semantic-grammar-eldoc-get-macro-docstring (macro expander) 1670(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
1669 "Return a one-line docstring for the given grammar MACRO. 1671 "Return a one-line docstring for the given grammar MACRO.
1670EXPANDER is the name of the function that expands MACRO." 1672EXPANDER is the name of the function that expands MACRO."
1671 (require 'eldoc) 1673 (require 'eldoc)
1672 (if (and (eq expander (aref eldoc-last-data 0)) 1674 (if (eq expander (car semantic-grammar-eldoc-last-data))
1673 (eq 'function (aref eldoc-last-data 2))) 1675 (cdr semantic-grammar-eldoc-last-data)
1674 (aref eldoc-last-data 1)
1675 (let ((doc (help-split-fundoc (documentation expander t) expander))) 1676 (let ((doc (help-split-fundoc (documentation expander t) expander)))
1676 (cond 1677 (cond
1677 (doc 1678 (doc
@@ -1684,7 +1685,7 @@ EXPANDER is the name of the function that expands MACRO."
1684 (setq doc 1685 (setq doc
1685 (eldoc-docstring-format-sym-doc 1686 (eldoc-docstring-format-sym-doc
1686 macro (format "==> %s %s" expander doc) 'default)) 1687 macro (format "==> %s %s" expander doc) 'default))
1687 (eldoc-last-data-store expander doc 'function)) 1688 (setq semantic-grammar-eldoc-last-data (cons expander doc)))
1688 doc))) 1689 doc)))
1689 1690
1690(define-mode-local-override semantic-idle-summary-current-symbol-info 1691(define-mode-local-override semantic-idle-summary-current-symbol-info
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 8a5cbac4129..2216fa9e964 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
1;;; semantic/ia.el --- Interactive Analysis functions 1;;; semantic/ia.el --- Interactive Analysis functions
2 2
3;;; Copyright (C) 2000-2014 Free Software Foundation, Inc. 3;;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: syntax 6;; Keywords: syntax
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index f54139260ce..790315381c1 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,6 +1,6 @@
1;;; idle.el --- Schedule parsing tasks in idle time 1;;; idle.el --- Schedule parsing tasks in idle time
2 2
3;; Copyright (C) 2003-2006, 2008-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2006, 2008-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: syntax 6;; Keywords: syntax
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 396f19c6c60..c56cbc3c126 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,6 +1,6 @@
1;;; semantic/scope.el --- Analyzer Scope Calculations 1;;; semantic/scope.el --- Analyzer Scope Calculations
2 2
3;; Copyright (C) 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <eric@siege-engine.com> 5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 6
@@ -134,7 +134,7 @@ Saves scoping information between runs of the analyzer.")
134 "Get the current cached scope, and reset it." 134 "Get the current cached scope, and reset it."
135 (when semanticdb-current-table 135 (when semanticdb-current-table
136 (let ((co (semanticdb-cache-get semanticdb-current-table 136 (let ((co (semanticdb-cache-get semanticdb-current-table
137 semantic-scope-cache))) 137 'semantic-scope-cache)))
138 (semantic-reset co)))) 138 (semantic-reset co))))
139 139
140(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) 140(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
@@ -706,7 +706,7 @@ The class returned from the scope calculation is variable
706 (let* ((TAG (semantic-current-tag)) 706 (let* ((TAG (semantic-current-tag))
707 (scopecache 707 (scopecache
708 (semanticdb-cache-get semanticdb-current-table 708 (semanticdb-cache-get semanticdb-current-table
709 semantic-scope-cache)) 709 'semantic-scope-cache))
710 ) 710 )
711 (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag))) 711 (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag)))
712 (semantic-reset scopecache)) 712 (semantic-reset scopecache))
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index ea366a3ec0a..782121ef5b5 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,6 +1,6 @@
1;;; srecode/compile --- Compilation of srecode template files. 1;;; srecode/compile --- Compilation of srecode template files.
2 2
3;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: codegeneration 6;; Keywords: codegeneration
@@ -87,10 +87,10 @@ for push, pop, and peek for the active template.")
87Useful if something goes wrong in SRecode, and the active template 87Useful if something goes wrong in SRecode, and the active template
88stack is broken." 88stack is broken."
89 (interactive) 89 (interactive)
90 (if (oref srecode-template active) 90 (if (oref-default 'srecode-template active)
91 (when (y-or-n-p (format "%d active templates. Flush? " 91 (when (y-or-n-p (format "%d active templates. Flush? "
92 (length (oref srecode-template active)))) 92 (length (oref-default 'srecode-template active))))
93 (oset-default srecode-template active nil)) 93 (oset-default 'srecode-template active nil))
94 (message "No active templates to flush.")) 94 (message "No active templates to flush."))
95 ) 95 )
96 96
@@ -514,7 +514,7 @@ to the inserter constructor."
514 ;;(message "Compile: %s %S" name props) 514 ;;(message "Compile: %s %S" name props)
515 (if (not key) 515 (if (not key)
516 (apply 'srecode-template-inserter-variable name props) 516 (apply 'srecode-template-inserter-variable name props)
517 (let ((classes (eieio-class-children srecode-template-inserter)) 517 (let ((classes (eieio-class-children 'srecode-template-inserter))
518 (new nil)) 518 (new nil))
519 ;; Loop over the various subclasses and 519 ;; Loop over the various subclasses and
520 ;; create the correct inserter. 520 ;; create the correct inserter.
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 7515717a041..f473a0d8261 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,6 +1,6 @@
1;;; srecode/fields.el --- Handling type-in fields in a buffer. 1;;; srecode/fields.el --- Handling type-in fields in a buffer.
2;; 2;;
3;; Copyright (C) 2009-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
4;; 4;;
5;; Author: Eric M. Ludlam <eric@siege-engine.com> 5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 6
@@ -237,7 +237,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
237 237
238(defsubst srecode-active-template-region () 238(defsubst srecode-active-template-region ()
239 "Return the active region for template fields." 239 "Return the active region for template fields."
240 (oref srecode-template-inserted-region active-region)) 240 (oref-default 'srecode-template-inserted-region active-region))
241 241
242(defun srecode-field-post-command () 242(defun srecode-field-post-command ()
243 "Srecode field handler in the post command hook." 243 "Srecode field handler in the post command hook."
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 0fe81a7e155..78ec1658859 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -1,6 +1,6 @@
1;;; srecode/insert.el --- Insert srecode templates to an output stream. 1;;; srecode/insert.el --- Insert srecode templates to an output stream.
2 2
3;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6 6
@@ -211,7 +211,7 @@ insertions."
211 (propertize " (most recent at bottom)" 'face '(:slant italic)) 211 (propertize " (most recent at bottom)" 'face '(:slant italic))
212 ":\n") 212 ":\n")
213 (data-debug-insert-stuff-list 213 (data-debug-insert-stuff-list
214 (reverse (oref srecode-template active)) "> ") 214 (reverse (oref-default 'srecode-template active)) "> ")
215 ;; Show the current dictionary. 215 ;; Show the current dictionary.
216 (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") 216 (insert (propertize "Dictionary" 'face '(:weight bold)) "\n")
217 (data-debug-insert-thing dictionary "" "> ") 217 (data-debug-insert-thing dictionary "" "> ")
@@ -396,7 +396,7 @@ Specify the :blank argument to enable this inserter.")
396 (pm (point-marker))) 396 (pm (point-marker)))
397 (when (and inbuff 397 (when (and inbuff
398 ;; Don't do this if we are not the active template. 398 ;; Don't do this if we are not the active template.
399 (= (length (oref srecode-template active)) 1)) 399 (= (length (oref-default 'srecode-template active)) 1))
400 400
401 (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) 401 (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin)))
402 (indent-according-to-mode) 402 (indent-according-to-mode)
@@ -773,7 +773,7 @@ generalized marker will do something else. See
773 ;; valid. Compare this to the actual template nesting depth and 773 ;; valid. Compare this to the actual template nesting depth and
774 ;; maybe use the override function which is stored in the cdr. 774 ;; maybe use the override function which is stored in the cdr.
775 (if (and srecode-template-inserter-point-override 775 (if (and srecode-template-inserter-point-override
776 (<= (length (oref srecode-template active)) 776 (<= (length (oref-default 'srecode-template active))
777 (car srecode-template-inserter-point-override))) 777 (car srecode-template-inserter-point-override)))
778 ;; Disable the old override while we do this. 778 ;; Disable the old override while we do this.
779 (let ((over (cdr srecode-template-inserter-point-override)) 779 (let ((over (cdr srecode-template-inserter-point-override))
@@ -943,7 +943,7 @@ this template instance."
943 ;; Calculate and store the discovered template 943 ;; Calculate and store the discovered template
944 (let ((tmpl (srecode-template-get-table (srecode-table) 944 (let ((tmpl (srecode-template-get-table (srecode-table)
945 templatenamepart)) 945 templatenamepart))
946 (active (oref srecode-template active)) 946 (active (oref-default 'srecode-template active))
947 ctxt) 947 ctxt)
948 (when (not tmpl) 948 (when (not tmpl)
949 ;; If it isn't just available, scan back through 949 ;; If it isn't just available, scan back through
@@ -1053,7 +1053,7 @@ template where a ^ inserter occurs."
1053 (lexical-let ((inserter1 sti)) 1053 (lexical-let ((inserter1 sti))
1054 (cons 1054 (cons
1055 ;; DEPTH 1055 ;; DEPTH
1056 (+ (length (oref srecode-template active)) 1) 1056 (+ (length (oref-default 'srecode-template active)) 1)
1057 ;; FUNCTION 1057 ;; FUNCTION
1058 (lambda (dict) 1058 (lambda (dict)
1059 (let ((srecode-template-inserter-point-override nil)) 1059 (let ((srecode-template-inserter-point-override nil))
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 31ea7101504..cc0c4ae4427 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,6 +1,6 @@
1;;; srecode/map.el --- Manage a template file map 1;;; srecode/map.el --- Manage a template file map
2 2
3;; Copyright (C) 2008-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <eric@siege-engine.com> 5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 6
@@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed."
298 (when (not srecode-current-map) 298 (when (not srecode-current-map)
299 (condition-case nil 299 (condition-case nil
300 (setq srecode-current-map 300 (setq srecode-current-map
301 (eieio-persistent-read srecode-map-save-file srecode-map)) 301 (eieio-persistent-read srecode-map-save-file 'srecode-map))
302 (error 302 (error
303 ;; There was an error loading the old map. Create a new one. 303 ;; There was an error loading the old map. Create a new one.
304 (setq srecode-current-map 304 (setq srecode-current-map
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index f84060e2630..218fbcbfcf1 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -422,7 +422,7 @@ or is created with the bounds of SEQ."
422 (if (stringp (car (oref seq data))) 422 (if (stringp (car (oref seq data)))
423 (let ((labels (oref seq data))) 423 (let ((labels (oref seq data)))
424 (if (not axis) 424 (if (not axis)
425 (setq axis (make-instance chart-axis-names 425 (setq axis (make-instance 'chart-axis-names
426 :name (oref seq name) 426 :name (oref seq name)
427 :items labels 427 :items labels
428 :chart c)) 428 :chart c))
@@ -430,7 +430,7 @@ or is created with the bounds of SEQ."
430 (let ((range (cons 0 1)) 430 (let ((range (cons 0 1))
431 (l (oref seq data))) 431 (l (oref seq data)))
432 (if (not axis) 432 (if (not axis)
433 (setq axis (make-instance chart-axis-range 433 (setq axis (make-instance 'chart-axis-range
434 :name (oref seq name) 434 :name (oref seq name)
435 :chart c))) 435 :chart c)))
436 (while l 436 (while l
@@ -577,19 +577,19 @@ labeled NUMTITLE.
577Optional arguments: 577Optional arguments:
578Set the chart's max element display to MAX, and sort lists with 578Set the chart's max element display to MAX, and sort lists with
579SORT-PRED if desired." 579SORT-PRED if desired."
580 (let ((nc (make-instance chart-bar 580 (let ((nc (make-instance 'chart-bar
581 :title title 581 :title title
582 :key-label "8-m" ; This is a text key pic 582 :key-label "8-m" ; This is a text key pic
583 :direction dir 583 :direction dir
584 )) 584 ))
585 (iv (eq dir 'vertical))) 585 (iv (eq dir 'vertical)))
586 (chart-add-sequence nc 586 (chart-add-sequence nc
587 (make-instance chart-sequece 587 (make-instance 'chart-sequece
588 :data namelst 588 :data namelst
589 :name nametitle) 589 :name nametitle)
590 (if iv 'x-axis 'y-axis)) 590 (if iv 'x-axis 'y-axis))
591 (chart-add-sequence nc 591 (chart-add-sequence nc
592 (make-instance chart-sequece 592 (make-instance 'chart-sequece
593 :data numlst 593 :data numlst
594 :name numtitle) 594 :name numtitle)
595 (if iv 'y-axis 'x-axis)) 595 (if iv 'y-axis 'x-axis))
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 7c0161b25d2..c3ea823f95c 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -333,8 +333,8 @@ Second, any text properties will be stripped from strings."
333 (unless (and 333 (unless (and
334 ;; Do we have a type? 334 ;; Do we have a type?
335 (consp classtype) (class-p (car classtype))) 335 (consp classtype) (class-p (car classtype)))
336 (error "In save file, list of object constructors found, but no :type specified for slot %S" 336 (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
337 slot)) 337 slot classtype))
338 338
339 ;; We have a predicate, but it doesn't satisfy the predicate? 339 ;; We have a predicate, but it doesn't satisfy the predicate?
340 (dolist (PV (cdr proposed-value)) 340 (dolist (PV (cdr proposed-value))
@@ -367,10 +367,24 @@ If no class is referenced there, then return nil."
367 (cond ((class-p type) 367 (cond ((class-p type)
368 ;; If the type is a class, then return it. 368 ;; If the type is a class, then return it.
369 type) 369 type)
370 ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
371 ;; If it is the type of a list of a class, then return that class and
372 ;; the type.
373 (cons (cadr type) type))
374
375 ((and (symbolp type) (get type 'cl-deftype-handler))
376 ;; Macro-expand the type according to cl-deftype definitions.
377 (eieio-persistent-slot-type-is-class-p
378 (funcall (get type 'cl-deftype-handler))))
379
370 ;; FIXME: foo-child should not be a valid type! 380 ;; FIXME: foo-child should not be a valid type!
371 ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) 381 ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
372 (class-p (intern-soft (substring (symbol-name type) 0 382 (class-p (intern-soft (substring (symbol-name type) 0
373 (match-beginning 0))))) 383 (match-beginning 0)))))
384 (unless eieio-backward-compatibility
385 (error "Use of bogus %S type instead of %S"
386 type (intern-soft (substring (symbol-name type) 0
387 (match-beginning 0)))))
374 ;; If it is the predicate ending with -child, then return 388 ;; If it is the predicate ending with -child, then return
375 ;; that class. Unfortunately, in EIEIO, typep of just the 389 ;; that class. Unfortunately, in EIEIO, typep of just the
376 ;; class is the same as if we used -child, so no further work needed. 390 ;; class is the same as if we used -child, so no further work needed.
@@ -380,13 +394,17 @@ If no class is referenced there, then return nil."
380 ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) 394 ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
381 (class-p (intern-soft (substring (symbol-name type) 0 395 (class-p (intern-soft (substring (symbol-name type) 0
382 (match-beginning 0))))) 396 (match-beginning 0)))))
397 (unless eieio-backward-compatibility
398 (error "Use of bogus %S type instead of (list-of %S)"
399 type (intern-soft (substring (symbol-name type) 0
400 (match-beginning 0)))))
383 ;; If it is the predicate ending with -list, then return 401 ;; If it is the predicate ending with -list, then return
384 ;; that class and the predicate to use. 402 ;; that class and the predicate to use.
385 (cons (intern-soft (substring (symbol-name type) 0 403 (cons (intern-soft (substring (symbol-name type) 0
386 (match-beginning 0))) 404 (match-beginning 0)))
387 type)) 405 type))
388 406
389 ((and (consp type) (eq (car type) 'or)) 407 ((eq (car-safe type) 'or)
390 ;; If type is a list, and is an or, it is possibly something 408 ;; If type is a list, and is an or, it is possibly something
391 ;; like (or null myclass), so check for that. 409 ;; like (or null myclass), so check for that.
392 (let ((ans nil)) 410 (let ((ans nil))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 950d70f450a..f7a26d2dedb 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -77,6 +77,13 @@ default setting for optimization purposes.")
77(defvar eieio-initializing-object nil 77(defvar eieio-initializing-object nil
78 "Set to non-nil while initializing an object.") 78 "Set to non-nil while initializing an object.")
79 79
80(defvar eieio-backward-compatibility t
81 "If nil, drop support for some behaviors of older versions of EIEIO.
82Currently under control of this var:
83- Define every class as a var whose value is the class symbol.
84- Define <class>-child-p and <class>-list-p predicates.
85- Allow object names in constructors.")
86
80(defconst eieio-unbound 87(defconst eieio-unbound
81 (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) 88 (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound))
82 eieio-unbound 89 eieio-unbound
@@ -217,7 +224,10 @@ Stored outright without modifications or stripping.")))
217 224
218(defsubst eieio--class-object (class) 225(defsubst eieio--class-object (class)
219 "Return the class object." 226 "Return the class object."
220 (if (symbolp class) (eieio--class-v class) class)) 227 (if (symbolp class)
228 ;; Keep the symbol if class-v is nil, for better error messages.
229 (or (eieio--class-v class) class)
230 class))
221 231
222(defsubst eieio--class-p (class) 232(defsubst eieio--class-p (class)
223 "Return non-nil if CLASS is a valid class object." 233 "Return non-nil if CLASS is a valid class object."
@@ -251,16 +261,6 @@ CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
251 (format "#<class %s>" (symbol-name class))) 261 (format "#<class %s>" (symbol-name class)))
252(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") 262(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
253 263
254(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check."
255 ;; FIXME: Remove. And change `children' to contain class objects rather than
256 ;; class names.
257 `(eieio--class-children (eieio--class-v ,class)))
258
259(defsubst same-class-fast-p (obj class-name)
260 "Return t if OBJ is of class-type CLASS-NAME with no error checking."
261 ;; (eq (eieio--object-class-name obj) class)
262 (eq (eieio--object-class-object obj) (eieio--class-object class-name)))
263
264(defmacro class-constructor (class) 264(defmacro class-constructor (class)
265 "Return the symbol representing the constructor of CLASS." 265 "Return the symbol representing the constructor of CLASS."
266 (declare (debug t)) 266 (declare (debug t))
@@ -388,7 +388,8 @@ It creates an autoload function for CNAME's constructor."
388 (push (eieio--class-v SC) (eieio--class-parent newc))) 388 (push (eieio--class-v SC) (eieio--class-parent newc)))
389 389
390 ;; turn this into a usable self-pointing symbol 390 ;; turn this into a usable self-pointing symbol
391 (set cname cname) 391 (when eieio-backward-compatibility
392 (set cname cname))
392 393
393 ;; Store the new class vector definition into the symbol. We need to 394 ;; Store the new class vector definition into the symbol. We need to
394 ;; do this first so that we can call defmethod for the accessor. 395 ;; do this first so that we can call defmethod for the accessor.
@@ -499,7 +500,8 @@ See `defclass' for more information."
499 (setf (eieio--class-parent newc) (list eieio-default-superclass)))) 500 (setf (eieio--class-parent newc) (list eieio-default-superclass))))
500 501
501 ;; turn this into a usable self-pointing symbol; FIXME: Why? 502 ;; turn this into a usable self-pointing symbol; FIXME: Why?
502 (set cname cname) 503 (when eieio-backward-compatibility
504 (set cname cname))
503 505
504 ;; These two tests must be created right away so we can have self- 506 ;; These two tests must be created right away so we can have self-
505 ;; referencing classes. ei, a class whose slot can contain only 507 ;; referencing classes. ei, a class whose slot can contain only
@@ -520,7 +522,9 @@ See `defclass' for more information."
520 )) 522 ))
521 523
522 ;; Create a handy child test too 524 ;; Create a handy child test too
523 (let ((csym (intern (concat (symbol-name cname) "-child-p")))) 525 (let ((csym (if eieio-backward-compatibility
526 (intern (concat (symbol-name cname) "-child-p"))
527 (make-symbol (concat (symbol-name cname) "-child-p")))))
524 (fset csym 528 (fset csym
525 `(lambda (obj) 529 `(lambda (obj)
526 ,(format 530 ,(format
@@ -540,21 +544,22 @@ See `defclass' for more information."
540 (put cname 'cl-deftype-satisfies csym)) 544 (put cname 'cl-deftype-satisfies csym))
541 545
542 ;; Create a handy list of the class test too 546 ;; Create a handy list of the class test too
543 (let ((csym (intern (concat (symbol-name cname) "-list-p")))) 547 (when eieio-backward-compatibility
544 (fset csym 548 (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
545 `(lambda (obj) 549 (fset csym
546 ,(format 550 `(lambda (obj)
547 "Test OBJ to see if it a list of objects which are a child of type %s" 551 ,(format
548 cname) 552 "Test OBJ to see if it a list of objects which are a child of type %s"
549 (when (listp obj) 553 cname)
550 (let ((ans t)) ;; nil is valid 554 (when (listp obj)
551 ;; Loop over all the elements of the input list, test 555 (let ((ans t)) ;; nil is valid
552 ;; each to make sure it is a child of the desired object class. 556 ;; Loop over all the elements of the input list, test
553 (while (and obj ans) 557 ;; each to make sure it is a child of the desired object class.
554 (setq ans (and (eieio-object-p (car obj)) 558 (while (and obj ans)
555 (object-of-class-p (car obj) ,cname))) 559 (setq ans (and (eieio-object-p (car obj))
556 (setq obj (cdr obj))) 560 (object-of-class-p (car obj) ,cname)))
557 ans))))) 561 (setq obj (cdr obj)))
562 ans))))))
558 563
559 ;; Before adding new slots, let's add all the methods and classes 564 ;; Before adding new slots, let's add all the methods and classes
560 ;; in from the parent class. 565 ;; in from the parent class.
@@ -767,7 +772,8 @@ See `defclass' for more information."
767 (if (and slots 772 (if (and slots
768 (let ((x (car slots))) 773 (let ((x (car slots)))
769 (or (stringp x) (null x)))) 774 (or (stringp x) (null x))))
770 (message "Obsolete name %S passed to %S constructor" 775 (funcall (if eieio-backward-compatibility #'ignore #'message)
776 "Obsolete name %S passed to %S constructor"
771 (pop slots) ',cname)) 777 (pop slots) ',cname))
772 (apply #'eieio-constructor ',cname slots))) 778 (apply #'eieio-constructor ',cname slots)))
773 ) 779 )
@@ -833,7 +839,7 @@ If SKIPNIL is non-nil, then if VALUE is nil return t instead."
833 (if (not (or (eieio-eval-default-p value) ;FIXME: Why? 839 (if (not (or (eieio-eval-default-p value) ;FIXME: Why?
834 eieio-skip-typecheck 840 eieio-skip-typecheck
835 (and skipnil (null value)) 841 (and skipnil (null value))
836 (eieio-perform-slot-validation spec value))) 842 (eieio--perform-slot-validation spec value)))
837 (signal 'invalid-slot-type (list slot spec value)))) 843 (signal 'invalid-slot-type (list slot spec value))))
838 844
839(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc 845(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc
@@ -1155,24 +1161,12 @@ DOC-STRING is the documentation attached to METHOD."
1155 (lambda (&rest local-args) 1161 (lambda (&rest local-args)
1156 (eieio-generic-call method local-args))) 1162 (eieio-generic-call method local-args)))
1157 1163
1158(defsubst eieio-defgeneric-reset-generic-form (method) 1164(defun eieio--defgeneric-form-primary-only (method)
1159 "Setup METHOD to call the generic form."
1160 (let ((doc-string (documentation method 'raw)))
1161 (put method 'function-documentation doc-string)
1162 (fset method (eieio-defgeneric-form method))))
1163
1164(defun eieio-defgeneric-form-primary-only (method)
1165 "The lambda form that would be used as the function defined on METHOD. 1165 "The lambda form that would be used as the function defined on METHOD.
1166All methods should call the same EIEIO function for dispatch. 1166All methods should call the same EIEIO function for dispatch.
1167DOC-STRING is the documentation attached to METHOD." 1167DOC-STRING is the documentation attached to METHOD."
1168 (lambda (&rest local-args) 1168 (lambda (&rest local-args)
1169 (eieio-generic-call-primary-only method local-args))) 1169 (eieio--generic-call-primary-only method local-args)))
1170
1171(defsubst eieio-defgeneric-reset-generic-form-primary-only (method)
1172 "Setup METHOD to call the generic form."
1173 (let ((doc-string (documentation method 'raw)))
1174 (put method 'function-documentation doc-string)
1175 (fset method (eieio-defgeneric-form-primary-only method))))
1176 1170
1177(declare-function no-applicable-method "eieio" (object method &rest args)) 1171(declare-function no-applicable-method "eieio" (object method &rest args))
1178 1172
@@ -1186,7 +1180,7 @@ Keys are a number representing :before, :primary, and :after methods.")
1186During executions, the list is first generated, then as each next method 1180During executions, the list is first generated, then as each next method
1187is called, the next method is popped off the stack.") 1181is called, the next method is popped off the stack.")
1188 1182
1189(defun eieio-defgeneric-form-primary-only-one (method class impl) 1183(defun eieio--defgeneric-form-primary-only-one (method class impl)
1190 "The lambda form that would be used as the function defined on METHOD. 1184 "The lambda form that would be used as the function defined on METHOD.
1191All methods should call the same EIEIO function for dispatch. 1185All methods should call the same EIEIO function for dispatch.
1192CLASS is the class symbol needed for private method access. 1186CLASS is the class symbol needed for private method access.
@@ -1219,16 +1213,6 @@ IMPL is the symbol holding the method implementation."
1219 (eieio--with-scoped-class (eieio--class-v class) 1213 (eieio--with-scoped-class (eieio--class-v class)
1220 (apply impl local-args))))))) 1214 (apply impl local-args)))))))
1221 1215
1222(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
1223 "Setup METHOD to call the generic form."
1224 (let* ((doc-string (documentation method 'raw))
1225 (M (get method 'eieio-method-tree))
1226 (entry (car (aref M eieio--method-primary)))
1227 )
1228 (put method 'function-documentation doc-string)
1229 (fset method (eieio-defgeneric-form-primary-only-one
1230 method (car entry) (cdr entry)))))
1231
1232(defun eieio-unbind-method-implementations (method) 1216(defun eieio-unbind-method-implementations (method)
1233 "Make the generic method METHOD have no implementations. 1217 "Make the generic method METHOD have no implementations.
1234It will leave the original generic function in place, 1218It will leave the original generic function in place,
@@ -1236,6 +1220,27 @@ but remove reference to all implementations of METHOD."
1236 (put method 'eieio-method-tree nil) 1220 (put method 'eieio-method-tree nil)
1237 (put method 'eieio-method-hashtable nil)) 1221 (put method 'eieio-method-hashtable nil))
1238 1222
1223(defun eieio--method-optimize-primary (method)
1224 (when eieio-optimize-primary-methods-flag
1225 ;; Optimizing step:
1226 ;;
1227 ;; If this method, after this setup, only has primary methods, then
1228 ;; we can setup the generic that way.
1229 (let ((doc-string (documentation method 'raw)))
1230 (put method 'function-documentation doc-string)
1231 ;; Use `defalias' so as to interact properly with nadvice.el.
1232 (defalias method
1233 (if (generic-primary-only-p method)
1234 ;; If there is only one primary method, then we can go one more
1235 ;; optimization step.
1236 (if (generic-primary-only-one-p method)
1237 (let* ((M (get method 'eieio-method-tree))
1238 (entry (car (aref M eieio--method-primary))))
1239 (eieio--defgeneric-form-primary-only-one
1240 method (car entry) (cdr entry)))
1241 (eieio--defgeneric-form-primary-only method))
1242 (eieio-defgeneric-form method))))))
1243
1239(defun eieio--defmethod (method kind argclass code) 1244(defun eieio--defmethod (method kind argclass code)
1240 "Work part of the `defmethod' macro defining METHOD with ARGS." 1245 "Work part of the `defmethod' macro defining METHOD with ARGS."
1241 (let ((key 1246 (let ((key
@@ -1272,18 +1277,7 @@ but remove reference to all implementations of METHOD."
1272 (eieiomt-add method code key argclass) 1277 (eieiomt-add method code key argclass)
1273 ) 1278 )
1274 1279
1275 (when eieio-optimize-primary-methods-flag 1280 (eieio--method-optimize-primary method)
1276 ;; Optimizing step:
1277 ;;
1278 ;; If this method, after this setup, only has primary methods, then
1279 ;; we can setup the generic that way.
1280 (if (generic-primary-only-p method)
1281 ;; If there is only one primary method, then we can go one more
1282 ;; optimization step.
1283 (if (generic-primary-only-one-p method)
1284 (eieio-defgeneric-reset-generic-form-primary-only-one method)
1285 (eieio-defgeneric-reset-generic-form-primary-only method))
1286 (eieio-defgeneric-reset-generic-form method)))
1287 1281
1288 method) 1282 method)
1289 1283
@@ -1293,13 +1287,13 @@ but remove reference to all implementations of METHOD."
1293;; requiring the CL library at run-time. It can be eliminated if/when 1287;; requiring the CL library at run-time. It can be eliminated if/when
1294;; `typep' is merged into Emacs core. 1288;; `typep' is merged into Emacs core.
1295 1289
1296(defun eieio-perform-slot-validation (spec value) 1290(defun eieio--perform-slot-validation (spec value)
1297 "Return non-nil if SPEC does not match VALUE." 1291 "Return non-nil if SPEC does not match VALUE."
1298 (or (eq spec t) ; t always passes 1292 (or (eq spec t) ; t always passes
1299 (eq value eieio-unbound) ; unbound always passes 1293 (eq value eieio-unbound) ; unbound always passes
1300 (cl-typep value spec))) 1294 (cl-typep value spec)))
1301 1295
1302(defun eieio-validate-slot-value (class slot-idx value slot) 1296(defun eieio--validate-slot-value (class slot-idx value slot)
1303 "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. 1297 "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
1304Checks the :type specifier. 1298Checks the :type specifier.
1305SLOT is the slot that is being checked, and is only used when throwing 1299SLOT is the slot that is being checked, and is only used when throwing
@@ -1308,21 +1302,23 @@ an error."
1308 nil 1302 nil
1309 ;; Trim off object IDX junk added in for the object index. 1303 ;; Trim off object IDX junk added in for the object index.
1310 (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) 1304 (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
1311 (let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx))) 1305 (let ((st (aref (eieio--class-public-type class) slot-idx)))
1312 (if (not (eieio-perform-slot-validation st value)) 1306 (if (not (eieio--perform-slot-validation st value))
1313 (signal 'invalid-slot-type (list class slot st value)))))) 1307 (signal 'invalid-slot-type
1308 (list (eieio--class-symbol class) slot st value))))))
1314 1309
1315(defun eieio-validate-class-slot-value (class slot-idx value slot) 1310(defun eieio--validate-class-slot-value (class slot-idx value slot)
1316 "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. 1311 "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
1317Checks the :type specifier. 1312Checks the :type specifier.
1318SLOT is the slot that is being checked, and is only used when throwing 1313SLOT is the slot that is being checked, and is only used when throwing
1319an error." 1314an error."
1320 (if eieio-skip-typecheck 1315 (if eieio-skip-typecheck
1321 nil 1316 nil
1322 (let ((st (aref (eieio--class-class-allocation-type (eieio--class-v class)) 1317 (let ((st (aref (eieio--class-class-allocation-type class)
1323 slot-idx))) 1318 slot-idx)))
1324 (if (not (eieio-perform-slot-validation st value)) 1319 (if (not (eieio--perform-slot-validation st value))
1325 (signal 'invalid-slot-type (list class slot st value)))))) 1320 (signal 'invalid-slot-type
1321 (list (eieio--class-symbol class) slot st value))))))
1326 1322
1327(defun eieio-barf-if-slot-unbound (value instance slotname fn) 1323(defun eieio-barf-if-slot-unbound (value instance slotname fn)
1328 "Throw a signal if VALUE is a representation of an UNBOUND slot. 1324 "Throw a signal if VALUE is a representation of an UNBOUND slot.
@@ -1389,6 +1385,8 @@ Fills in OBJ's SLOT with its default value."
1389 1385
1390(defun eieio-default-eval-maybe (val) 1386(defun eieio-default-eval-maybe (val)
1391 "Check VAL, and return what `oref-default' would provide." 1387 "Check VAL, and return what `oref-default' would provide."
1388 ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate
1389 ;; variables as well? Why not just always call `eval'?
1392 (cond 1390 (cond
1393 ;; Is it a function call? If so, evaluate it. 1391 ;; Is it a function call? If so, evaluate it.
1394 ((eieio-eval-default-p val) 1392 ((eieio-eval-default-p val)
@@ -1413,41 +1411,41 @@ Fills in OBJ's SLOT with VALUE."
1413 (eieio--class-slot-name-index class slot)) 1411 (eieio--class-slot-name-index class slot))
1414 ;; Oset that slot. 1412 ;; Oset that slot.
1415 (progn 1413 (progn
1416 (eieio-validate-class-slot-value (eieio--class-symbol class) 1414 (eieio--validate-class-slot-value class c value slot)
1417 c value slot)
1418 (aset (eieio--class-class-allocation-values class) 1415 (aset (eieio--class-class-allocation-values class)
1419 c value)) 1416 c value))
1420 ;; See oref for comment on `slot-missing' 1417 ;; See oref for comment on `slot-missing'
1421 (slot-missing obj slot 'oset value) 1418 (slot-missing obj slot 'oset value)
1422 ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) 1419 ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
1423 ) 1420 )
1424 (eieio-validate-slot-value (eieio--class-symbol class) c value slot) 1421 (eieio--validate-slot-value class c value slot)
1425 (aset obj c value)))) 1422 (aset obj c value))))
1426 1423
1427(defun eieio-oset-default (class slot value) 1424(defun eieio-oset-default (class slot value)
1428 "Do the work for the macro `oset-default'. 1425 "Do the work for the macro `oset-default'.
1429Fills in the default value in CLASS' in SLOT with VALUE." 1426Fills in the default value in CLASS' in SLOT with VALUE."
1430 (eieio--check-type class-p class) 1427 (setq class (eieio--class-object class))
1428 (eieio--check-type eieio--class-p class)
1431 (eieio--check-type symbolp slot) 1429 (eieio--check-type symbolp slot)
1432 (eieio--with-scoped-class (eieio--class-v class) 1430 (eieio--with-scoped-class class
1433 (let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot))) 1431 (let* ((c (eieio--slot-name-index class nil slot)))
1434 (if (not c) 1432 (if (not c)
1435 ;; It might be missing because it is a :class allocated slot. 1433 ;; It might be missing because it is a :class allocated slot.
1436 ;; Let's check that info out. 1434 ;; Let's check that info out.
1437 (if (setq c (eieio--class-slot-name-index (eieio--class-v class) slot)) 1435 (if (setq c (eieio--class-slot-name-index class slot))
1438 (progn 1436 (progn
1439 ;; Oref that slot. 1437 ;; Oref that slot.
1440 (eieio-validate-class-slot-value class c value slot) 1438 (eieio--validate-class-slot-value class c value slot)
1441 (aset (eieio--class-class-allocation-values (eieio--class-v class)) c 1439 (aset (eieio--class-class-allocation-values class) c
1442 value)) 1440 value))
1443 (signal 'invalid-slot-name (list (eieio-class-name class) slot))) 1441 (signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
1444 (eieio-validate-slot-value class c value slot) 1442 (eieio--validate-slot-value class c value slot)
1445 ;; Set this into the storage for defaults. 1443 ;; Set this into the storage for defaults.
1446 (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) 1444 (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
1447 (eieio--class-public-d (eieio--class-v class))) 1445 (eieio--class-public-d class))
1448 value) 1446 value)
1449 ;; Take the value, and put it into our cache object. 1447 ;; Take the value, and put it into our cache object.
1450 (eieio-oset (eieio--class-default-object-cache (eieio--class-v class)) 1448 (eieio-oset (eieio--class-default-object-cache class)
1451 slot value) 1449 slot value)
1452 )))) 1450 ))))
1453 1451
@@ -1808,7 +1806,7 @@ This should only be called from a generic function."
1808 (list method args)))) 1806 (list method args))))
1809 rval))) 1807 rval)))
1810 1808
1811(defun eieio-generic-call-primary-only (method args) 1809(defun eieio--generic-call-primary-only (method args)
1812 "Call METHOD with ARGS for methods with only :PRIMARY implementations. 1810 "Call METHOD with ARGS for methods with only :PRIMARY implementations.
1813ARGS provides the context on which implementation to use. 1811ARGS provides the context on which implementation to use.
1814This should only be called from a generic function. 1812This should only be called from a generic function.
@@ -2124,18 +2122,7 @@ is memorized for faster future use."
2124 key argclass)) 2122 key argclass))
2125 ) 2123 )
2126 2124
2127 (when eieio-optimize-primary-methods-flag 2125 (eieio--method-optimize-primary method)
2128 ;; Optimizing step:
2129 ;;
2130 ;; If this method, after this setup, only has primary methods, then
2131 ;; we can setup the generic that way.
2132 (if (generic-primary-only-p method)
2133 ;; If there is only one primary method, then we can go one more
2134 ;; optimization step.
2135 (if (generic-primary-only-one-p method)
2136 (eieio-defgeneric-reset-generic-form-primary-only-one method)
2137 (eieio-defgeneric-reset-generic-form-primary-only method))
2138 (eieio-defgeneric-reset-generic-form method)))
2139 2126
2140 method) 2127 method)
2141(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") 2128(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index be3c2b0cc94..4896a4cdead 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -221,7 +221,7 @@ Outputs to the current buffer."
221 (cl-mapcan 221 (cl-mapcan
222 (lambda (c) 222 (lambda (c)
223 (append (list c) (eieio-build-class-list c))) 223 (append (list c) (eieio-build-class-list c)))
224 (eieio-class-children-fast class)) 224 (eieio--class-children (eieio--class-v class)))
225 (list class))) 225 (list class)))
226 226
227(defun eieio-build-class-alist (&optional class instantiable-only buildlist) 227(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
@@ -423,16 +423,10 @@ function has no documentation, then return nil."
423(defvar eieio-read-generic nil 423(defvar eieio-read-generic nil
424 "History of the `eieio-read-generic' prompt.") 424 "History of the `eieio-read-generic' prompt.")
425 425
426(defun eieio-read-generic-p (fn)
427 "Function used in function `eieio-read-generic'.
428This is because `generic-p' is a macro.
429Argument FN is the function to test."
430 (generic-p fn))
431
432(defun eieio-read-generic (prompt &optional historyvar) 426(defun eieio-read-generic (prompt &optional historyvar)
433 "Read a generic function from the minibuffer with PROMPT. 427 "Read a generic function from the minibuffer with PROMPT.
434Optional argument HISTORYVAR is the variable to use as history." 428Optional argument HISTORYVAR is the variable to use as history."
435 (intern (completing-read prompt obarray 'eieio-read-generic-p 429 (intern (completing-read prompt obarray #'generic-p
436 t nil (or historyvar 'eieio-read-generic)))) 430 t nil (or historyvar 'eieio-read-generic))))
437 431
438;;; METHOD STATS 432;;; METHOD STATS
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 878667106c8..fdeba5e55f0 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -328,7 +328,7 @@ The CLOS function `class-direct-superclasses' is aliased to this function."
328 "Return child classes to CLASS. 328 "Return child classes to CLASS.
329The CLOS function `class-direct-subclasses' is aliased to this function." 329The CLOS function `class-direct-subclasses' is aliased to this function."
330 (eieio--check-type class-p class) 330 (eieio--check-type class-p class)
331 (eieio-class-children-fast class)) 331 (eieio--class-children (eieio--class-v class)))
332(define-obsolete-function-alias 332(define-obsolete-function-alias
333 'class-children #'eieio-class-children "24.4") 333 'class-children #'eieio-class-children "24.4")
334 334
@@ -343,10 +343,12 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
343 `(car (eieio-class-parents ,class))) 343 `(car (eieio-class-parents ,class)))
344(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") 344(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4")
345 345
346(defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." 346(defun same-class-p (obj class)
347 (eieio--check-type class-p class) 347 "Return t if OBJ is of class-type CLASS."
348 (setq class (eieio--class-object class))
349 (eieio--check-type eieio--class-p class)
348 (eieio--check-type eieio-object-p obj) 350 (eieio--check-type eieio-object-p obj)
349 (same-class-fast-p obj class)) 351 (eq (eieio--object-class-object obj) class))
350 352
351(defun object-of-class-p (obj class) 353(defun object-of-class-p (obj class)
352 "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." 354 "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
@@ -546,7 +548,7 @@ Use `next-method-p' to find out if there is a next method to call."
546 (next (car eieio-generic-call-next-method-list)) 548 (next (car eieio-generic-call-next-method-list))
547 ) 549 )
548 (if (not (and next (car next))) 550 (if (not (and next (car next)))
549 (apply #'no-next-method (car newargs) (cdr newargs)) 551 (apply #'no-next-method newargs)
550 (let* ((eieio-generic-call-next-method-list 552 (let* ((eieio-generic-call-next-method-list
551 (cdr eieio-generic-call-next-method-list)) 553 (cdr eieio-generic-call-next-method-list))
552 (eieio-generic-call-arglst newargs) 554 (eieio-generic-call-arglst newargs)
@@ -723,7 +725,8 @@ first and modify the returned object.")
723 "Make a copy of OBJ, and then apply PARAMS." 725 "Make a copy of OBJ, and then apply PARAMS."
724 (let ((nobj (copy-sequence obj))) 726 (let ((nobj (copy-sequence obj)))
725 (if (stringp (car params)) 727 (if (stringp (car params))
726 (message "Obsolete name %S passed to clone" (pop params))) 728 (funcall (if eieio-backward-compatibility #'ignore #'message)
729 "Obsolete name %S passed to clone" (pop params)))
727 (if params (shared-initialize nobj params)) 730 (if params (shared-initialize nobj params))
728 nobj)) 731 nobj))
729 732
@@ -889,7 +892,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
889 892
890;;; Start of automatically extracted autoloads. 893;;; Start of automatically extracted autoloads.
891 894
892;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "a3f314e2a27e52444df4597c6ae51458") 895;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "7d3c0bca065713ae74af0c07778dd1f4")
893;;; Generated autoloads from eieio-custom.el 896;;; Generated autoloads from eieio-custom.el
894 897
895(autoload 'customize-object "eieio-custom" "\ 898(autoload 'customize-object "eieio-custom" "\
@@ -900,7 +903,7 @@ Optional argument GROUP is the sub-group of slots to display.
900 903
901;;;*** 904;;;***
902 905
903;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "2ff7d98da3f84c6af5c873ffb781930e") 906;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6377e022e85d377b399f44c98b4eab4a")
904;;; Generated autoloads from eieio-opt.el 907;;; Generated autoloads from eieio-opt.el
905 908
906(autoload 'eieio-browse "eieio-opt" "\ 909(autoload 'eieio-browse "eieio-opt" "\
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 6f0ea0f57de..91c08c49d48 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
12015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * registry.el: Don't use <class> as a variable.
4
12014-12-18 Paul Eggert <eggert@cs.ucla.edu> 52014-12-18 Paul Eggert <eggert@cs.ucla.edu>
2 6
3 * registry.el (registry-db): Set default slot later. 7 * registry.el (registry-db): Set default slot later.
@@ -26011,7 +26015,7 @@
26011 26015
26012See ChangeLog.2 for earlier changes. 26016See ChangeLog.2 for earlier changes.
26013 26017
26014 Copyright (C) 2004-2014 Free Software Foundation, Inc. 26018 Copyright (C) 2004-2015 Free Software Foundation, Inc.
26015 26019
26016 This file is part of GNU Emacs. 26020 This file is part of GNU Emacs.
26017 26021
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index 69f5058b8ac..55b83a8e889 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -1,6 +1,6 @@
1;;; registry.el --- Track and remember data items by various fields 1;;; registry.el --- Track and remember data items by various fields
2 2
3;; Copyright (C) 2011-2014 Free Software Foundation, Inc. 3;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
4 4
5;; Author: Teodor Zlatanov <tzz@lifelogs.com> 5;; Author: Teodor Zlatanov <tzz@lifelogs.com>
6;; Keywords: data 6;; Keywords: data
@@ -124,7 +124,7 @@
124 :type hash-table 124 :type hash-table
125 :documentation "The data hashtable."))) 125 :documentation "The data hashtable.")))
126;; Do this separately, since defclass doesn't allow expressions in :initform. 126;; Do this separately, since defclass doesn't allow expressions in :initform.
127(oset-default registry-db max-size most-positive-fixnum) 127(oset-default 'registry-db max-size most-positive-fixnum)
128 128
129(defmethod initialize-instance :BEFORE ((this registry-db) slots) 129(defmethod initialize-instance :BEFORE ((this registry-db) slots)
130 "Check whether a registry object needs to be upgraded." 130 "Check whether a registry object needs to be upgraded."
diff --git a/test/ChangeLog b/test/ChangeLog
index 8e3b83efbb0..bb480280970 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,15 @@
12015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable.
4 Don't use <class>-list types and <class>-list-p predicates.
5
6 * automated/eieio-test-persist.el (persistent-with-objs-list-slot):
7 Don't use <class>-list type.
8
9 * automated/eieio-test-methodinvoke.el
10 (eieio-test-method-order-list-4):
11 Don't use <class> as a variable.
12
12015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> 132015-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
2 14
3 * automated/eieio-tests.el (eieio-test-04-static-method) 15 * automated/eieio-tests.el (eieio-test-04-static-method)
@@ -2423,7 +2435,7 @@
2423;; coding: utf-8 2435;; coding: utf-8
2424;; End: 2436;; End:
2425 2437
2426 Copyright (C) 2008-2014 Free Software Foundation, Inc. 2438 Copyright (C) 2008-2015 Free Software Foundation, Inc.
2427 2439
2428 This file is part of GNU Emacs. 2440 This file is part of GNU Emacs.
2429 2441
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index f99ee8d1f46..7790c13327f 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -145,7 +145,7 @@
145 145
146(ert-deftest eieio-test-method-order-list-4 () 146(ert-deftest eieio-test-method-order-list-4 ()
147 ;; Both of these situations should succeed. 147 ;; Both of these situations should succeed.
148 (should (eitest-H eitest-A)) 148 (should (eitest-H 'eitest-A))
149 (should (eitest-H (eitest-A nil)))) 149 (should (eitest-H (eitest-A nil))))
150 150
151;;; Return value from :PRIMARY 151;;; Return value from :PRIMARY
diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el
index 5ea7cf25740..d6f7c90e18c 100644
--- a/test/automated/eieio-test-persist.el
+++ b/test/automated/eieio-test-persist.el
@@ -203,7 +203,7 @@ persistent class.")
203;; A slot that contains another object that isn't persistent 203;; A slot that contains another object that isn't persistent
204(defclass persistent-with-objs-list-slot (eieio-persistent) 204(defclass persistent-with-objs-list-slot (eieio-persistent)
205 ((pnp :initarg :pnp 205 ((pnp :initarg :pnp
206 :type persist-not-persistent-list 206 :type (list-of persist-not-persistent)
207 :initform nil)) 207 :initform nil))
208 "Class for testing the saving of slots with objects in them.") 208 "Class for testing the saving of slots with objects in them.")
209 209
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index f3088bacf32..13f4a5728ed 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -28,7 +28,7 @@
28(require 'eieio-base) 28(require 'eieio-base)
29(require 'eieio-opt) 29(require 'eieio-opt)
30 30
31(eval-when-compile (require 'cl)) 31(eval-when-compile (require 'cl-lib))
32 32
33;;; Code: 33;;; Code:
34;; Set up some test classes 34;; Set up some test classes
@@ -198,10 +198,10 @@ Argument C is the class bound to this static method."
198 198
199(ert-deftest eieio-test-04-static-method () 199(ert-deftest eieio-test-04-static-method ()
200 ;; Call static method on a class and see if it worked 200 ;; Call static method on a class and see if it worked
201 (static-method-class-method static-method-class 'class) 201 (static-method-class-method 'static-method-class 'class)
202 (should (eq (oref-default static-method-class some-slot) 'class)) 202 (should (eq (oref-default 'static-method-class some-slot) 'class))
203 (static-method-class-method (static-method-class) 'object) 203 (static-method-class-method (static-method-class) 'object)
204 (should (eq (oref-default static-method-class some-slot) 'object))) 204 (should (eq (oref-default 'static-method-class some-slot) 'object)))
205 205
206(ert-deftest eieio-test-05-static-method-2 () 206(ert-deftest eieio-test-05-static-method-2 ()
207 (defclass static-method-class-2 (static-method-class) 207 (defclass static-method-class-2 (static-method-class)
@@ -214,10 +214,10 @@ Argument C is the class bound to this static method."
214 (if (eieio-object-p c) (setq c (eieio-object-class c))) 214 (if (eieio-object-p c) (setq c (eieio-object-class c)))
215 (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) 215 (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
216 216
217 (static-method-class-method static-method-class-2 'class) 217 (static-method-class-method 'static-method-class-2 'class)
218 (should (eq (oref-default static-method-class-2 some-slot) 'moose-class)) 218 (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
219 (static-method-class-method (static-method-class-2) 'object) 219 (static-method-class-method (static-method-class-2) 'object)
220 (should (eq (oref-default static-method-class-2 some-slot) 'moose-object))) 220 (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object)))
221 221
222 222
223;;; Perform method testing 223;;; Perform method testing
@@ -473,12 +473,12 @@ METHOD is the method that was attempting to be called."
473 473
474 ;; Slot should be bound 474 ;; Slot should be bound
475 (should (slot-boundp eitest-a 'classslot)) 475 (should (slot-boundp eitest-a 'classslot))
476 (should (slot-boundp class-a 'classslot)) 476 (should (slot-boundp 'class-a 'classslot))
477 477
478 (slot-makeunbound eitest-a 'classslot) 478 (slot-makeunbound eitest-a 'classslot)
479 479
480 (should-not (slot-boundp eitest-a 'classslot)) 480 (should-not (slot-boundp eitest-a 'classslot))
481 (should-not (slot-boundp class-a 'classslot))) 481 (should-not (slot-boundp 'class-a 'classslot)))
482 482
483 483
484(defvar eieio-test-permuting-value nil) 484(defvar eieio-test-permuting-value nil)
@@ -529,17 +529,17 @@ METHOD is the method that was attempting to be called."
529 :type 'invalid-slot-type)) 529 :type 'invalid-slot-type))
530 530
531(ert-deftest eieio-test-23-inheritance-check () 531(ert-deftest eieio-test-23-inheritance-check ()
532 (should (child-of-class-p class-ab class-a)) 532 (should (child-of-class-p 'class-ab 'class-a))
533 (should (child-of-class-p class-ab class-b)) 533 (should (child-of-class-p 'class-ab 'class-b))
534 (should (object-of-class-p eitest-a class-a)) 534 (should (object-of-class-p eitest-a 'class-a))
535 (should (object-of-class-p eitest-ab class-a)) 535 (should (object-of-class-p eitest-ab 'class-a))
536 (should (object-of-class-p eitest-ab class-b)) 536 (should (object-of-class-p eitest-ab 'class-b))
537 (should (object-of-class-p eitest-ab class-ab)) 537 (should (object-of-class-p eitest-ab 'class-ab))
538 (should (eq (eieio-class-parents class-a) nil)) 538 (should (eq (eieio-class-parents 'class-a) nil))
539 ;; FIXME: eieio-class-parents now returns class objects! 539 ;; FIXME: eieio-class-parents now returns class objects!
540 (should (equal (mapcar #'eieio-class-object (eieio-class-parents class-ab)) 540 (should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab))
541 (mapcar #'eieio-class-object '(class-a class-b)))) 541 (mapcar #'eieio-class-object '(class-a class-b))))
542 (should (same-class-p eitest-a class-a)) 542 (should (same-class-p eitest-a 'class-a))
543 (should (class-a-p eitest-a)) 543 (should (class-a-p eitest-a))
544 (should (not (class-a-p eitest-ab))) 544 (should (not (class-a-p eitest-ab)))
545 (should (class-a-child-p eitest-a)) 545 (should (class-a-child-p eitest-a))
@@ -550,10 +550,10 @@ METHOD is the method that was attempting to be called."
550(ert-deftest eieio-test-24-object-predicates () 550(ert-deftest eieio-test-24-object-predicates ()
551 (let ((listooa (list (class-ab) (class-a))) 551 (let ((listooa (list (class-ab) (class-a)))
552 (listoob (list (class-ab) (class-b)))) 552 (listoob (list (class-ab) (class-b))))
553 (should (class-a-list-p listooa)) 553 (should (cl-typep listooa '(list-of class-a)))
554 (should (class-b-list-p listoob)) 554 (should (cl-typep listoob '(list-of class-b)))
555 (should-not (class-b-list-p listooa)) 555 (should-not (cl-typep listooa '(list-of class-b)))
556 (should-not (class-a-list-p listoob)))) 556 (should-not (cl-typep listoob '(list-of class-a)))))
557 557
558(defvar eitest-t1 nil) 558(defvar eitest-t1 nil)
559(ert-deftest eieio-test-25-slot-tests () 559(ert-deftest eieio-test-25-slot-tests ()
@@ -568,7 +568,7 @@ METHOD is the method that was attempting to be called."
568 ;; Pass string instead of symbol 568 ;; Pass string instead of symbol
569 (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type) 569 (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type)
570 (should (eq (get-slot-3 eitest-t1) 'emu)) 570 (should (eq (get-slot-3 eitest-t1) 'emu))
571 (should (eq (get-slot-3 class-c) 'emu)) 571 (should (eq (get-slot-3 'class-c) 'emu))
572 ;; Check setf 572 ;; Check setf
573 (setf (get-slot-3 eitest-t1) 'setf-emu) 573 (setf (get-slot-3 eitest-t1) 'setf-emu)
574 (should (eq (get-slot-3 eitest-t1) 'setf-emu)) 574 (should (eq (get-slot-3 eitest-t1) 'setf-emu))
@@ -793,7 +793,7 @@ Subclasses to override slot attributes.")
793 ((type :type string) 793 ((type :type string)
794 ) 794 )
795 "This class should throw an error."))) 795 "This class should throw an error.")))
796 (should (eq (oref-default slotattr-class-ok initform) 'no-init))) 796 (should (eq (oref-default 'slotattr-class-ok initform) 'no-init)))
797 797
798(ert-deftest eieio-test-32-slot-attribute-override-2 () 798(ert-deftest eieio-test-32-slot-attribute-override-2 ()
799 (let* ((cv (eieio--class-v 'slotattr-ok)) 799 (let* ((cv (eieio--class-v 'slotattr-ok))
@@ -883,8 +883,8 @@ Subclasses to override slot attributes.")
883 "Instantiable child") 883 "Instantiable child")
884 884
885(ert-deftest eieio-test-36-build-class-alist () 885(ert-deftest eieio-test-36-build-class-alist ()
886 (should (= (length (eieio-build-class-alist opt-test1 nil)) 2)) 886 (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
887 (should (= (length (eieio-build-class-alist opt-test1 t)) 1))) 887 (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
888 888
889(provide 'eieio-tests) 889(provide 'eieio-tests)
890 890