Merge branch 'cedet-object-name'
This commit is contained in:
commit
fb5da5035a
33 changed files with 92 additions and 95 deletions
|
@ -149,7 +149,6 @@ HOSTS can be a string or a list of strings."
|
|||
|
||||
(defvar auth-source-pass-backend
|
||||
(auth-source-backend
|
||||
(when (<= emacs-major-version 25) "password-store")
|
||||
:source "." ;; not used
|
||||
:type 'password-store
|
||||
:search-function #'auth-source-pass-search)
|
||||
|
|
|
@ -627,14 +627,14 @@ instead of the current project."
|
|||
"Fills :directory or :file slots if they're missing in project THIS.
|
||||
The other slot will be used to calculate values.
|
||||
PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc."
|
||||
(when (and (or (not (slot-boundp this :file))
|
||||
(not (oref this file)))
|
||||
(slot-boundp this :directory)
|
||||
(when (and (not (and (slot-boundp this 'file)
|
||||
(oref this file)))
|
||||
(slot-boundp this 'directory)
|
||||
(oref this directory))
|
||||
(oset this file (expand-file-name project-file-name (oref this directory))))
|
||||
(when (and (or (not (slot-boundp this :directory))
|
||||
(not (oref this directory)))
|
||||
(slot-boundp this :file)
|
||||
(when (and (not (and (slot-boundp this 'directory)
|
||||
(oref this directory)))
|
||||
(slot-boundp this 'file)
|
||||
(oref this file))
|
||||
(oset this directory (file-name-directory (oref this file))))
|
||||
)
|
||||
|
|
|
@ -154,14 +154,9 @@ the directory isn't on the `safe' list, ask to add it to the safe list."
|
|||
(when (file-exists-p fname)
|
||||
(message "Ignoring EDE config file for now and creating a new one. Use C-c . g to load it.")
|
||||
;; Set how it was ignored.
|
||||
(if loadask
|
||||
(setq ignore-type 'manual)
|
||||
(setq ignore-type 'auto))
|
||||
)
|
||||
(setq ignore-type (if loadask 'manual 'auto)))
|
||||
;; Create a new one.
|
||||
(setq config (make-instance class
|
||||
"Configuration"
|
||||
:file fname))
|
||||
(setq config (make-instance class :file fname))
|
||||
(oset config ignored-file ignore-type)
|
||||
|
||||
;; Set initial values based on project.
|
||||
|
|
|
@ -327,7 +327,7 @@ If one doesn't exist, create a new one for this directory."
|
|||
(ans (object-assoc dir :path targets))
|
||||
)
|
||||
(when (not ans)
|
||||
(setq ans (ede-cpp-root-target dir
|
||||
(setq ans (ede-cpp-root-target
|
||||
:name (file-name-nondirectory
|
||||
(directory-file-name dir))
|
||||
:path dir
|
||||
|
|
|
@ -118,7 +118,7 @@ All directories need at least one target.")
|
|||
"Make sure the targets slot is bound."
|
||||
(cl-call-next-method)
|
||||
(unless (slot-boundp this 'targets)
|
||||
(oset this :targets nil)))
|
||||
(oset this targets nil)))
|
||||
|
||||
;;; File Stuff
|
||||
;;
|
||||
|
|
|
@ -153,7 +153,7 @@ The class allocated value is replace by different sub classes.")
|
|||
"Make sure the targets slot is bound."
|
||||
(cl-call-next-method)
|
||||
(unless (slot-boundp this 'targets)
|
||||
(oset this :targets nil))
|
||||
(oset this targets nil))
|
||||
)
|
||||
|
||||
(cl-defmethod ede-project-root ((this ede-generic-project))
|
||||
|
|
|
@ -227,7 +227,7 @@ All directories need at least one target.")
|
|||
"Make sure the targets slot is bound."
|
||||
(cl-call-next-method)
|
||||
(unless (slot-boundp this 'targets)
|
||||
(oset this :targets nil)))
|
||||
(oset this targets nil)))
|
||||
|
||||
;;; File Stuff
|
||||
;;
|
||||
|
@ -377,9 +377,9 @@ Argument COMMAND is the command to use for compiling the target."
|
|||
(inc (ede-linux--include-path dir bdir arch))
|
||||
(ver (ede-linux-version dir)))
|
||||
(oset this version ver)
|
||||
(oset this :build-directory bdir)
|
||||
(oset this :architecture arch)
|
||||
(oset this :include-path inc)
|
||||
(oset this build-directory bdir)
|
||||
(oset this architecture arch)
|
||||
(oset this include-path inc)
|
||||
))
|
||||
|
||||
(provide 'ede/linux)
|
||||
|
|
|
@ -89,7 +89,7 @@ based on `ede-locate-setup-options'."
|
|||
(when (called-interactively-p 'interactive)
|
||||
(message "Setting locator to ede-locate-base"))
|
||||
(setq ans 'ede-locate-base))
|
||||
(oset proj locate-obj (make-instance ans "Loc" :root root))
|
||||
(oset proj locate-obj (make-instance ans :root root))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "Setting locator to %s" ans))
|
||||
))
|
||||
|
|
|
@ -480,7 +480,7 @@ This is used when subprojects are made in named subdirectories."
|
|||
(bug (nth 2 pi))
|
||||
(cof (nth 3 pi))
|
||||
(ampf (project-am-makefile
|
||||
pn :name pn
|
||||
:name pn
|
||||
:version ver
|
||||
:mailinglist (or bug "")
|
||||
:file fn)))
|
||||
|
|
|
@ -86,7 +86,7 @@ ROOTPROJ is nil, since we will only create a single EDE project here."
|
|||
(obj nil))
|
||||
(when pf
|
||||
(setq obj (eieio-persistent-read pf))
|
||||
(oset obj :directory dir)
|
||||
(oset obj directory dir)
|
||||
)
|
||||
obj))
|
||||
|
||||
|
|
|
@ -89,8 +89,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
|
|||
|
||||
(setq allhits (semantic--analyze-refs-full-lookup tag scope t))
|
||||
|
||||
(semantic-analyze-references (semantic-tag-name tag)
|
||||
:tag tag
|
||||
(semantic-analyze-references :tag tag
|
||||
:tagdb db
|
||||
:scope scope
|
||||
:rawsearchdata allhits)
|
||||
|
|
|
@ -1256,8 +1256,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
|
|||
(setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
|
||||
|
||||
;; (setq refs
|
||||
(semantic-analyze-references (semantic-tag-name tag)
|
||||
:tag tag
|
||||
(semantic-analyze-references :tag tag
|
||||
:tagdb db
|
||||
:scope scope
|
||||
:rawsearchdata allhits)))) ;;)
|
||||
|
|
|
@ -1899,7 +1899,7 @@ completion text in ghost text."
|
|||
(mapcar
|
||||
(lambda (class)
|
||||
(let* ((C (intern (car class)))
|
||||
(doc (documentation-property C 'variable-documentation))
|
||||
(doc (cl--class-docstring (cl--find-class C)))
|
||||
(doc1 (car (split-string doc "\n")))
|
||||
)
|
||||
(list 'const
|
||||
|
@ -1930,7 +1930,7 @@ DEFAULT-TAG is a semantic tag or string to use as the default value.
|
|||
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
|
||||
HISTORY is a symbol representing a variable to store the history in."
|
||||
(semantic-complete-read-tag-engine
|
||||
(semantic-collector-buffer-deep prompt :buffer (current-buffer))
|
||||
(semantic-collector-buffer-deep :buffer (current-buffer))
|
||||
(semantic-displayer-traditional-with-focus-highlight)
|
||||
;;(semantic-displayer-tooltip)
|
||||
prompt
|
||||
|
@ -1952,7 +1952,7 @@ DEFAULT-TAG is a semantic tag or string to use as the default value.
|
|||
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
|
||||
HISTORY is a symbol representing a variable to store the history in."
|
||||
(semantic-complete-read-tag-engine
|
||||
(semantic-collector-local-members prompt :buffer (current-buffer))
|
||||
(semantic-collector-local-members :buffer (current-buffer))
|
||||
(semantic-displayer-traditional-with-focus-highlight)
|
||||
;;(semantic-displayer-tooltip)
|
||||
prompt
|
||||
|
@ -1974,8 +1974,7 @@ DEFAULT-TAG is a semantic tag or string to use as the default value.
|
|||
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
|
||||
HISTORY is a symbol representing a variable to store the history in."
|
||||
(semantic-complete-read-tag-engine
|
||||
(semantic-collector-project-brutish prompt
|
||||
:buffer (current-buffer)
|
||||
(semantic-collector-project-brutish :buffer (current-buffer)
|
||||
:path (current-buffer)
|
||||
)
|
||||
(semantic-displayer-traditional-with-focus-highlight)
|
||||
|
@ -2049,7 +2048,6 @@ prompts. these are calculated from the CONTEXT variable passed in."
|
|||
(setq syms (nreverse (cdr (nreverse syms))))
|
||||
(semantic-complete-read-tag-engine
|
||||
(semantic-collector-analyze-completions
|
||||
prompt
|
||||
:buffer (oref context buffer)
|
||||
:context context)
|
||||
(semantic-displayer-traditional-with-focus-highlight)
|
||||
|
|
|
@ -309,11 +309,7 @@ If there is no database for DIRECTORY available, then
|
|||
)
|
||||
(if found
|
||||
(setq db found)
|
||||
(setq db (make-instance
|
||||
dbeC
|
||||
directory
|
||||
:ebrowse-struct ebd
|
||||
))
|
||||
(setq db (make-instance dbeC :ebrowse-struct ebd))
|
||||
(oset db reference-directory directory))
|
||||
|
||||
;; Once we recycle or make a new DB, refresh the
|
||||
|
|
|
@ -138,10 +138,6 @@ If DIRECTORY doesn't exist, create a new one."
|
|||
(unless db
|
||||
(setq db (make-instance
|
||||
dbc ; Create the database requested. Perhaps
|
||||
(concat (file-name-nondirectory
|
||||
(directory-file-name
|
||||
directory))
|
||||
"/")
|
||||
:file fn :tables nil
|
||||
:semantic-tag-version semantic-tag-version
|
||||
:semanticdb-version semanticdb-file-version)))
|
||||
|
|
|
@ -136,7 +136,7 @@ If there is no table, create one, and fill it in."
|
|||
;; Make sure we have a cache object in the DB index.
|
||||
(when (not cache)
|
||||
;; The object won't change as we fill it with stuff.
|
||||
(setq cache (semanticdb-typecache (semanticdb-full-filename table)))
|
||||
(setq cache (semanticdb-typecache))
|
||||
(oset idx type-cache cache))
|
||||
|
||||
cache))
|
||||
|
|
|
@ -188,7 +188,6 @@ If one doesn't exist, create it."
|
|||
(oref obj index)
|
||||
(let ((idx nil))
|
||||
(setq idx (funcall semanticdb-default-find-index-class
|
||||
(concat (eieio-object-name obj) " index")
|
||||
;; Fill in the defaults
|
||||
:table obj
|
||||
))
|
||||
|
@ -413,7 +412,6 @@ If the table for FILE does not exist, create one."
|
|||
;; This implementation will satisfy autoloaded classes
|
||||
;; for tables.
|
||||
(setq newtab (funcall (oref db new-table-class)
|
||||
(file-name-nondirectory file)
|
||||
:file (file-name-nondirectory file)
|
||||
))
|
||||
(setf (slot-value newtab 'parent-db) db)
|
||||
|
@ -486,7 +484,7 @@ other than :table."
|
|||
(if obj
|
||||
obj ;; Just return it.
|
||||
;; No object, let's create a new one and return that.
|
||||
(setq obj (funcall desired-class "Cache" :table table))
|
||||
(setq obj (make-instance desired-class :table table))
|
||||
(object-add-to-list table 'cache obj)
|
||||
obj)))
|
||||
|
||||
|
|
|
@ -197,7 +197,7 @@ The resulting bookmark is then sorted within the ring."
|
|||
(ring-remove ring idx))
|
||||
(setq idx (1+ idx)))
|
||||
;; Create a new mark
|
||||
(let ((sbm (semantic-bookmark (semantic-tag-name tag)
|
||||
(let ((sbm (semantic-bookmark :object-name (semantic-tag-name tag)
|
||||
:tag tag)))
|
||||
;; Take the mark, and update it for the current state.
|
||||
(ring-insert ring sbm)
|
||||
|
|
|
@ -199,8 +199,7 @@ STATE is the current compilation state."
|
|||
(tag nil)
|
||||
(class nil)
|
||||
(table nil)
|
||||
(STATE (srecode-compile-state (file-name-nondirectory
|
||||
(buffer-file-name))))
|
||||
(STATE (srecode-compile-state))
|
||||
(mode nil)
|
||||
(application nil)
|
||||
(framework nil)
|
||||
|
@ -263,7 +262,7 @@ STATE is the current compilation state."
|
|||
;; Create a compound dictionary value from "value".
|
||||
(require 'srecode/dictionary)
|
||||
(let ((cv (srecode-dictionary-compound-variable
|
||||
name :value value)))
|
||||
:value value)))
|
||||
(setq vars (cons (cons name cv) vars)))
|
||||
))
|
||||
)
|
||||
|
@ -361,7 +360,7 @@ STATE is the current compile state as an object of class
|
|||
:where 'end)))))))
|
||||
|
||||
;; Construct and return the template object.
|
||||
(srecode-template (semantic-tag-name tag)
|
||||
(srecode-template :object-name (semantic-tag-name tag)
|
||||
:context context
|
||||
:args (nreverse addargs)
|
||||
:dictionary root-dict
|
||||
|
@ -504,7 +503,8 @@ PROPS are additional properties that might need to be passed
|
|||
to the inserter constructor."
|
||||
;;(message "Compile: %s %S" name props)
|
||||
(if (not key)
|
||||
(apply #'make-instance 'srecode-template-inserter-variable name props)
|
||||
(apply #'make-instance 'srecode-template-inserter-variable
|
||||
:object-name name props)
|
||||
(let ((classes (eieio-class-children 'srecode-template-inserter))
|
||||
(new nil))
|
||||
;; Loop over the various subclasses and
|
||||
|
@ -515,7 +515,8 @@ to the inserter constructor."
|
|||
(when (and (not (class-abstract-p (car classes)))
|
||||
(equal (oref-default (car classes) key) key))
|
||||
;; Create the new class, and apply state.
|
||||
(setq new (apply #'make-instance (car classes) name props))
|
||||
(setq new (apply #'make-instance (car classes)
|
||||
:object-name name props))
|
||||
(srecode-inserter-apply-state new STATE)
|
||||
)
|
||||
(setq classes (cdr classes)))
|
||||
|
@ -589,7 +590,7 @@ A list of defined variables VARS provides a variable table."
|
|||
(cl-defmethod srecode-dump ((tmp srecode-template))
|
||||
"Dump the contents of the SRecode template tmp."
|
||||
(princ "== Template \"")
|
||||
(princ (eieio-object-name-string tmp))
|
||||
(princ (slot-value tmp 'object-name))
|
||||
(princ "\" in context ")
|
||||
(princ (oref tmp context))
|
||||
(princ "\n")
|
||||
|
@ -635,7 +636,7 @@ Argument INDENT specifies the indentation level for the list."
|
|||
(cl-defmethod srecode-dump ((ins srecode-template-inserter) _indent)
|
||||
"Dump the state of the SRecode template inserter INS."
|
||||
(princ "INS: \"")
|
||||
(princ (eieio-object-name-string ins))
|
||||
(princ (slot-value ins 'object-name))
|
||||
(when (oref ins secondname)
|
||||
(princ "\" : \"")
|
||||
(princ (oref ins secondname)))
|
||||
|
|
|
@ -146,8 +146,7 @@ specified in a C file."
|
|||
(value-dict (srecode-dictionary-add-section-dictionary
|
||||
dict "VALUE")))
|
||||
(srecode-semantic-apply-tag-to-dict
|
||||
(srecode-semantic-tag (semantic-tag-name value-tag)
|
||||
:prime value-tag)
|
||||
(srecode-semantic-tag :prime value-tag)
|
||||
value-dict))
|
||||
|
||||
;; Discriminate using statements referring to namespaces and
|
||||
|
@ -224,8 +223,7 @@ specified in a C file."
|
|||
(let ((template-dict (srecode-dictionary-add-section-dictionary
|
||||
templates-dict "ARGS")))
|
||||
(srecode-semantic-apply-tag-to-dict
|
||||
(srecode-semantic-tag (semantic-tag-name template)
|
||||
:prime template)
|
||||
(srecode-semantic-tag :prime template)
|
||||
template-dict)))))
|
||||
)
|
||||
|
||||
|
|
|
@ -369,7 +369,7 @@ values but STATE is nil."
|
|||
(srecode-dictionary-set-value
|
||||
dict name
|
||||
(srecode-dictionary-compound-variable
|
||||
name :value value :state state)))))
|
||||
:value value :state state)))))
|
||||
(setq entries (nthcdr 2 entries)))
|
||||
dict)
|
||||
|
||||
|
@ -536,7 +536,7 @@ inserted with a new editable field.")
|
|||
(error "Unknown default value for value %S" name)))
|
||||
|
||||
;; Create a field from the inserter.
|
||||
(srecode-field name :name name
|
||||
(srecode-field :name name
|
||||
:start start
|
||||
:end (point)
|
||||
:prompt (oref sti prompt)
|
||||
|
|
|
@ -648,8 +648,7 @@ Use DICTIONARY to resolve values."
|
|||
Use DICTIONARY to resolve values."
|
||||
(let* ((default (srecode-insert-ask-default sti dictionary))
|
||||
(compound-value
|
||||
(srecode-field-value (oref sti object-name)
|
||||
:firstinserter sti
|
||||
(srecode-field-value :firstinserter sti
|
||||
:defaultvalue default))
|
||||
)
|
||||
;; Return this special compound value as the thing to insert.
|
||||
|
@ -806,7 +805,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
|
|||
(srecode-insert-report-error
|
||||
dict
|
||||
"Only section dictionaries allowed for `%s'"
|
||||
(eieio-object-name-string sti)))
|
||||
(slot-value sti 'object-name)))
|
||||
|
||||
;; Output the code from the sub-template.
|
||||
(srecode-insert-method (slot-value sti slot) dict))
|
||||
|
@ -860,10 +859,10 @@ applied to the text between the section start and the
|
|||
"For the section inserter INS, parse INPUT.
|
||||
Shorten input until the END token is found.
|
||||
Return the remains of INPUT."
|
||||
(let* ((out (srecode-compile-split-code tag input STATE
|
||||
(oref ins object-name))))
|
||||
(let* ((name (oref ins object-name))
|
||||
(out (srecode-compile-split-code tag input STATE name)))
|
||||
(oset ins template (srecode-template
|
||||
(eieio-object-name-string ins)
|
||||
:object-name name
|
||||
:context nil
|
||||
:args nil
|
||||
:code (cdr out)))
|
||||
|
|
|
@ -338,7 +338,7 @@ if that file is NEW, otherwise assume the mode has not changed."
|
|||
;; Only do the save if we are dirty, or if we are in an interactive
|
||||
;; Emacs.
|
||||
(when (and dirty (not noninteractive)
|
||||
(slot-boundp srecode-current-map :file))
|
||||
(slot-boundp srecode-current-map 'file))
|
||||
(eieio-persistent-save srecode-current-map))
|
||||
))
|
||||
|
||||
|
|
|
@ -207,7 +207,7 @@ MENU-DEF is the menu to bind this into."
|
|||
(ctxtcons (assoc ctxt alltabs))
|
||||
(bind (if (slot-boundp temp 'binding)
|
||||
(oref temp binding)))
|
||||
(name (eieio-object-name-string temp)))
|
||||
(name (slot-value temp 'object-name)))
|
||||
|
||||
(when (not ctxtcons)
|
||||
(if (string= context ctxt)
|
||||
|
|
|
@ -129,8 +129,7 @@ variable default values, and other things."
|
|||
larg nil nil)))
|
||||
;; Apply the sub-argument to the subdictionary.
|
||||
(srecode-semantic-apply-tag-to-dict
|
||||
(srecode-semantic-tag (semantic-tag-name larg)
|
||||
:prime larg)
|
||||
(srecode-semantic-tag :prime larg)
|
||||
subdict)
|
||||
)
|
||||
;; Next!
|
||||
|
@ -203,8 +202,7 @@ variable default values, and other things."
|
|||
(when (not tag)
|
||||
(error "No tag for current template. Use the semantic kill-ring"))
|
||||
(srecode-semantic-apply-tag-to-dict
|
||||
(srecode-semantic-tag (semantic-tag-name tag)
|
||||
:prime tag)
|
||||
(srecode-semantic-tag :prime tag)
|
||||
dict)))
|
||||
|
||||
;;; :tagtype ARGUMENT HANDLING
|
||||
|
@ -394,7 +392,7 @@ as `function' will leave point where code might be inserted."
|
|||
;; Resolve TAG into the dictionary. We may have a :tag arg
|
||||
;; from the macro such that we don't need to do this.
|
||||
(when (not (srecode-dictionary-lookup-name dict "TAG"))
|
||||
(let ((tagobj (srecode-semantic-tag (semantic-tag-name tag) :prime tag))
|
||||
(let ((tagobj (srecode-semantic-tag :prime tag))
|
||||
)
|
||||
(srecode-semantic-apply-tag-to-dict tagobj dict)))
|
||||
|
||||
|
|
|
@ -276,7 +276,7 @@ we can tell font lock about them.")
|
|||
(prin1 (format "%c" key))
|
||||
)))
|
||||
(terpri)
|
||||
(princ (documentation-property C 'variable-documentation))
|
||||
(princ (cl--class-docstring (cl--find-class C)))
|
||||
(terpri)
|
||||
(when showexample
|
||||
(princ "Example:")
|
||||
|
@ -503,7 +503,7 @@ section or ? for an ask variable."
|
|||
(when inserter
|
||||
(let ((base
|
||||
(cons (oref inserter object-name)
|
||||
(if (and (slot-boundp inserter :secondname)
|
||||
(if (and (slot-boundp inserter 'secondname)
|
||||
(oref inserter secondname))
|
||||
(split-string (oref inserter secondname)
|
||||
":")
|
||||
|
|
|
@ -180,7 +180,6 @@ INIT are the initialization parameters for the new template table."
|
|||
(old (srecode-mode-table-find mt file))
|
||||
(attr (file-attributes file))
|
||||
(new (apply #'srecode-template-table
|
||||
(file-name-nondirectory file)
|
||||
:file file
|
||||
:filesize (file-attribute-size attr)
|
||||
:filedate (file-attribute-modification-time attr)
|
||||
|
|
|
@ -740,18 +740,19 @@ Argument FN is the function calling this verifier."
|
|||
|
||||
;;; Get/Set slots in an object.
|
||||
|
||||
(eval-and-compile
|
||||
(defun eieio--check-slot-name (exp _obj slot &rest _)
|
||||
(pcase slot
|
||||
((and (or `',name (and name (pred keywordp)))
|
||||
(guard (not (eieio--known-slot-name-p name))))
|
||||
(macroexp-warn-and-return
|
||||
(format-message "Unknown slot `%S'" name)
|
||||
exp nil 'compile-only name))
|
||||
(_ exp))))
|
||||
|
||||
(defun eieio-oref (obj slot)
|
||||
"Return the value in OBJ at SLOT in the object vector."
|
||||
(declare (compiler-macro
|
||||
(lambda (exp)
|
||||
(ignore obj)
|
||||
(pcase slot
|
||||
((and (or `',name (and name (pred keywordp)))
|
||||
(guard (not (eieio--known-slot-name-p name))))
|
||||
(macroexp-warn-and-return
|
||||
(format-message "Unknown slot `%S'" name)
|
||||
exp nil 'compile-only name))
|
||||
(_ exp))))
|
||||
(declare (compiler-macro eieio--check-slot-name)
|
||||
;; FIXME: Make it a gv-expander such that the hash-table lookup is
|
||||
;; only performed once when used in `push' and friends?
|
||||
(gv-setter eieio-oset))
|
||||
|
@ -822,6 +823,7 @@ Fills in CLASS's SLOT with its default value."
|
|||
(defun eieio-oset (obj slot value)
|
||||
"Do the work for the macro `oset'.
|
||||
Fills in OBJ's SLOT with VALUE."
|
||||
(declare (compiler-macro eieio--check-slot-name))
|
||||
(cl-check-type slot symbol)
|
||||
(cond
|
||||
((cl-typep obj '(or eieio-object cl-structure-object))
|
||||
|
|
|
@ -31,6 +31,7 @@
|
|||
;; `:custom'.
|
||||
|
||||
(require 'eieio)
|
||||
(require 'eieio-base) ;; For `eieio-named's slot.
|
||||
(require 'widget)
|
||||
(require 'wid-edit)
|
||||
|
||||
|
|
|
@ -304,7 +304,7 @@ and reference them using the function `class-option'."
|
|||
;; but hide it so we don't trigger indefinitely.
|
||||
`(,(car whole) (identity ,(car slots))
|
||||
,@(cdr slots))
|
||||
nil nil (car slots))))
|
||||
'(obsolete eieio-constructor-name-arg) nil (car slots))))
|
||||
|
||||
;;; Get/Set slots in an object.
|
||||
;;
|
||||
|
@ -554,6 +554,7 @@ after they are created."
|
|||
Setting a slot's value makes it bound. Calling `slot-makeunbound' will
|
||||
make a slot unbound.
|
||||
OBJECT can be an instance or a class."
|
||||
(declare (compiler-macro eieio--check-slot-name))
|
||||
;; Skip typechecking while retrieving this value.
|
||||
(let ((eieio-skip-typecheck t))
|
||||
;; Return nil if the magic symbol is in there.
|
||||
|
@ -700,6 +701,20 @@ for each slot. For example:
|
|||
|
||||
(make-instance \\='foo :slot1 value1 :slotN valueN)")
|
||||
|
||||
(put 'make-instance 'compiler-macro
|
||||
(lambda (whole class &rest slots)
|
||||
(if (or (null slots) (keywordp (car slots))
|
||||
;; Detect the second pass!
|
||||
(eq 'identity (car-safe (car slots))))
|
||||
whole
|
||||
(macroexp-warn-and-return
|
||||
(format "Obsolete name arg %S to `make-instance'" (car slots))
|
||||
;; Keep the name arg, for backward compatibility,
|
||||
;; but hide it so we don't trigger indefinitely.
|
||||
`(,(car whole) ,class (identity ,(car slots))
|
||||
,@(cdr slots))
|
||||
'(obsolete eieio-constructor-name-arg) nil (car slots)))))
|
||||
|
||||
(define-obsolete-function-alias 'constructor #'make-instance "25.1")
|
||||
|
||||
(cl-defmethod make-instance
|
||||
|
|
|
@ -138,7 +138,7 @@
|
|||
(:AFTER eitest-B-base1)
|
||||
(:AFTER eitest-B)
|
||||
)))
|
||||
(eitest-F (eitest-B nil))
|
||||
(eitest-F (eitest-B))
|
||||
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
|
||||
(eieio-test-match ans)))
|
||||
|
||||
|
@ -153,7 +153,9 @@
|
|||
(ert-deftest eieio-test-method-order-list-4 ()
|
||||
;; Both of these situations should succeed.
|
||||
(should (eitest-H 'eitest-A))
|
||||
(should (eitest-H (eitest-A nil))))
|
||||
(let ((eieio-backward-compatibility t))
|
||||
(with-suppressed-warnings ((obsolete eieio-constructor-name-arg))
|
||||
(should (eitest-H (eitest-A nil))))))
|
||||
|
||||
;;; Return value from :PRIMARY
|
||||
;;
|
||||
|
@ -213,7 +215,7 @@
|
|||
(:STATIC C-base1)
|
||||
(:STATIC C-base2)
|
||||
)))
|
||||
(C nil)
|
||||
(C)
|
||||
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
|
||||
(eieio-test-match ans)))
|
||||
|
||||
|
@ -262,7 +264,7 @@
|
|||
(:PRIMARY D-base2)
|
||||
(:PRIMARY D-base0)
|
||||
)))
|
||||
(eitest-F (D nil))
|
||||
(eitest-F (D))
|
||||
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
|
||||
(eieio-test-match ans)))
|
||||
|
||||
|
@ -304,7 +306,7 @@
|
|||
(:PRIMARY E-base2)
|
||||
(:PRIMARY E-base0)
|
||||
)))
|
||||
(eitest-F (E nil))
|
||||
(eitest-F (E))
|
||||
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
|
||||
(eieio-test-match ans)))
|
||||
|
||||
|
|
|
@ -430,6 +430,9 @@ METHOD is the method that was attempting to be called."
|
|||
(defclass virtual-slot-class ()
|
||||
((base-value :initarg :base-value))
|
||||
"Class has real slot :base-value and simulated slot :derived-value.")
|
||||
|
||||
(eieio-declare-slots derived-value)
|
||||
|
||||
(with-suppressed-warnings ((obsolete defmethod)
|
||||
(obsolete defgeneric))
|
||||
(defmethod slot-missing ((vsc virtual-slot-class)
|
||||
|
|
|
@ -76,7 +76,6 @@
|
|||
(setq endpoint
|
||||
(make-instance
|
||||
'jsonrpc--test-client
|
||||
"Emacs RPC client"
|
||||
:process
|
||||
(open-network-stream "JSONRPC test tcp endpoint"
|
||||
nil "localhost"
|
||||
|
|
Loading…
Add table
Reference in a new issue