diff options
| author | Stefan Monnier | 2015-01-07 23:11:58 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-01-07 23:11:58 -0500 |
| commit | 1599688e95802c34f35819f5600a48a81248732c (patch) | |
| tree | 30de69970ba2e145c374e78b3a1606a443169771 | |
| parent | cb4db863192aed6c4d0b28e6490f08d5518ff3e7 (diff) | |
| download | emacs-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.
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 @@ | |||
| 1 | 2015-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 | |||
| 1 | 2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> | 44 | 2015-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 @@ | |||
| 1 | 2015-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 | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | 50 | 2014-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. |
| 73 | OBJ is the target object to customize." | 73 | OBJ 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 | |||
| 297 | the PROJECT being read in is the root project." | 297 | the 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. |
| 180 | Uses default implementation, and also gets a list of filenames." | 180 | Uses 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. |
| 189 | Keeps STRINGS only in the history.") | 189 | Keeps 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. |
| 1877 | Use this to enable custom editing.") | 1879 | Use 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'." | |||
| 192 | If DIRECTORY is found to be defunct, it won't load the DB, and will | 192 | If DIRECTORY is found to be defunct, it won't load the DB, and will |
| 193 | warn instead." | 193 | warn 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. | |||
| 1114 | If optional argument BRUTISH is non-nil, then ignore include statements, | 1114 | If optional argument BRUTISH is non-nil, then ignore include statements, |
| 1115 | and search all tables in this project tree." | 1115 | and 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. |
| 182 | If there is no table, create one, and fill it in." | 182 | If 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 | |||
| 378 | if a user presses any key during execution, this form macro | 378 | if a user presses any key during execution, this form macro |
| 379 | will exit with the value passed to `semantic-throw-on-input'. | 379 | will exit with the value passed to `semantic-throw-on-input'. |
| 380 | If FORMS completes, then the return value is the same as `progn'." | 380 | If 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 | |||
| 391 | calling this one." | 391 | calling 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. |
| 1670 | EXPANDER is the name of the function that expands MACRO." | 1672 | EXPANDER 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.") | |||
| 87 | Useful if something goes wrong in SRecode, and the active template | 87 | Useful if something goes wrong in SRecode, and the active template |
| 88 | stack is broken." | 88 | stack 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. | |||
| 577 | Optional arguments: | 577 | Optional arguments: |
| 578 | Set the chart's max element display to MAX, and sort lists with | 578 | Set the chart's max element display to MAX, and sort lists with |
| 579 | SORT-PRED if desired." | 579 | SORT-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. | ||
| 82 | Currently 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. |
| 1166 | All methods should call the same EIEIO function for dispatch. | 1166 | All methods should call the same EIEIO function for dispatch. |
| 1167 | DOC-STRING is the documentation attached to METHOD." | 1167 | DOC-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.") | |||
| 1186 | During executions, the list is first generated, then as each next method | 1180 | During executions, the list is first generated, then as each next method |
| 1187 | is called, the next method is popped off the stack.") | 1181 | is 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. |
| 1191 | All methods should call the same EIEIO function for dispatch. | 1185 | All methods should call the same EIEIO function for dispatch. |
| 1192 | CLASS is the class symbol needed for private method access. | 1186 | CLASS 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. |
| 1234 | It will leave the original generic function in place, | 1218 | It 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. |
| 1304 | Checks the :type specifier. | 1298 | Checks the :type specifier. |
| 1305 | SLOT is the slot that is being checked, and is only used when throwing | 1299 | SLOT 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. |
| 1317 | Checks the :type specifier. | 1312 | Checks the :type specifier. |
| 1318 | SLOT is the slot that is being checked, and is only used when throwing | 1313 | SLOT is the slot that is being checked, and is only used when throwing |
| 1319 | an error." | 1314 | an 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'. |
| 1429 | Fills in the default value in CLASS' in SLOT with VALUE." | 1426 | Fills 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. |
| 1813 | ARGS provides the context on which implementation to use. | 1811 | ARGS provides the context on which implementation to use. |
| 1814 | This should only be called from a generic function. | 1812 | This 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'. | ||
| 428 | This is because `generic-p' is a macro. | ||
| 429 | Argument 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. |
| 434 | Optional argument HISTORYVAR is the variable to use as history." | 428 | Optional 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. |
| 329 | The CLOS function `class-direct-subclasses' is aliased to this function." | 329 | The 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 @@ | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * registry.el: Don't use <class> as a variable. | ||
| 4 | |||
| 1 | 2014-12-18 Paul Eggert <eggert@cs.ucla.edu> | 5 | 2014-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 | ||
| 26012 | See ChangeLog.2 for earlier changes. | 26016 | See 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 @@ | |||
| 1 | 2015-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 | |||
| 1 | 2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> | 13 | 2015-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 | ||