diff options
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 @@ +2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): + Don't use <class> as a variable. + + * emacs-lisp/eieio.el (same-class-p): Accept class object as well. + (call-next-method): Simplify. + (clone): Obey eieio-backward-compatibility. + + * emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove. + (eieio-read-generic): Use `generic-p' instead. + + * 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. + + * 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. + 2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects. @@ -22547,7 +22590,7 @@ See ChangeLog.16 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 2011-2014 Free Software Foundation, Inc. + Copyright (C) 2011-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. 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 @@ +2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> + + Don't use <class> as a variable and don't assume that <class>-list-p is + automatically defined. + + * ede/speedbar.el (ede-speedbar-compile-line) + (ede-speedbar-get-top-project-for-line): + * ede.el (ede-buffer-belongs-to-target-p) + (ede-buffer-belongs-to-project-p, ede-build-forms-menu) + (ede-add-project-to-global-list): + * semantic/db-typecache.el (semanticdb-get-typecache): + * semantic/db-file.el (semanticdb-load-database): + * semantic/db-el.el (semanticdb-elisp-sym->tag): + * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper): + * ede/project-am.el (project-am-preferred-target-type): + * ede/proj.el (ede-proj-load): + * ede/custom.el (ede-customize-current-target, ede-customize-target): + * semantic/ede-grammar.el ("semantic grammar"): + * semantic/scope.el (semantic-scope-reset-cache) + (semantic-calculate-scope): + * srecode/map.el (srecode-map-update-map): + * srecode/insert.el (srecode-insert-show-error-report) + (srecode-insert-method, srecode-insert-include-lookup) + (srecode-insert-method): + * srecode/fields.el (srecode-active-template-region): + * srecode/compile.el (srecode-flush-active-templates) + (srecode-compile-inserter): Don't use <class> as a variable. + Use `oref-default' for class slots. + + * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var. + (semantic-grammar-eldoc-get-macro-docstring): Use it instead of + eldoc-last-data. + * semantic/fw.el (semantic-exit-on-input): Use `declare'. + (semantic-throw-on-input): Use `with-current-buffer'. + * semantic/db.el (semanticdb-abstract-table-list): Define if not + pre-defined. + * semantic/db-find.el (semanticdb-find-tags-collector): + Use save-current-buffer. + (semanticdb-find-tags-collector): Don't use <class> as a variable. + * 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. + * semantic/bovine/make.el (semantic-analyze-possible-completions): + Use with-current-buffer. + * semantic.el (semantic-parser-warnings): Declare. + * ede/base.el (ede-target-list): Define if not pre-defined. + (ede-with-projectfile): Prefer find-file-noselect over + save-window-excursion. + 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children. @@ -3379,7 +3428,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2009-2014 Free Software Foundation, Inc. + Copyright (C) 2009-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. 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 @@ ;;; ede.el --- Emacs Development Environment gloss -;; Copyright (C) 1998-2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -248,12 +248,12 @@ Argument LIST-O-O is the list of objects to choose from." (let ((obj ede-object)) (if (consp obj) (setq obj (car obj))) - (and obj (obj-of-class-p obj ede-target)))) + (and obj (obj-of-class-p obj 'ede-target)))) (defun ede-buffer-belongs-to-project-p () "Return non-nil if this buffer belongs to at least one project." (if (or (null ede-object) (consp ede-object)) nil - (obj-of-class-p ede-object-project ede-project))) + (obj-of-class-p ede-object-project 'ede-project))) (defun ede-menu-obj-of-class-p (class) "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." ;; First, collect the build items from the project (setq newmenu (append newmenu (ede-menu-items-build obj t))) ;; Second, declare the current target menu items - (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) + (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target)) (while ede-obj (setq newmenu (append newmenu (ede-menu-items-build (car ede-obj) t)) @@ -1078,7 +1078,7 @@ On success, return the added project." (error "No project created to add to master list")) (when (not (eieio-object-p proj)) (error "Attempt to add non-object to master project list")) - (when (not (obj-of-class-p proj ede-project-placeholder)) + (when (not (obj-of-class-p proj 'ede-project-placeholder)) (error "Attempt to add a non-project to the ede projects list")) (add-to-list 'ede-projects proj) proj) @@ -1099,6 +1099,8 @@ Flush the dead projects from the project cache." (ede-delete-project-from-global-list D)) )) +(defvar ede--disable-inode) ;Defined in ede/files.el. + (defun ede-global-list-sanity-check () "Perform a sanity check to make sure there are no duplicate projects." (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 @@ ;;; ede/base.el --- Baseclasses for EDE. -;; Copyright (C) 2010-2014 Free Software Foundation, Inc. +;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -159,6 +159,9 @@ and querying them will cause the actual project to get loaded.") ;; Projects can also affect how EDE works, by changing what appears in ;; the EDE menu, or how some keys are bound. ;; +(unless (fboundp 'ede-target-list-p) + (cl-deftype ede-target-list () '(list-of ede-target))) + (defclass ede-project (ede-project-placeholder) ((subproj :initform nil :type list @@ -287,16 +290,18 @@ All specific project types must derive from this project." ;; (defmacro ede-with-projectfile (obj &rest forms) "For the project in which OBJ resides, execute FORMS." - `(save-window-excursion - (let* ((pf (if (obj-of-class-p ,obj ede-target) - (ede-target-parent ,obj) - ,obj)) - (dbka (get-file-buffer (oref pf file)))) - (if (not dbka) (find-file (oref pf file)) - (switch-to-buffer dbka)) + (declare (indent 1)) + (unless (symbolp obj) + (message "Beware! ede-with-projectfile's first arg is copied: %S" obj)) + `(let* ((pf (if (obj-of-class-p ,obj 'ede-target) + (ede-target-parent ,obj) + ,obj)) + (dbka (get-file-buffer (oref pf file)))) + (with-current-buffer + (if (not dbka) (find-file-noselect (oref pf file)) + dbka) ,@forms (if (not dbka) (kill-buffer (current-buffer)))))) -(put 'ede-with-projectfile 'lisp-indent-function 1) ;;; The EDE persistent cache. ;; 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 @@ ;;; ede/custom.el --- customization of EDE projects. -;; Copyright (C) 2010-2014 Free Software Foundation, Inc. +;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -61,7 +61,7 @@ "Edit fields of the current target through EIEIO & Custom." (interactive) (require 'eieio-custom) - (if (not (obj-of-class-p ede-object ede-target)) + (if (not (obj-of-class-p ede-object 'ede-target)) (error "Current file is not part of a target")) (ede-customize-target ede-object)) @@ -72,7 +72,7 @@ "Edit fields of the current target through EIEIO & Custom. OBJ is the target object to customize." (require 'eieio-custom) - (if (and obj (not (obj-of-class-p obj ede-target))) + (if (and obj (not (obj-of-class-p obj 'ede-target))) (error "No logical target to customize")) (ede-customize obj)) 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 @@ ;;; ede/proj.el --- EDE Generic Project file driver -;; Copyright (C) 1998-2003, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 1998-2003, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that the PROJECT being read in is the root project." (save-excursion (let ((ret (eieio-persistent-read (concat project "Project.ede") - ede-proj-project)) + 'ede-proj-project)) (subdirs (directory-files project nil "[^.].*" nil))) (if (not (object-of-class-p ret 'ede-proj-project)) (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 @@ ;;; project-am.el --- A project management scheme based on automake files. -;; Copyright (C) 1998-2000, 2003, 2005, 2007-2014 +;; Copyright (C) 1998-2000, 2003, 2005, 2007-2015 ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -853,13 +853,13 @@ Argument FILE is the file to extract the end directory name from." (defun project-am-preferred-target-type (file) "For FILE, return the preferred type for that file." (cond ((string-match "\\.texi?\\(nfo\\)$" file) - project-am-texinfo) + 'project-am-texinfo) ((string-match "\\.[0-9]$" file) - project-am-man) + 'project-am-man) ((string-match "\\.el$" file) - project-am-lisp) + 'project-am-lisp) (t - project-am-program))) + 'project-am-program))) (defmethod ede-buffer-header-file((this project-am-objectcode) buffer) "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 @@ ;;; ede/speedbar.el --- Speedbar viewing of EDE projects -;; Copyright (C) 1998-2001, 2003, 2005, 2007-2014 Free Software +;; Copyright (C) 1998-2001, 2003, 2005, 2007-2015 Free Software ;; Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects." (let ((obj (eieio-speedbar-find-nearest-object))) (if (not (eieio-object-p obj)) nil - (cond ((obj-of-class-p obj ede-project) + (cond ((obj-of-class-p obj 'ede-project) (project-compile-project obj)) - ((obj-of-class-p obj ede-target) + ((obj-of-class-p obj 'ede-target) (project-compile-target obj)) (t (error "Error in speedbar structure")))))) @@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects." (let ((obj (eieio-speedbar-find-nearest-object))) (if (not (eieio-object-p obj)) (error "Error in speedbar or ede structure") - (if (obj-of-class-p obj ede-target) + (if (obj-of-class-p obj 'ede-target) (setq obj (ede-target-parent obj))) - (if (obj-of-class-p obj ede-project) + (if (obj-of-class-p obj 'ede-project) obj (error "Error in speedbar or ede structure"))))) 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 @@ ;;; semantic.el --- Semantic buffer evaluator. -;; Copyright (C) 1999-2014 Free Software Foundation, Inc. +;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax tools @@ -573,6 +573,7 @@ string." ;; The best way to call the parser from programs is via ;; `semantic-fetch-tags'. This, in turn, uses other internal ;; API functions which plug-in parsers can take advantage of. +(defvar semantic-parser-warnings) (defun semantic-fetch-tags () "Fetch semantic tags from the current buffer. @@ -602,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache." (garbage-collect) (cond -;;;; Try the incremental parser to do a fast update. - ((semantic-parse-tree-needs-update-p) - (setq res (semantic-parse-changes)) - (if (semantic-parse-tree-needs-rebuild-p) - ;; If the partial reparse fails, jump to a full reparse. - (semantic-fetch-tags) - ;; Clear the cache of unmatched syntax tokens - ;; - ;; NOTE TO SELF: - ;; - ;; Move this into the incremental parser. This is a bug. - ;; - (semantic-clear-unmatched-syntax-cache) - (run-hook-with-args ;; Let hooks know the updated tags - 'semantic-after-partial-cache-change-hook res)) - (setq semantic--completion-cache nil)) - -;;;; Parse the whole system. - ((semantic-parse-tree-needs-rebuild-p) - ;; Use Emacs's built-in progress-reporter (only interactive). - (if noninteractive - (setq res (semantic-parse-region (point-min) (point-max))) - (let ((semantic--progress-reporter - (and (>= (point-max) semantic-minimum-working-buffer-size) - (eq semantic-working-type 'percent) - (make-progress-reporter - (semantic-parser-working-message (buffer-name)) - 0 100)))) - (setq res (semantic-parse-region (point-min) (point-max))) - (if semantic--progress-reporter - (progress-reporter-done semantic--progress-reporter)))) - - ;; Clear the caches when we see there were no errors. - ;; But preserve the unmatched syntax cache and warnings! - (let (semantic-unmatched-syntax-cache - semantic-unmatched-syntax-cache-check - semantic-parser-warnings) - (semantic-clear-toplevel-cache)) - ;; Set up the new overlays - (semantic--tag-link-list-to-buffer res) - ;; Set up the cache with the new results - (semantic--set-buffer-cache res) - )))) + ;; Try the incremental parser to do a fast update. + ((semantic-parse-tree-needs-update-p) + (setq res (semantic-parse-changes)) + (if (semantic-parse-tree-needs-rebuild-p) + ;; If the partial reparse fails, jump to a full reparse. + (semantic-fetch-tags) + ;; Clear the cache of unmatched syntax tokens + ;; + ;; NOTE TO SELF: + ;; + ;; Move this into the incremental parser. This is a bug. + ;; + (semantic-clear-unmatched-syntax-cache) + (run-hook-with-args ;; Let hooks know the updated tags + 'semantic-after-partial-cache-change-hook res)) + (setq semantic--completion-cache nil)) + + ;; Parse the whole system. + ((semantic-parse-tree-needs-rebuild-p) + ;; Use Emacs's built-in progress-reporter (only interactive). + (if noninteractive + (setq res (semantic-parse-region (point-min) (point-max))) + (let ((semantic--progress-reporter + (and (>= (point-max) semantic-minimum-working-buffer-size) + (eq semantic-working-type 'percent) + (make-progress-reporter + (semantic-parser-working-message (buffer-name)) + 0 100)))) + (setq res (semantic-parse-region (point-min) (point-max))) + (if semantic--progress-reporter + (progress-reporter-done semantic--progress-reporter)))) + + ;; Clear the caches when we see there were no errors. + ;; But preserve the unmatched syntax cache and warnings! + (let (semantic-unmatched-syntax-cache + semantic-unmatched-syntax-cache-check + semantic-parser-warnings) + (semantic-clear-toplevel-cache)) + ;; Set up the new overlays + (semantic--tag-link-list-to-buffer res) + ;; Set up the cache with the new results + (semantic--set-buffer-cache res) + )))) ;; Always return the current parse tree. 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 @@ ;;; semantic/analyze.el --- Analyze semantic tags against local context -;; Copyright (C) 2000-2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> 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 @@ ;;; semantic/bovine/make.el --- Makefile parsing rules. -;; Copyright (C) 2000-2004, 2008-2014 Free Software Foundation, Inc. +;; Copyright (C) 2000-2004, 2008-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -178,9 +178,8 @@ This is the same as a regular prototype." makefile-mode (context) "Return a list of possible completions in a Makefile. Uses default implementation, and also gets a list of filenames." - (save-excursion - (require 'semantic/analyze/complete) - (set-buffer (oref context buffer)) + (require 'semantic/analyze/complete) + (with-current-buffer (oref context buffer) (let* ((normal (semantic-analyze-possible-completions-default context)) (classes (oref context :prefixclass)) (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 @@ ;;; semantic/complete.el --- Routines for performing tag completion -;; Copyright (C) 2003-2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2003-2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax @@ -188,6 +188,8 @@ Value should be a ... what?") "Default history variable for any unhistoried prompt. Keeps STRINGS only in the history.") +(defvar semantic-complete-active-default) +(defvar semantic-complete-current-matched-tag) (defun semantic-complete-read-tag-engine (collector displayor prompt default-tag initial-input @@ -1871,7 +1873,7 @@ completion text in ghost text." (list 'const :tag doc1 C))) - (eieio-build-class-alist semantic-displayor-abstract t)) + (eieio-build-class-alist 'semantic-displayor-abstract t)) ) "Possible options for inline completion displayors. 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 @@ ;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. -;; Copyright (C) 2005-2014 Free Software Foundation, Inc. +;; Copyright (C) 2005-2015 Free Software Foundation, Inc. ;; Authors: Eric M. Ludlam <zappo@gnu.org> ;; Joakim Verona @@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'." If DIRECTORY is found to be defunct, it won't load the DB, and will warn instead." (if (file-directory-p directory) - (semanticdb-create-database semanticdb-project-database-ebrowse + (semanticdb-create-database 'semanticdb-project-database-ebrowse directory) (let* ((BF (semanticdb-ebrowse-file-for-directory directory)) (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 @@ ;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp -;;; Copyright (C) 2002-2014 Free Software Foundation, Inc. +;;; Copyright (C) 2002-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -225,7 +225,7 @@ TOKTYPE is a hint to the type of tag desired." (semantic-elisp-desymbolify ;; FIXME: This only gives the instance slots and ignores the ;; class-allocated slots. - (eieio--class-public-a (find-class semanticdb-project-database))) ;; slots ;FIXME: eieio-- + (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio-- (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents )) ((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 @@ ;;; semantic/db-file.el --- Save a semanticdb to a cache file. -;;; Copyright (C) 2000-2005, 2007-2014 Free Software Foundation, Inc. +;;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one." (defun semanticdb-load-database (filename) "Load the database FILENAME." (condition-case foo - (let* ((r (eieio-persistent-read filename semanticdb-project-database-file)) + (let* ((r (eieio-persistent-read filename + 'semanticdb-project-database-file)) (c (semanticdb-get-database-tables r)) (tv (oref r semantic-tag-version)) (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 @@ ;;; semantic/db-find.el --- Searching through semantic databases. -;; Copyright (C) 2000-2014 Free Software Foundation, Inc. +;; Copyright (C) 2000-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -1114,7 +1114,7 @@ for backward compatibility. If optional argument BRUTISH is non-nil, then ignore include statements, and search all tables in this project tree." (let (found match) - (save-excursion + (save-current-buffer ;; If path is a buffer, set ourselves up in that buffer ;; so that the override methods work correctly. (when (bufferp path) (set-buffer path)) @@ -1127,7 +1127,7 @@ and search all tables in this project tree." ;; databases and not associated with a file. (unless (and find-file-match (obj-of-class-p - (car tableandtags) semanticdb-search-results-table)) + (car tableandtags) 'semanticdb-search-results-table)) (when (setq match (funcall function (car tableandtags) (cdr tableandtags))) (when find-file-match @@ -1144,7 +1144,7 @@ and search all tables in this project tree." ;; `semanticdb-search-results-table', since those are system ;; databases and not associated with a file. (unless (and find-file-match - (obj-of-class-p table semanticdb-search-results-table)) + (obj-of-class-p table 'semanticdb-search-results-table)) (when (and table (setq match (funcall function table nil))) (semanticdb-find-log-activity table match) (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 @@ ;;; semantic/db-typecache.el --- Manage Datatypes -;; Copyright (C) 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> @@ -180,7 +180,7 @@ If there is no table, create one, and fill it in." (defmethod semanticdb-get-typecache ((db semanticdb-project-database)) "Retrieve the typecache from the semantic database DB. If there is no table, create one, and fill it in." - (semanticdb-cache-get db semanticdb-database-typecache) + (semanticdb-cache-get db 'semanticdb-database-typecache) ) 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 @@ ;;; semantic/db.el --- Semantic tag database manager -;; Copyright (C) 2000-2014 Free Software Foundation, Inc. +;; Copyright (C) 2000-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: tags @@ -330,6 +330,10 @@ Adds the number of tags in this file to the object print name." ;;; DATABASE BASE CLASS ;; +(unless (fboundp 'semanticdb-abstract-table-list-p) + (cl-deftype semanticdb-abstract-table-list () + '(list-of semanticdb-abstract-table))) + (defclass semanticdb-project-database (eieio-instance-tracker) ((tracking-symbol :initform semanticdb-database-list) (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 @@ ;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -;; Copyright (C) 2003-2004, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff." ;; "Target class for Emacs/Semantic grammar files." nil nil) (ede-proj-register-target "semantic grammar" - semantic-ede-proj-target-grammar) + 'semantic-ede-proj-target-grammar) (provide 'semantic/ede-grammar) 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 @@ ;;; semantic/fw.el --- Framework for Semantic -;;; Copyright (C) 1999-2014 Free Software Foundation, Inc. +;;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -378,11 +378,11 @@ If FORMS includes a call to `semantic-throw-on-input', then if a user presses any key during execution, this form macro will exit with the value passed to `semantic-throw-on-input'. If FORMS completes, then the return value is the same as `progn'." + (declare (indent 1)) `(let ((semantic-current-input-throw-symbol ,symbol) (semantic--on-input-start-marker (point-marker))) (catch ,symbol ,@forms))) -(put 'semantic-exit-on-input 'lisp-indent-function 1) (defmacro semantic-throw-on-input (from) "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 calling this one." `(when (and semantic-current-input-throw-symbol (or (input-pending-p) - (save-excursion - ;; Timers might run during accept-process-output. - ;; If they redisplay, point must be where the user - ;; expects. (Bug#15045) - (set-buffer (marker-buffer - semantic--on-input-start-marker)) - (goto-char (marker-position - semantic--on-input-start-marker)) - (accept-process-output)))) + (with-current-buffer + ;; Timers might run during accept-process-output. + ;; If they redisplay, point must be where the user + ;; expects. (Bug#15045) + (marker-buffer semantic--on-input-start-marker) + (save-excursion + (goto-char semantic--on-input-start-marker) + (accept-process-output))))) (throw semantic-current-input-throw-symbol ,from))) 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 @@ ;;; semantic/grammar.el --- Major mode framework for Semantic grammars -;; Copyright (C) 2002-2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2002-2005, 2007-2015 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -1665,13 +1665,14 @@ Select the buffer containing the tag's definition, and move point there." (declare-function eldoc-get-fnsym-args-string "eldoc") (declare-function eldoc-get-var-docstring "eldoc") +(defvar semantic-grammar-eldoc-last-data (cons nil nil)) + (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) "Return a one-line docstring for the given grammar MACRO. EXPANDER is the name of the function that expands MACRO." (require 'eldoc) - (if (and (eq expander (aref eldoc-last-data 0)) - (eq 'function (aref eldoc-last-data 2))) - (aref eldoc-last-data 1) + (if (eq expander (car semantic-grammar-eldoc-last-data)) + (cdr semantic-grammar-eldoc-last-data) (let ((doc (help-split-fundoc (documentation expander t) expander))) (cond (doc @@ -1684,7 +1685,7 @@ EXPANDER is the name of the function that expands MACRO." (setq doc (eldoc-docstring-format-sym-doc macro (format "==> %s %s" expander doc) 'default)) - (eldoc-last-data-store expander doc 'function)) + (setq semantic-grammar-eldoc-last-data (cons expander doc))) doc))) (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 @@ ;;; semantic/ia.el --- Interactive Analysis functions -;;; Copyright (C) 2000-2014 Free Software Foundation, Inc. +;;; Copyright (C) 2000-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; 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 @@ ;;; idle.el --- Schedule parsing tasks in idle time -;; Copyright (C) 2003-2006, 2008-2014 Free Software Foundation, Inc. +;; Copyright (C) 2003-2006, 2008-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; 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 @@ ;;; semantic/scope.el --- Analyzer Scope Calculations -;; Copyright (C) 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> @@ -134,7 +134,7 @@ Saves scoping information between runs of the analyzer.") "Get the current cached scope, and reset it." (when semanticdb-current-table (let ((co (semanticdb-cache-get semanticdb-current-table - semantic-scope-cache))) + 'semantic-scope-cache))) (semantic-reset co)))) (defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) @@ -706,7 +706,7 @@ The class returned from the scope calculation is variable (let* ((TAG (semantic-current-tag)) (scopecache (semanticdb-cache-get semanticdb-current-table - semantic-scope-cache)) + 'semantic-scope-cache)) ) (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag))) (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 @@ ;;; srecode/compile --- Compilation of srecode template files. -;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: codegeneration @@ -87,10 +87,10 @@ for push, pop, and peek for the active template.") Useful if something goes wrong in SRecode, and the active template stack is broken." (interactive) - (if (oref srecode-template active) + (if (oref-default 'srecode-template active) (when (y-or-n-p (format "%d active templates. Flush? " - (length (oref srecode-template active)))) - (oset-default srecode-template active nil)) + (length (oref-default 'srecode-template active)))) + (oset-default 'srecode-template active nil)) (message "No active templates to flush.")) ) @@ -514,7 +514,7 @@ to the inserter constructor." ;;(message "Compile: %s %S" name props) (if (not key) (apply 'srecode-template-inserter-variable name props) - (let ((classes (eieio-class-children srecode-template-inserter)) + (let ((classes (eieio-class-children 'srecode-template-inserter)) (new nil)) ;; Loop over the various subclasses and ;; 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 @@ ;;; srecode/fields.el --- Handling type-in fields in a buffer. ;; -;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; Copyright (C) 2009-2015 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam <eric@siege-engine.com> @@ -237,7 +237,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO." (defsubst srecode-active-template-region () "Return the active region for template fields." - (oref srecode-template-inserted-region active-region)) + (oref-default 'srecode-template-inserted-region active-region)) (defun srecode-field-post-command () "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 @@ ;;; srecode/insert.el --- Insert srecode templates to an output stream. -;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -211,7 +211,7 @@ insertions." (propertize " (most recent at bottom)" 'face '(:slant italic)) ":\n") (data-debug-insert-stuff-list - (reverse (oref srecode-template active)) "> ") + (reverse (oref-default 'srecode-template active)) "> ") ;; Show the current dictionary. (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") (data-debug-insert-thing dictionary "" "> ") @@ -396,7 +396,7 @@ Specify the :blank argument to enable this inserter.") (pm (point-marker))) (when (and inbuff ;; Don't do this if we are not the active template. - (= (length (oref srecode-template active)) 1)) + (= (length (oref-default 'srecode-template active)) 1)) (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) (indent-according-to-mode) @@ -773,7 +773,7 @@ generalized marker will do something else. See ;; valid. Compare this to the actual template nesting depth and ;; maybe use the override function which is stored in the cdr. (if (and srecode-template-inserter-point-override - (<= (length (oref srecode-template active)) + (<= (length (oref-default 'srecode-template active)) (car srecode-template-inserter-point-override))) ;; Disable the old override while we do this. (let ((over (cdr srecode-template-inserter-point-override)) @@ -943,7 +943,7 @@ this template instance." ;; Calculate and store the discovered template (let ((tmpl (srecode-template-get-table (srecode-table) templatenamepart)) - (active (oref srecode-template active)) + (active (oref-default 'srecode-template active)) ctxt) (when (not tmpl) ;; If it isn't just available, scan back through @@ -1053,7 +1053,7 @@ template where a ^ inserter occurs." (lexical-let ((inserter1 sti)) (cons ;; DEPTH - (+ (length (oref srecode-template active)) 1) + (+ (length (oref-default 'srecode-template active)) 1) ;; FUNCTION (lambda (dict) (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 @@ ;;; srecode/map.el --- Manage a template file map -;; Copyright (C) 2008-2014 Free Software Foundation, Inc. +;; Copyright (C) 2008-2015 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> @@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed." (when (not srecode-current-map) (condition-case nil (setq srecode-current-map - (eieio-persistent-read srecode-map-save-file srecode-map)) + (eieio-persistent-read srecode-map-save-file 'srecode-map)) (error ;; There was an error loading the old map. Create a new one. (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." (if (stringp (car (oref seq data))) (let ((labels (oref seq data))) (if (not axis) - (setq axis (make-instance chart-axis-names + (setq axis (make-instance 'chart-axis-names :name (oref seq name) :items labels :chart c)) @@ -430,7 +430,7 @@ or is created with the bounds of SEQ." (let ((range (cons 0 1)) (l (oref seq data))) (if (not axis) - (setq axis (make-instance chart-axis-range + (setq axis (make-instance 'chart-axis-range :name (oref seq name) :chart c))) (while l @@ -577,19 +577,19 @@ labeled NUMTITLE. Optional arguments: Set the chart's max element display to MAX, and sort lists with SORT-PRED if desired." - (let ((nc (make-instance chart-bar + (let ((nc (make-instance 'chart-bar :title title :key-label "8-m" ; This is a text key pic :direction dir )) (iv (eq dir 'vertical))) (chart-add-sequence nc - (make-instance chart-sequece + (make-instance 'chart-sequece :data namelst :name nametitle) (if iv 'x-axis 'y-axis)) (chart-add-sequence nc - (make-instance chart-sequece + (make-instance 'chart-sequece :data numlst :name numtitle) (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." (unless (and ;; Do we have a type? (consp classtype) (class-p (car classtype))) - (error "In save file, list of object constructors found, but no :type specified for slot %S" - slot)) + (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S" + slot classtype)) ;; We have a predicate, but it doesn't satisfy the predicate? (dolist (PV (cdr proposed-value)) @@ -367,10 +367,24 @@ If no class is referenced there, then return nil." (cond ((class-p type) ;; If the type is a class, then return it. type) + ((and (eq 'list-of (car-safe type)) (class-p (cadr type))) + ;; If it is the type of a list of a class, then return that class and + ;; the type. + (cons (cadr type) type)) + + ((and (symbolp type) (get type 'cl-deftype-handler)) + ;; Macro-expand the type according to cl-deftype definitions. + (eieio-persistent-slot-type-is-class-p + (funcall (get type 'cl-deftype-handler)))) + ;; FIXME: foo-child should not be a valid type! ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) (class-p (intern-soft (substring (symbol-name type) 0 (match-beginning 0))))) + (unless eieio-backward-compatibility + (error "Use of bogus %S type instead of %S" + type (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) ;; If it is the predicate ending with -child, then return ;; that class. Unfortunately, in EIEIO, typep of just the ;; 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." ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) (class-p (intern-soft (substring (symbol-name type) 0 (match-beginning 0))))) + (unless eieio-backward-compatibility + (error "Use of bogus %S type instead of (list-of %S)" + type (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) ;; If it is the predicate ending with -list, then return ;; that class and the predicate to use. (cons (intern-soft (substring (symbol-name type) 0 (match-beginning 0))) type)) - ((and (consp type) (eq (car type) 'or)) + ((eq (car-safe type) 'or) ;; If type is a list, and is an or, it is possibly something ;; like (or null myclass), so check for that. (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.") (defvar eieio-initializing-object nil "Set to non-nil while initializing an object.") +(defvar eieio-backward-compatibility t + "If nil, drop support for some behaviors of older versions of EIEIO. +Currently under control of this var: +- Define every class as a var whose value is the class symbol. +- Define <class>-child-p and <class>-list-p predicates. +- Allow object names in constructors.") + (defconst eieio-unbound (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) eieio-unbound @@ -217,7 +224,10 @@ Stored outright without modifications or stripping."))) (defsubst eieio--class-object (class) "Return the class object." - (if (symbolp class) (eieio--class-v class) class)) + (if (symbolp class) + ;; Keep the symbol if class-v is nil, for better error messages. + (or (eieio--class-v class) class) + class)) (defsubst eieio--class-p (class) "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? (format "#<class %s>" (symbol-name class))) (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") -(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." - ;; FIXME: Remove. And change `children' to contain class objects rather than - ;; class names. - `(eieio--class-children (eieio--class-v ,class))) - -(defsubst same-class-fast-p (obj class-name) - "Return t if OBJ is of class-type CLASS-NAME with no error checking." - ;; (eq (eieio--object-class-name obj) class) - (eq (eieio--object-class-object obj) (eieio--class-object class-name))) - (defmacro class-constructor (class) "Return the symbol representing the constructor of CLASS." (declare (debug t)) @@ -388,7 +388,8 @@ It creates an autoload function for CNAME's constructor." (push (eieio--class-v SC) (eieio--class-parent newc))) ;; turn this into a usable self-pointing symbol - (set cname cname) + (when eieio-backward-compatibility + (set cname cname)) ;; Store the new class vector definition into the symbol. We need to ;; do this first so that we can call defmethod for the accessor. @@ -499,7 +500,8 @@ See `defclass' for more information." (setf (eieio--class-parent newc) (list eieio-default-superclass)))) ;; turn this into a usable self-pointing symbol; FIXME: Why? - (set cname cname) + (when eieio-backward-compatibility + (set cname cname)) ;; These two tests must be created right away so we can have self- ;; referencing classes. ei, a class whose slot can contain only @@ -520,7 +522,9 @@ See `defclass' for more information." )) ;; Create a handy child test too - (let ((csym (intern (concat (symbol-name cname) "-child-p")))) + (let ((csym (if eieio-backward-compatibility + (intern (concat (symbol-name cname) "-child-p")) + (make-symbol (concat (symbol-name cname) "-child-p"))))) (fset csym `(lambda (obj) ,(format @@ -540,21 +544,22 @@ See `defclass' for more information." (put cname 'cl-deftype-satisfies csym)) ;; Create a handy list of the class test too - (let ((csym (intern (concat (symbol-name cname) "-list-p")))) - (fset csym - `(lambda (obj) - ,(format - "Test OBJ to see if it a list of objects which are a child of type %s" - cname) - (when (listp obj) - (let ((ans t)) ;; nil is valid - ;; Loop over all the elements of the input list, test - ;; each to make sure it is a child of the desired object class. - (while (and obj ans) - (setq ans (and (eieio-object-p (car obj)) - (object-of-class-p (car obj) ,cname))) - (setq obj (cdr obj))) - ans))))) + (when eieio-backward-compatibility + (let ((csym (intern (concat (symbol-name cname) "-list-p")))) + (fset csym + `(lambda (obj) + ,(format + "Test OBJ to see if it a list of objects which are a child of type %s" + cname) + (when (listp obj) + (let ((ans t)) ;; nil is valid + ;; Loop over all the elements of the input list, test + ;; each to make sure it is a child of the desired object class. + (while (and obj ans) + (setq ans (and (eieio-object-p (car obj)) + (object-of-class-p (car obj) ,cname))) + (setq obj (cdr obj))) + ans)))))) ;; Before adding new slots, let's add all the methods and classes ;; in from the parent class. @@ -767,7 +772,8 @@ See `defclass' for more information." (if (and slots (let ((x (car slots))) (or (stringp x) (null x)))) - (message "Obsolete name %S passed to %S constructor" + (funcall (if eieio-backward-compatibility #'ignore #'message) + "Obsolete name %S passed to %S constructor" (pop slots) ',cname)) (apply #'eieio-constructor ',cname slots))) ) @@ -833,7 +839,7 @@ If SKIPNIL is non-nil, then if VALUE is nil return t instead." (if (not (or (eieio-eval-default-p value) ;FIXME: Why? eieio-skip-typecheck (and skipnil (null value)) - (eieio-perform-slot-validation spec value))) + (eieio--perform-slot-validation spec value))) (signal 'invalid-slot-type (list slot spec value)))) (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." (lambda (&rest local-args) (eieio-generic-call method local-args))) -(defsubst eieio-defgeneric-reset-generic-form (method) - "Setup METHOD to call the generic form." - (let ((doc-string (documentation method 'raw))) - (put method 'function-documentation doc-string) - (fset method (eieio-defgeneric-form method)))) - -(defun eieio-defgeneric-form-primary-only (method) +(defun eieio--defgeneric-form-primary-only (method) "The lambda form that would be used as the function defined on METHOD. All methods should call the same EIEIO function for dispatch. DOC-STRING is the documentation attached to METHOD." (lambda (&rest local-args) - (eieio-generic-call-primary-only method local-args))) - -(defsubst eieio-defgeneric-reset-generic-form-primary-only (method) - "Setup METHOD to call the generic form." - (let ((doc-string (documentation method 'raw))) - (put method 'function-documentation doc-string) - (fset method (eieio-defgeneric-form-primary-only method)))) + (eieio--generic-call-primary-only method local-args))) (declare-function no-applicable-method "eieio" (object method &rest args)) @@ -1186,7 +1180,7 @@ Keys are a number representing :before, :primary, and :after methods.") During executions, the list is first generated, then as each next method is called, the next method is popped off the stack.") -(defun eieio-defgeneric-form-primary-only-one (method class impl) +(defun eieio--defgeneric-form-primary-only-one (method class impl) "The lambda form that would be used as the function defined on METHOD. All methods should call the same EIEIO function for dispatch. CLASS is the class symbol needed for private method access. @@ -1219,16 +1213,6 @@ IMPL is the symbol holding the method implementation." (eieio--with-scoped-class (eieio--class-v class) (apply impl local-args))))))) -(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) - "Setup METHOD to call the generic form." - (let* ((doc-string (documentation method 'raw)) - (M (get method 'eieio-method-tree)) - (entry (car (aref M eieio--method-primary))) - ) - (put method 'function-documentation doc-string) - (fset method (eieio-defgeneric-form-primary-only-one - method (car entry) (cdr entry))))) - (defun eieio-unbind-method-implementations (method) "Make the generic method METHOD have no implementations. It will leave the original generic function in place, @@ -1236,6 +1220,27 @@ but remove reference to all implementations of METHOD." (put method 'eieio-method-tree nil) (put method 'eieio-method-hashtable nil)) +(defun eieio--method-optimize-primary (method) + (when eieio-optimize-primary-methods-flag + ;; Optimizing step: + ;; + ;; If this method, after this setup, only has primary methods, then + ;; we can setup the generic that way. + (let ((doc-string (documentation method 'raw))) + (put method 'function-documentation doc-string) + ;; Use `defalias' so as to interact properly with nadvice.el. + (defalias method + (if (generic-primary-only-p method) + ;; If there is only one primary method, then we can go one more + ;; optimization step. + (if (generic-primary-only-one-p method) + (let* ((M (get method 'eieio-method-tree)) + (entry (car (aref M eieio--method-primary)))) + (eieio--defgeneric-form-primary-only-one + method (car entry) (cdr entry))) + (eieio--defgeneric-form-primary-only method)) + (eieio-defgeneric-form method)))))) + (defun eieio--defmethod (method kind argclass code) "Work part of the `defmethod' macro defining METHOD with ARGS." (let ((key @@ -1272,18 +1277,7 @@ but remove reference to all implementations of METHOD." (eieiomt-add method code key argclass) ) - (when eieio-optimize-primary-methods-flag - ;; Optimizing step: - ;; - ;; If this method, after this setup, only has primary methods, then - ;; we can setup the generic that way. - (if (generic-primary-only-p method) - ;; If there is only one primary method, then we can go one more - ;; optimization step. - (if (generic-primary-only-one-p method) - (eieio-defgeneric-reset-generic-form-primary-only-one method) - (eieio-defgeneric-reset-generic-form-primary-only method)) - (eieio-defgeneric-reset-generic-form method))) + (eieio--method-optimize-primary method) method) @@ -1293,13 +1287,13 @@ but remove reference to all implementations of METHOD." ;; requiring the CL library at run-time. It can be eliminated if/when ;; `typep' is merged into Emacs core. -(defun eieio-perform-slot-validation (spec value) +(defun eieio--perform-slot-validation (spec value) "Return non-nil if SPEC does not match VALUE." (or (eq spec t) ; t always passes (eq value eieio-unbound) ; unbound always passes (cl-typep value spec))) -(defun eieio-validate-slot-value (class slot-idx value slot) +(defun eieio--validate-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. Checks the :type specifier. SLOT is the slot that is being checked, and is only used when throwing @@ -1308,21 +1302,23 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) - (let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx))) - (if (not (eieio-perform-slot-validation st value)) - (signal 'invalid-slot-type (list class slot st value)))))) + (let ((st (aref (eieio--class-public-type class) slot-idx))) + (if (not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-symbol class) slot st value)))))) -(defun eieio-validate-class-slot-value (class slot-idx value slot) +(defun eieio--validate-class-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. Checks the :type specifier. SLOT is the slot that is being checked, and is only used when throwing an error." (if eieio-skip-typecheck nil - (let ((st (aref (eieio--class-class-allocation-type (eieio--class-v class)) + (let ((st (aref (eieio--class-class-allocation-type class) slot-idx))) - (if (not (eieio-perform-slot-validation st value)) - (signal 'invalid-slot-type (list class slot st value)))))) + (if (not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-symbol class) slot st value)))))) (defun eieio-barf-if-slot-unbound (value instance slotname fn) "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." (defun eieio-default-eval-maybe (val) "Check VAL, and return what `oref-default' would provide." + ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate + ;; variables as well? Why not just always call `eval'? (cond ;; Is it a function call? If so, evaluate it. ((eieio-eval-default-p val) @@ -1413,41 +1411,41 @@ Fills in OBJ's SLOT with VALUE." (eieio--class-slot-name-index class slot)) ;; Oset that slot. (progn - (eieio-validate-class-slot-value (eieio--class-symbol class) - c value slot) + (eieio--validate-class-slot-value class c value slot) (aset (eieio--class-class-allocation-values class) c value)) ;; See oref for comment on `slot-missing' (slot-missing obj slot 'oset value) ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) ) - (eieio-validate-slot-value (eieio--class-symbol class) c value slot) + (eieio--validate-slot-value class c value slot) (aset obj c value)))) (defun eieio-oset-default (class slot value) "Do the work for the macro `oset-default'. Fills in the default value in CLASS' in SLOT with VALUE." - (eieio--check-type class-p class) + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) (eieio--check-type symbolp slot) - (eieio--with-scoped-class (eieio--class-v class) - (let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot))) + (eieio--with-scoped-class class + (let* ((c (eieio--slot-name-index class nil slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c (eieio--class-slot-name-index (eieio--class-v class) slot)) + (if (setq c (eieio--class-slot-name-index class slot)) (progn ;; Oref that slot. - (eieio-validate-class-slot-value class c value slot) - (aset (eieio--class-class-allocation-values (eieio--class-v class)) c + (eieio--validate-class-slot-value class c value slot) + (aset (eieio--class-class-allocation-values class) c value)) - (signal 'invalid-slot-name (list (eieio-class-name class) slot))) - (eieio-validate-slot-value class c value slot) + (signal 'invalid-slot-name (list (eieio--class-symbol class) slot))) + (eieio--validate-slot-value class c value slot) ;; Set this into the storage for defaults. (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) - (eieio--class-public-d (eieio--class-v class))) + (eieio--class-public-d class)) value) ;; Take the value, and put it into our cache object. - (eieio-oset (eieio--class-default-object-cache (eieio--class-v class)) + (eieio-oset (eieio--class-default-object-cache class) slot value) )))) @@ -1808,7 +1806,7 @@ This should only be called from a generic function." (list method args)))) rval))) -(defun eieio-generic-call-primary-only (method args) +(defun eieio--generic-call-primary-only (method args) "Call METHOD with ARGS for methods with only :PRIMARY implementations. ARGS provides the context on which implementation to use. This should only be called from a generic function. @@ -2124,18 +2122,7 @@ is memorized for faster future use." key argclass)) ) - (when eieio-optimize-primary-methods-flag - ;; Optimizing step: - ;; - ;; If this method, after this setup, only has primary methods, then - ;; we can setup the generic that way. - (if (generic-primary-only-p method) - ;; If there is only one primary method, then we can go one more - ;; optimization step. - (if (generic-primary-only-one-p method) - (eieio-defgeneric-reset-generic-form-primary-only-one method) - (eieio-defgeneric-reset-generic-form-primary-only method)) - (eieio-defgeneric-reset-generic-form method))) + (eieio--method-optimize-primary method) method) (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." (cl-mapcan (lambda (c) (append (list c) (eieio-build-class-list c))) - (eieio-class-children-fast class)) + (eieio--class-children (eieio--class-v class))) (list class))) (defun eieio-build-class-alist (&optional class instantiable-only buildlist) @@ -423,16 +423,10 @@ function has no documentation, then return nil." (defvar eieio-read-generic nil "History of the `eieio-read-generic' prompt.") -(defun eieio-read-generic-p (fn) - "Function used in function `eieio-read-generic'. -This is because `generic-p' is a macro. -Argument FN is the function to test." - (generic-p fn)) - (defun eieio-read-generic (prompt &optional historyvar) "Read a generic function from the minibuffer with PROMPT. Optional argument HISTORYVAR is the variable to use as history." - (intern (completing-read prompt obarray 'eieio-read-generic-p + (intern (completing-read prompt obarray #'generic-p t nil (or historyvar 'eieio-read-generic)))) ;;; 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." "Return child classes to CLASS. The CLOS function `class-direct-subclasses' is aliased to this function." (eieio--check-type class-p class) - (eieio-class-children-fast class)) + (eieio--class-children (eieio--class-v class))) (define-obsolete-function-alias 'class-children #'eieio-class-children "24.4") @@ -343,10 +343,12 @@ The CLOS function `class-direct-subclasses' is aliased to this function." `(car (eieio-class-parents ,class))) (define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") -(defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." - (eieio--check-type class-p class) +(defun same-class-p (obj class) + "Return t if OBJ is of class-type CLASS." + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) (eieio--check-type eieio-object-p obj) - (same-class-fast-p obj class)) + (eq (eieio--object-class-object obj) class)) (defun object-of-class-p (obj class) "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." (next (car eieio-generic-call-next-method-list)) ) (if (not (and next (car next))) - (apply #'no-next-method (car newargs) (cdr newargs)) + (apply #'no-next-method newargs) (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) (eieio-generic-call-arglst newargs) @@ -723,7 +725,8 @@ first and modify the returned object.") "Make a copy of OBJ, and then apply PARAMS." (let ((nobj (copy-sequence obj))) (if (stringp (car params)) - (message "Obsolete name %S passed to clone" (pop params))) + (funcall (if eieio-backward-compatibility #'ignore #'message) + "Obsolete name %S passed to clone" (pop params))) (if params (shared-initialize nobj params)) nobj)) @@ -889,7 +892,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "a3f314e2a27e52444df4597c6ae51458") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "7d3c0bca065713ae74af0c07778dd1f4") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -900,7 +903,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;*** -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "2ff7d98da3f84c6af5c873ffb781930e") +;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6377e022e85d377b399f44c98b4eab4a") ;;; Generated autoloads from eieio-opt.el (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 @@ +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * registry.el: Don't use <class> as a variable. + 2014-12-18 Paul Eggert <eggert@cs.ucla.edu> * registry.el (registry-db): Set default slot later. @@ -26011,7 +26015,7 @@ See ChangeLog.2 for earlier changes. - Copyright (C) 2004-2014 Free Software Foundation, Inc. + Copyright (C) 2004-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. 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 @@ ;;; registry.el --- Track and remember data items by various fields -;; Copyright (C) 2011-2014 Free Software Foundation, Inc. +;; Copyright (C) 2011-2015 Free Software Foundation, Inc. ;; Author: Teodor Zlatanov <tzz@lifelogs.com> ;; Keywords: data @@ -124,7 +124,7 @@ :type hash-table :documentation "The data hashtable."))) ;; Do this separately, since defclass doesn't allow expressions in :initform. -(oset-default registry-db max-size most-positive-fixnum) +(oset-default 'registry-db max-size most-positive-fixnum) (defmethod initialize-instance :BEFORE ((this registry-db) slots) "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 @@ +2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * 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. + + * automated/eieio-test-persist.el (persistent-with-objs-list-slot): + Don't use <class>-list type. + + * automated/eieio-test-methodinvoke.el + (eieio-test-method-order-list-4): + Don't use <class> as a variable. + 2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> * automated/eieio-tests.el (eieio-test-04-static-method) @@ -2423,7 +2435,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2008-2014 Free Software Foundation, Inc. + Copyright (C) 2008-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. 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 @@ (ert-deftest eieio-test-method-order-list-4 () ;; Both of these situations should succeed. - (should (eitest-H eitest-A)) + (should (eitest-H 'eitest-A)) (should (eitest-H (eitest-A nil)))) ;;; 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.") ;; A slot that contains another object that isn't persistent (defclass persistent-with-objs-list-slot (eieio-persistent) ((pnp :initarg :pnp - :type persist-not-persistent-list + :type (list-of persist-not-persistent) :initform nil)) "Class for testing the saving of slots with objects in them.") 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 @@ (require 'eieio-base) (require 'eieio-opt) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Code: ;; Set up some test classes @@ -198,10 +198,10 @@ Argument C is the class bound to this static method." (ert-deftest eieio-test-04-static-method () ;; Call static method on a class and see if it worked - (static-method-class-method static-method-class 'class) - (should (eq (oref-default static-method-class some-slot) 'class)) + (static-method-class-method 'static-method-class 'class) + (should (eq (oref-default 'static-method-class some-slot) 'class)) (static-method-class-method (static-method-class) 'object) - (should (eq (oref-default static-method-class some-slot) 'object))) + (should (eq (oref-default 'static-method-class some-slot) 'object))) (ert-deftest eieio-test-05-static-method-2 () (defclass static-method-class-2 (static-method-class) @@ -214,10 +214,10 @@ Argument C is the class bound to this static method." (if (eieio-object-p c) (setq c (eieio-object-class c))) (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) - (static-method-class-method static-method-class-2 'class) - (should (eq (oref-default static-method-class-2 some-slot) 'moose-class)) + (static-method-class-method 'static-method-class-2 'class) + (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class)) (static-method-class-method (static-method-class-2) 'object) - (should (eq (oref-default static-method-class-2 some-slot) 'moose-object))) + (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object))) ;;; Perform method testing @@ -473,12 +473,12 @@ METHOD is the method that was attempting to be called." ;; Slot should be bound (should (slot-boundp eitest-a 'classslot)) - (should (slot-boundp class-a 'classslot)) + (should (slot-boundp 'class-a 'classslot)) (slot-makeunbound eitest-a 'classslot) (should-not (slot-boundp eitest-a 'classslot)) - (should-not (slot-boundp class-a 'classslot))) + (should-not (slot-boundp 'class-a 'classslot))) (defvar eieio-test-permuting-value nil) @@ -529,17 +529,17 @@ METHOD is the method that was attempting to be called." :type 'invalid-slot-type)) (ert-deftest eieio-test-23-inheritance-check () - (should (child-of-class-p class-ab class-a)) - (should (child-of-class-p class-ab class-b)) - (should (object-of-class-p eitest-a class-a)) - (should (object-of-class-p eitest-ab class-a)) - (should (object-of-class-p eitest-ab class-b)) - (should (object-of-class-p eitest-ab class-ab)) - (should (eq (eieio-class-parents class-a) nil)) + (should (child-of-class-p 'class-ab 'class-a)) + (should (child-of-class-p 'class-ab 'class-b)) + (should (object-of-class-p eitest-a 'class-a)) + (should (object-of-class-p eitest-ab 'class-a)) + (should (object-of-class-p eitest-ab 'class-b)) + (should (object-of-class-p eitest-ab 'class-ab)) + (should (eq (eieio-class-parents 'class-a) nil)) ;; FIXME: eieio-class-parents now returns class objects! - (should (equal (mapcar #'eieio-class-object (eieio-class-parents class-ab)) + (should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab)) (mapcar #'eieio-class-object '(class-a class-b)))) - (should (same-class-p eitest-a class-a)) + (should (same-class-p eitest-a 'class-a)) (should (class-a-p eitest-a)) (should (not (class-a-p eitest-ab))) (should (class-a-child-p eitest-a)) @@ -550,10 +550,10 @@ METHOD is the method that was attempting to be called." (ert-deftest eieio-test-24-object-predicates () (let ((listooa (list (class-ab) (class-a))) (listoob (list (class-ab) (class-b)))) - (should (class-a-list-p listooa)) - (should (class-b-list-p listoob)) - (should-not (class-b-list-p listooa)) - (should-not (class-a-list-p listoob)))) + (should (cl-typep listooa '(list-of class-a))) + (should (cl-typep listoob '(list-of class-b))) + (should-not (cl-typep listooa '(list-of class-b))) + (should-not (cl-typep listoob '(list-of class-a))))) (defvar eitest-t1 nil) (ert-deftest eieio-test-25-slot-tests () @@ -568,7 +568,7 @@ METHOD is the method that was attempting to be called." ;; Pass string instead of symbol (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type) (should (eq (get-slot-3 eitest-t1) 'emu)) - (should (eq (get-slot-3 class-c) 'emu)) + (should (eq (get-slot-3 'class-c) 'emu)) ;; Check setf (setf (get-slot-3 eitest-t1) 'setf-emu) (should (eq (get-slot-3 eitest-t1) 'setf-emu)) @@ -793,7 +793,7 @@ Subclasses to override slot attributes.") ((type :type string) ) "This class should throw an error."))) - (should (eq (oref-default slotattr-class-ok initform) 'no-init))) + (should (eq (oref-default 'slotattr-class-ok initform) 'no-init))) (ert-deftest eieio-test-32-slot-attribute-override-2 () (let* ((cv (eieio--class-v 'slotattr-ok)) @@ -883,8 +883,8 @@ Subclasses to override slot attributes.") "Instantiable child") (ert-deftest eieio-test-36-build-class-alist () - (should (= (length (eieio-build-class-alist opt-test1 nil)) 2)) - (should (= (length (eieio-build-class-alist opt-test1 t)) 1))) + (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2)) + (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1))) (provide 'eieio-tests) |