Commit bcebc831 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/emacs-lisp/eieio*.el: Use hashtables rather than obarrays

* lisp/emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to
symbol-hashtable.  It contains a hashtable instead of an obarray.
(generic-p): Use symbol property `eieio-method-hashtable' instead of
`eieio-method-obarray'.
(generic-primary-only-p, generic-primary-only-one-p):
Slight optimization.
(eieio-defclass-autoload-map): Use a hashtable instead of an obarray.
(eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly.
(eieio-class-un-autoload): Use autoload-do-load.
(eieio-defclass): Use dolist, cl-pushnew, cl-callf.
Use new cl-deftype-satisfies.  Adjust to use of hashtables.
Don't hardcode the value of eieio--object-num-slots.
(eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg.
Use a closure rather than a backquoted lambda.
(eieio--defmethod): Adjust call accordingly.  Set doc-string via the
function-documentation property.
(eieio-slot-originating-class-p, eieio-slot-name-index)
(eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add)
(eieio-generic-form): Adjust to use of hashtables.
(eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take
additional class argument.
(eieio-generic-call-methodname): Remove, unused.

* lisp/emacs-lisp/eieio-custom.el: Use lexical-binding.
(eieio-object-value-to-abstract): Simplify.

* lisp/emacs-lisp/eieio-datadebug.el: Use lexical-binding.

* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan.
(eieio-build-class-alist): Use dolist.
(eieio-all-generic-functions): Adjust to use of hashtables.

* lisp/emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
`eieio-default-superclass'.

* test/automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Remove use of eieio-generic-call-methodname.
(eieio-test-method-order-list-3, eieio-test-method-order-list-6)
(eieio-test-method-order-list-7, eieio-test-method-order-list-8):
Adjust the expected result accordingly.

* lisp/emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
Prefer \' to $.
parent b11d8924
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
`eieio-default-superclass'.
* emacs-lisp/eieio-datadebug.el: Use lexical-binding.
* emacs-lisp/eieio-custom.el: Use lexical-binding.
(eieio-object-value-to-abstract): Simplify.
* emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan.
(eieio-build-class-alist): Use dolist.
(eieio-all-generic-functions): Adjust to use of hashtables.
* emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to
symbol-hashtable. It contains a hashtable instead of an obarray.
(generic-p): Use symbol property `eieio-method-hashtable' instead of
`eieio-method-obarray'.
(generic-primary-only-p, generic-primary-only-one-p):
Slight optimization.
(eieio-defclass-autoload-map): Use a hashtable instead of an obarray.
(eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly.
(eieio-class-un-autoload): Use autoload-do-load.
(eieio-defclass): Use dolist, cl-pushnew, cl-callf.
Use new cl-deftype-satisfies. Adjust to use of hashtables.
Don't hardcode the value of eieio--object-num-slots.
(eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg.
Use a closure rather than a backquoted lambda.
(eieio--defmethod): Adjust call accordingly. Set doc-string via the
function-documentation property.
(eieio-slot-originating-class-p, eieio-slot-name-index)
(eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add)
(eieio-generic-form): Adjust to use of hashtables.
(eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take
additional class argument.
(eieio-generic-call-methodname): Remove, unused.
* emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
Prefer \' to $.
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
* completion.el: Use post-self-insert-hook (bug#19400).
......@@ -95,8 +135,8 @@
* electric.el (Electric-pop-up-window):
* help.el (resize-temp-buffer-window): Call fit-window-to-buffer
with `preserve-size' t.
* minibuffer.el (minibuffer-completion-help): Use
`resize-temp-buffer-window' instead of `fit-window-to-buffer'
* minibuffer.el (minibuffer-completion-help):
Use `resize-temp-buffer-window' instead of `fit-window-to-buffer'
(Bug#19355). Preserve size of completions window.
* register.el (register-preview): Preserve size of register
preview window.
......@@ -106,8 +146,8 @@
`window-preserve-size'.
(window-min-pixel-size, window--preservable-size)
(window-preserve-size, window-preserved-size)
(window--preserve-size, window--min-size-ignore-p): New
functions.
(window--preserve-size, window--min-size-ignore-p):
New functions.
(window-min-size, window-min-delta, window--resizable)
(window--resize-this-window, split-window-below)
(split-window-right): Amend doc-string.
......
......@@ -375,13 +375,13 @@ Second, any text properties will be stripped from strings."
)
(defun eieio-persistent-slot-type-is-class-p (type)
"Return the class refered to in TYPE.
"Return the class referred to in TYPE.
If no class is referenced there, then return nil."
(cond ((class-p type)
;; If the type is a class, then return it.
type)
((and (symbolp type) (string-match "-child$" (symbol-name type))
;; 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)))))
;; If it is the predicate ending with -child, then return
......@@ -389,8 +389,8 @@ If no class is referenced there, then return nil."
;; class is the same as if we used -child, so no further work needed.
(intern-soft (substring (symbol-name type) 0
(match-beginning 0))))
((and (symbolp type) (string-match "-list$" (symbol-name type))
;; FIXME: foo-list should not be a valid type!
((and (symbolp type) (string-match "-list\\'" (symbol-name type))
(class-p (intern-soft (substring (symbol-name type) 0
(match-beginning 0)))))
;; If it is the predicate ending with -list, then return
......
This diff is collapsed.
;;; eieio-custom.el -- eieio object customization
;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
;; Copyright (C) 1999-2001, 2005, 2007-2014 Free Software Foundation,
;; Inc.
......@@ -136,7 +136,7 @@ Updates occur regardless of the current customization group.")
))
(widget-value-set vc (widget-value vc))))
(defun eieio-custom-toggle-parent (widget &rest ignore)
(defun eieio-custom-toggle-parent (widget &rest _)
"Toggle visibility of parent of WIDGET.
Optional argument IGNORE is an extraneous parameter."
(eieio-custom-toggle-hide (widget-get widget :parent)))
......@@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter."
:clone-object-children nil
)
(defun eieio-object-match (widget value)
(defun eieio-object-match (_widget _value)
"Match info for WIDGET against VALUE."
;; Write me
t)
......@@ -216,7 +216,7 @@ Optional argument IGNORE is an extraneous parameter."
(widget-insert "*" (capitalize (symbol-name master-group)) "*")
(widget-create 'push-button
:thing (cons obj (car groups))
:notify (lambda (widget &rest stuff)
:notify (lambda (widget &rest _)
(eieio-customize-object
(car (widget-get widget :thing))
(cdr (widget-get widget :thing))))
......@@ -389,14 +389,14 @@ These groups are specified with the `:group' slot flag."
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _)
(widget-apply eieio-wo :value-get)
(eieio-done-customizing eieio-co)
(bury-buffer))
"Accept")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _)
;; I think the act of getting it sets
;; its value through the get function.
(message "Applying Changes...")
......@@ -406,13 +406,13 @@ Argument OBJ is the object being customized."
"Apply")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _)
(message "Resetting")
(eieio-customize-object eieio-co eieio-cog))
"Reset")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _)
(bury-buffer))
"Cancel"))
......@@ -431,13 +431,11 @@ Must return the created widget."
:clone-object-children t
)
(defun eieio-object-value-to-abstract (widget value)
(defun eieio-object-value-to-abstract (_widget value)
"For WIDGET, convert VALUE to an abstract /safe/ representation."
(if (eieio-object-p value) value
(if (null value) value
nil)))
(if (eieio-object-p value) value))
(defun eieio-object-abstract-to-value (widget value)
(defun eieio-object-abstract-to-value (_widget value)
"For WIDGET, convert VALUE from an abstract /safe/ representation."
value)
......
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
......@@ -137,7 +137,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(data
(catch 'moose (eieio-generic-call
method (list class))))
(buf (data-debug-new-buffer "*Method Invocation*"))
(_buf (data-debug-new-buffer "*Method Invocation*"))
(data2 (mapcar (lambda (sym)
(symbol-function (car sym)))
data)))
......
......@@ -218,11 +218,10 @@ Outputs to the current buffer."
(defun eieio-build-class-list (class)
"Return a list of all classes that inherit from CLASS."
(if (class-p class)
(apply #'append
(mapcar
(lambda (c)
(append (list c) (eieio-build-class-list c)))
(eieio-class-children-fast class)))
(cl-mapcan
(lambda (c)
(append (list c) (eieio-build-class-list c)))
(eieio-class-children-fast class))
(list class)))
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
......@@ -235,11 +234,12 @@ Optional argument BUILDLIST is more list to attach and is used internally."
(sublst (eieio--class-children (class-v cc))))
(unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc)))
;; FIXME: Completion tables don't need alists, and ede/generic.el needs
;; the symbols rather than their names.
(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
(while sublst
(dolist (elem sublst)
(setq buildlist (eieio-build-class-alist
(car sublst) instantiable-only buildlist))
(setq sublst (cdr sublst)))
elem instantiable-only buildlist)))
buildlist))
(defvar eieio-read-class nil
......@@ -378,51 +378,47 @@ are not abstract."
"Return a list of all generic functions.
Optional CLASS argument returns only those functions that contain
methods for CLASS."
(let ((l nil) tree (cn (if class (symbol-name class) nil)))
(let ((l nil))
(mapatoms
(lambda (symbol)
(setq tree (get symbol 'eieio-method-obarray))
(if tree
(progn
;; A symbol might be interned for that class in one of
;; these three slots in the method-obarray.
(if (or (not class)
(fboundp (intern-soft cn (aref tree 0)))
(fboundp (intern-soft cn (aref tree 1)))
(fboundp (intern-soft cn (aref tree 2))))
(setq l (cons symbol l)))))))
(let ((tree (get symbol 'eieio-method-hashtable)))
(when tree
;; A symbol might be interned for that class in one of
;; these three slots in the method-obarray.
(if (or (not class)
(car (gethash class (aref tree 0)))
(car (gethash class (aref tree 1)))
(car (gethash class (aref tree 2))))
(setq l (cons symbol l)))))))
l))
(defun eieio-method-documentation (generic class)
"Return a list of the specific documentation of GENERIC for CLASS.
If there is not an explicit method for CLASS in GENERIC, or if that
function has no documentation, then return nil."
(let ((tree (get generic 'eieio-method-obarray))
(cn (symbol-name class))
before primary after)
(if (not tree)
nil
(let ((tree (get generic 'eieio-method-hashtable)))
(when tree
;; A symbol might be interned for that class in one of
;; these three slots in the method-obarray.
(setq before (intern-soft cn (aref tree 0))
primary (intern-soft cn (aref tree 1))
after (intern-soft cn (aref tree 2)))
(if (not (or (fboundp before)
(fboundp primary)
(fboundp after)))
nil
(list (if (fboundp before)
(cons (help-function-arglist before)
(documentation before))
nil)
(if (fboundp primary)
(cons (help-function-arglist primary)
(documentation primary))
nil)
(if (fboundp after)
(cons (help-function-arglist after)
(documentation after))
nil))))))
;; these three slots in the method-hashtable.
;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static,
;; 1 for before, and 2 for primary (and 3 for after)?
(let ((before (car (gethash class (aref tree 0))))
(primary (car (gethash class (aref tree 1))))
(after (car (gethash class (aref tree 2)))))
(if (not (or before primary after))
nil
(list (if before
(cons (help-function-arglist before)
(documentation before))
nil)
(if primary
(cons (help-function-arglist primary)
(documentation primary))
nil)
(if after
(cons (help-function-arglist after)
(documentation after))
nil)))))))
(defvar eieio-read-generic nil
"History of the `eieio-read-generic' prompt.")
......@@ -627,7 +623,7 @@ Optional argument HISTORYVAR is the variable to use as history."
()
"Menu part in easymenu format used in speedbar while in `eieio' mode.")
(defun eieio-class-speedbar (dir-or-object depth)
(defun eieio-class-speedbar (_dir-or-object _depth)
"Create buttons in speedbar that represents the current project.
DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the
current expansion depth."
......@@ -676,7 +672,7 @@ Argument INDENT is the depth of indentation."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
(defun eieio-describe-class-sb (text token indent)
(defun eieio-describe-class-sb (_text token _indent)
"Describe the class TEXT in TOKEN.
INDENT is the current indentation level."
(dframe-with-attached-buffer
......
......@@ -343,12 +343,15 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
"Return non-nil if CHILD class is a subclass of CLASS."
(eieio--check-type class-p class)
(eieio--check-type class-p child)
(let ((p nil))
(while (and child (not (eq child class)))
(setq p (append p (eieio--class-parent (class-v child)))
child (car p)
p (cdr p)))
(if child t)))
;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
;; so we have to special case it here.
(or (eq class 'eieio-default-superclass)
(let ((p nil))
(while (and child (not (eq child class)))
(setq p (append p (eieio--class-parent (class-v child)))
child (car p)
p (cdr p)))
(if child t))))
(defun object-slots (obj)
"Return list of slots available in OBJ."
......@@ -906,7 +909,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;***
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "889c0a935dddf758dbb65488470ffa06")
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e50a67ebd0c6258c615e4bf16714e81f")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
......
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Remove use of eieio-generic-call-methodname.
(eieio-test-method-order-list-3, eieio-test-method-order-list-6)
(eieio-test-method-order-list-7, eieio-test-method-order-list-8):
Adjust the expected result accordingly.
2014-12-19 Artur Malabarba <bruce.connor.am@gmail.com>
* automated/let-alist.el: require `cl-lib'
......@@ -27,8 +35,8 @@
(vc-test--create-repo-function): Rename from
`vc-test--create-repo-if-not-supported'. Adapt all callees.
(vc-test--create-repo): Check also for revision-granularity.
(vc-test--unregister-function): Additional argument FILE. Adapt
all callees.
(vc-test--unregister-function): Additional argument FILE.
Adapt all callees.
(vc-test--working-revision): New defun.
(vc-test-*-working-revision): New tests.
......@@ -65,7 +73,7 @@
2014-11-21 Ulf Jasper <ulf.jasper@web.de>
* automated/libxml-tests.el
(libxml-tests--data-comments-preserved): Renamed from
(libxml-tests--data-comments-preserved): Rename from
'libxml-tests--data'.
(libxml-tests--data-comments-discarded): New.
(libxml-tests): Check whether 'libxml-parse-xml-region' is
......@@ -92,8 +100,8 @@
2014-11-17 Ulf Jasper <ulf.jasper@web.de>
* automated/icalendar-tests.el (icalendar-tests--test-export): New
optional parameter `alarms'.
* automated/icalendar-tests.el (icalendar-tests--test-export):
New optional parameter `alarms'.
(icalendar-export-alarms): New test for exporting icalendar
alarms.
(icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil.
......@@ -107,8 +115,8 @@
2014-11-16 Ulf Jasper <ulf.jasper@web.de>
* automated/icalendar-tests.el (icalendar--parse-vtimezone): Add
testcase where offsets of standard time and daylight saving time
* automated/icalendar-tests.el (icalendar--parse-vtimezone):
Add testcase where offsets of standard time and daylight saving time
are equal.
(icalendar-real-world): Fix error in test case. Expected result
was wrong when offsets of standard time and daylight saving time
......
......@@ -61,9 +61,8 @@
"Store current invocation class symbol in the invocation order list."
(let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
(or eieio-generic-call-key 0)))
(c (list eieio-generic-call-methodname keysym (eieio--scoped-class))))
(setq eieio-test-method-order-list
(cons c eieio-test-method-order-list))))
(c (list keysym (eieio--scoped-class))))
(push c eieio-test-method-order-list)))
(defun eieio-test-match (rightanswer)
"Do a test match."
......@@ -120,17 +119,17 @@
(ert-deftest eieio-test-method-order-list-3 ()
(let ((eieio-test-method-order-list nil)
(ans '(
(eitest-F :BEFORE eitest-B)
(eitest-F :BEFORE eitest-B-base1)
(eitest-F :BEFORE eitest-B-base2)
(:BEFORE eitest-B)
(:BEFORE eitest-B-base1)
(:BEFORE eitest-B-base2)
(eitest-F :PRIMARY eitest-B)
(eitest-F :PRIMARY eitest-B-base1)
(eitest-F :PRIMARY eitest-B-base2)
(:PRIMARY eitest-B)
(:PRIMARY eitest-B-base1)
(:PRIMARY eitest-B-base2)
(eitest-F :AFTER eitest-B-base2)
(eitest-F :AFTER eitest-B-base1)
(eitest-F :AFTER eitest-B)
(:AFTER eitest-B-base2)
(:AFTER eitest-B-base1)
(:AFTER eitest-B)
)))
(eitest-F (eitest-B nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
......@@ -193,9 +192,9 @@
(ert-deftest eieio-test-method-order-list-6 ()
(let ((eieio-test-method-order-list nil)
(ans '(
(constructor :STATIC C)
(constructor :STATIC C-base1)
(constructor :STATIC C-base2)
(:STATIC C)
(:STATIC C-base1)
(:STATIC C-base2)
)))
(C nil)
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
......@@ -238,10 +237,10 @@
(ert-deftest eieio-test-method-order-list-7 ()
(let ((eieio-test-method-order-list nil)
(ans '(
(eitest-F :PRIMARY D)
(eitest-F :PRIMARY D-base1)
;; (eitest-F :PRIMARY D-base2)
(eitest-F :PRIMARY D-base0)
(:PRIMARY D)
(:PRIMARY D-base1)
;; (:PRIMARY D-base2)
(:PRIMARY D-base0)
)))
(eitest-F (D nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
......@@ -277,10 +276,10 @@
(ert-deftest eieio-test-method-order-list-8 ()
(let ((eieio-test-method-order-list nil)
(ans '(
(eitest-F :PRIMARY E)
(eitest-F :PRIMARY E-base1)
(eitest-F :PRIMARY E-base2)
(eitest-F :PRIMARY E-base0)
(:PRIMARY E)
(:PRIMARY E-base1)
(:PRIMARY E-base2)
(:PRIMARY E-base0)
)))
(eitest-F (E nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment