Update CEDET from upstream.
This commit is contained in:
Chong Yidong
parent
b3317662ac
commit
62a81506f8
115 changed files with 5693 additions and 1649 deletions
|
|
@ -4,7 +4,6 @@
|
|||
;;; Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
||||
;; Version: 0.2
|
||||
;; Keywords: OO, lisp
|
||||
;; Package: eieio
|
||||
|
||||
|
|
@ -225,8 +224,16 @@ a file. Optional argument NAME specifies a default file name."
|
|||
))))
|
||||
(oref this file))
|
||||
|
||||
(defun eieio-persistent-read (filename)
|
||||
"Read a persistent object from FILENAME, and return it."
|
||||
(defun eieio-persistent-read (filename &optional class allow-subclass)
|
||||
"Read a persistent object from FILENAME, and return it.
|
||||
Signal an error if the object in FILENAME is not a constructor
|
||||
for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
|
||||
`eieio-peristent-read' to load in subclasses of class instead of
|
||||
being pendantic."
|
||||
(unless class
|
||||
(message "Unsafe call to `eieio-persistent-read'."))
|
||||
(when (and class (not (class-p class)))
|
||||
(signal 'wrong-type-argument (list 'class-p class)))
|
||||
(let ((ret nil)
|
||||
(buffstr nil))
|
||||
(unwind-protect
|
||||
|
|
@ -239,13 +246,171 @@ a file. Optional argument NAME specifies a default file name."
|
|||
;; so that any initialize-instance calls that depend on
|
||||
;; the current buffer will work.
|
||||
(setq ret (read buffstr))
|
||||
(if (not (child-of-class-p (car ret) 'eieio-persistent))
|
||||
(error "Corrupt object on disk"))
|
||||
(setq ret (eval ret))
|
||||
(when (not (child-of-class-p (car ret) 'eieio-persistent))
|
||||
(error "Corrupt object on disk: Unknown saved object"))
|
||||
(when (and class
|
||||
(not (or (eq (car ret) class ) ; same class
|
||||
(and allow-subclass
|
||||
(child-of-class-p (car ret) class)) ; subclasses
|
||||
)))
|
||||
(error "Corrupt object on disk: Invalid saved class"))
|
||||
(setq ret (eieio-persistent-convert-list-to-object ret))
|
||||
(oset ret file filename))
|
||||
(kill-buffer " *tmp eieio read*"))
|
||||
ret))
|
||||
|
||||
(defun eieio-persistent-convert-list-to-object (inputlist)
|
||||
"Convert the INPUTLIST, representing object creation to an object.
|
||||
While it is possible to just `eval' the INPUTLIST, this code instead
|
||||
validates the existing list, and explicitly creates objects instead of
|
||||
calling eval. This avoids the possibility of accidentally running
|
||||
malicious code.
|
||||
|
||||
Note: This function recurses when a slot of :type of some object is
|
||||
identified, and needing more object creation."
|
||||
(let ((objclass (nth 0 inputlist))
|
||||
(objname (nth 1 inputlist))
|
||||
(slots (nthcdr 2 inputlist))
|
||||
(createslots nil))
|
||||
|
||||
;; If OBJCLASS is an eieio autoload object, then we need to load it.
|
||||
(eieio-class-un-autoload objclass)
|
||||
|
||||
(while slots
|
||||
(let ((name (car slots))
|
||||
(value (car (cdr slots))))
|
||||
|
||||
;; Make sure that the value proposed for SLOT is valid.
|
||||
;; In addition, strip out quotes, list functions, and update
|
||||
;; object constructors as needed.
|
||||
(setq value (eieio-persistent-validate/fix-slot-value
|
||||
objclass name value))
|
||||
|
||||
(push name createslots)
|
||||
(push value createslots)
|
||||
)
|
||||
|
||||
(setq slots (cdr (cdr slots))))
|
||||
|
||||
(apply 'make-instance objclass objname (nreverse createslots))
|
||||
|
||||
;;(eval inputlist)
|
||||
))
|
||||
|
||||
(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
|
||||
"Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
|
||||
A limited number of functions, such as quote, list, and valid object
|
||||
constructor functions are considered valid.
|
||||
Secondarilly, any text properties will be stripped from strings."
|
||||
(cond ((consp proposed-value)
|
||||
;; Lists with something in them need special treatment.
|
||||
(let ((slot-idx (eieio-slot-name-index class nil slot))
|
||||
(type nil)
|
||||
(classtype nil))
|
||||
(setq slot-idx (- slot-idx 3))
|
||||
(setq type (aref (aref (class-v class) class-public-type)
|
||||
slot-idx))
|
||||
|
||||
(setq classtype (eieio-persistent-slot-type-is-class-p
|
||||
type))
|
||||
|
||||
(cond ((eq (car proposed-value) 'quote)
|
||||
(car (cdr proposed-value)))
|
||||
|
||||
;; An empty list sometimes shows up as (list), which is dumb, but
|
||||
;; we need to support it for backward compat.
|
||||
((and (eq (car proposed-value) 'list)
|
||||
(= (length proposed-value) 1))
|
||||
nil)
|
||||
|
||||
;; We have a slot with a single object that can be
|
||||
;; saved here. Recurse and evaluate that
|
||||
;; sub-object.
|
||||
((and classtype (class-p classtype)
|
||||
(child-of-class-p (car proposed-value) classtype))
|
||||
(eieio-persistent-convert-list-to-object
|
||||
proposed-value))
|
||||
|
||||
;; List of object constructors.
|
||||
((and (eq (car proposed-value) 'list)
|
||||
;; 2nd item is a list.
|
||||
(consp (car (cdr proposed-value)))
|
||||
;; 1st elt of 2nd item is a class name.
|
||||
(class-p (car (car (cdr proposed-value))))
|
||||
)
|
||||
|
||||
;; Check the value against the input class type.
|
||||
;; If something goes wrong, issue a smart warning
|
||||
;; about how a :type is needed for this to work.
|
||||
(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))
|
||||
|
||||
;; We have a predicate, but it doesn't satisfy the predicate?
|
||||
(dolist (PV (cdr proposed-value))
|
||||
(unless (child-of-class-p (car PV) (car classtype))
|
||||
(error "Corrupt object on disk")))
|
||||
|
||||
;; We have a list of objects here. Lets load them
|
||||
;; in.
|
||||
(let ((objlist nil))
|
||||
(dolist (subobj (cdr proposed-value))
|
||||
(push (eieio-persistent-convert-list-to-object subobj)
|
||||
objlist))
|
||||
;; return the list of objects ... reversed.
|
||||
(nreverse objlist)))
|
||||
(t
|
||||
proposed-value))))
|
||||
|
||||
((stringp proposed-value)
|
||||
;; Else, check for strings, remove properties.
|
||||
(substring-no-properties proposed-value))
|
||||
|
||||
(t
|
||||
;; Else, just return whatever the constant was.
|
||||
proposed-value))
|
||||
)
|
||||
|
||||
(defun eieio-persistent-slot-type-is-class-p (type)
|
||||
"Return the class refered 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))
|
||||
(class-p (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.
|
||||
(intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0))))
|
||||
|
||||
((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
|
||||
;; 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))
|
||||
;; If type is a list, and is an or, it is possibly something
|
||||
;; like (or null myclass), so check for that.
|
||||
(let ((ans nil))
|
||||
(dolist (subtype (cdr type))
|
||||
(setq ans (eieio-persistent-slot-type-is-class-p
|
||||
subtype)))
|
||||
ans))
|
||||
|
||||
(t
|
||||
;; No match, not a class.
|
||||
nil)))
|
||||
|
||||
(defmethod object-write ((this eieio-persistent) &optional comment)
|
||||
"Write persistent object THIS out to the current stream.
|
||||
Optional argument COMMENT is a header line comment."
|
||||
|
|
|
|||
|
|
@ -332,6 +332,16 @@ Argument OBJ is the object that has been customized."
|
|||
Optional argument GROUP is the sub-group of slots to display."
|
||||
(eieio-customize-object obj group))
|
||||
|
||||
(defvar eieio-custom-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map widget-keymap)
|
||||
map)
|
||||
"Keymap for EIEIO Custom mode")
|
||||
|
||||
(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom"
|
||||
"Major mode for customizing EIEIO objects.
|
||||
\\{eieio-custom-mode-map}")
|
||||
|
||||
(defmethod eieio-customize-object ((obj eieio-default-superclass)
|
||||
&optional group)
|
||||
"Customize OBJ in a specialized custom buffer.
|
||||
|
|
@ -347,6 +357,7 @@ These groups are specified with the `:group' slot flag."
|
|||
(symbol-name g) "*")))
|
||||
(setq buffer-read-only nil)
|
||||
(kill-all-local-variables)
|
||||
(eieio-custom-mode)
|
||||
(erase-buffer)
|
||||
(let ((all (overlay-lists)))
|
||||
;; Delete all the overlays.
|
||||
|
|
@ -363,7 +374,6 @@ These groups are specified with the `:group' slot flag."
|
|||
(widget-insert "\n")
|
||||
(eieio-custom-object-apply-reset obj)
|
||||
;; Now initialize the buffer
|
||||
(use-local-map widget-keymap)
|
||||
(widget-setup)
|
||||
;;(widget-minor-mode)
|
||||
(goto-char (point-min))
|
||||
|
|
@ -461,8 +471,4 @@ Return the symbol for the group, or nil"
|
|||
|
||||
(provide 'eieio-custom)
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "eieio.el"
|
||||
;; End:
|
||||
|
||||
;;; eieio-custom.el ends here
|
||||
|
|
|
|||
|
|
@ -92,12 +92,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
|
|||
"Class: ")
|
||||
;; Loop over all the public slots
|
||||
(let ((publa (aref cv class-public-a))
|
||||
(publd (aref cv class-public-d))
|
||||
)
|
||||
(while publa
|
||||
(if (slot-boundp obj (car publa))
|
||||
(let ((i (class-slot-initarg cl (car publa)))
|
||||
(v (eieio-oref obj (car publa))))
|
||||
(let* ((i (class-slot-initarg cl (car publa)))
|
||||
(v (eieio-oref obj (car publa))))
|
||||
(data-debug-insert-thing
|
||||
v prefix (concat
|
||||
(if i (symbol-name i)
|
||||
|
|
@ -112,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
|
|||
" ")
|
||||
'font-lock-keyword-face))
|
||||
)
|
||||
(setq publa (cdr publa) publd (cdr publd))))))
|
||||
(setq publa (cdr publa))))))
|
||||
|
||||
;;; Augment the Data debug thing display list.
|
||||
(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
;; Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
||||
;; Version: 0.2
|
||||
;; Keywords: OO, lisp
|
||||
;; Package: eieio
|
||||
|
||||
|
|
@ -30,6 +29,9 @@
|
|||
;;
|
||||
|
||||
(require 'eieio)
|
||||
(require 'button)
|
||||
(require 'help-mode)
|
||||
(require 'find-func)
|
||||
|
||||
;;; Code:
|
||||
;;;###autoload
|
||||
|
|
@ -85,11 +87,16 @@ Optional HEADERFCN should be called to insert a few bits of info first."
|
|||
(called-interactively-p 'interactive))
|
||||
|
||||
(when headerfcn (funcall headerfcn))
|
||||
|
||||
(if (class-option class :abstract)
|
||||
(princ "Abstract "))
|
||||
(princ "Class ")
|
||||
(prin1 class)
|
||||
(princ " is a")
|
||||
(if (class-option class :abstract)
|
||||
(princ "n abstract"))
|
||||
(princ " class")
|
||||
;; Print file location
|
||||
(when (get class 'class-location)
|
||||
(princ " in `")
|
||||
(princ (file-name-nondirectory (get class 'class-location)))
|
||||
(princ "'"))
|
||||
(terpri)
|
||||
;; Inheritance tree information
|
||||
(let ((pl (class-parents class)))
|
||||
|
|
@ -251,8 +258,13 @@ Uses `eieio-describe-class' to describe the class being constructed."
|
|||
(eieio-describe-class
|
||||
fcn (lambda ()
|
||||
;; Describe the constructor part.
|
||||
(princ "Object Constructor Function: ")
|
||||
(prin1 fcn)
|
||||
(princ " is an object constructor function")
|
||||
;; Print file location
|
||||
(when (get fcn 'class-location)
|
||||
(princ " in `")
|
||||
(princ (file-name-nondirectory (get fcn 'class-location)))
|
||||
(princ "'"))
|
||||
(terpri)
|
||||
(princ "Creates an object of class ")
|
||||
(prin1 fcn)
|
||||
|
|
@ -262,6 +274,16 @@ Uses `eieio-describe-class' to describe the class being constructed."
|
|||
))
|
||||
)
|
||||
|
||||
(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)))
|
||||
(class-children-fast class)))
|
||||
(list class)))
|
||||
|
||||
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
|
||||
"Return an alist of all currently active classes for completion purposes.
|
||||
Optional argument CLASS is the class to start with.
|
||||
|
|
@ -270,8 +292,9 @@ are not abstract, otherwise allow all classes.
|
|||
Optional argument BUILDLIST is more list to attach and is used internally."
|
||||
(let* ((cc (or class eieio-default-superclass))
|
||||
(sublst (aref (class-v cc) class-children)))
|
||||
(if (or (not instantiable-only) (not (class-abstract-p cc)))
|
||||
(setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))
|
||||
(unless (assoc (symbol-name cc) buildlist)
|
||||
(when (or (not instantiable-only) (not (class-abstract-p cc)))
|
||||
(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
|
||||
(while sublst
|
||||
(setq buildlist (eieio-build-class-alist
|
||||
(car sublst) instantiable-only buildlist))
|
||||
|
|
@ -342,10 +365,10 @@ Also extracts information about all methods specific to this generic."
|
|||
(princ "Implementations:")
|
||||
(terpri)
|
||||
(terpri)
|
||||
(let ((i 3)
|
||||
(let ((i 4)
|
||||
(prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
|
||||
;; Loop over fanciful generics
|
||||
(while (< i 6)
|
||||
(while (< i 7)
|
||||
(let ((gm (aref (get generic 'eieio-method-tree) i)))
|
||||
(when gm
|
||||
(princ "Generic ")
|
||||
|
|
@ -357,8 +380,9 @@ Also extracts information about all methods specific to this generic."
|
|||
(setq i (1+ i)))
|
||||
(setq i 0)
|
||||
;; Loop over defined class-specific methods
|
||||
(while (< i 3)
|
||||
(let ((gm (reverse (aref (get generic 'eieio-method-tree) i))))
|
||||
(while (< i 4)
|
||||
(let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
|
||||
location)
|
||||
(while gm
|
||||
(princ "`")
|
||||
(prin1 (car (car gm)))
|
||||
|
|
@ -375,6 +399,13 @@ Also extracts information about all methods specific to this generic."
|
|||
;; 3 because of cdr
|
||||
(princ (or (documentation (cdr (car gm)))
|
||||
"Undocumented"))
|
||||
;; Print file location if available
|
||||
(when (and (setq location (get generic 'method-locations))
|
||||
(setq location (assoc (caar gm) location)))
|
||||
(setq location (cadr location))
|
||||
(princ "\n\nDefined in `")
|
||||
(princ (file-name-nondirectory location))
|
||||
(princ "'\n"))
|
||||
(setq gm (cdr gm))
|
||||
(terpri)
|
||||
(terpri)))
|
||||
|
|
@ -554,7 +585,65 @@ Optional argument HISTORYVAR is the variable to use as history."
|
|||
|
||||
;;; HELP AUGMENTATION
|
||||
;;
|
||||
;;;###autoload
|
||||
(define-button-type 'eieio-method-def
|
||||
:supertype 'help-xref
|
||||
'help-function (lambda (class method file)
|
||||
(eieio-help-find-method-definition class method file))
|
||||
'help-echo (purecopy "mouse-2, RET: find method's definition"))
|
||||
|
||||
(define-button-type 'eieio-class-def
|
||||
:supertype 'help-xref
|
||||
'help-function (lambda (class file)
|
||||
(eieio-help-find-class-definition class file))
|
||||
'help-echo (purecopy "mouse-2, RET: find class definition"))
|
||||
|
||||
(defun eieio-help-find-method-definition (class method file)
|
||||
(let ((filename (find-library-name file))
|
||||
location buf)
|
||||
(when (null filename)
|
||||
(error "Cannot find library %s" file))
|
||||
(setq buf (find-file-noselect filename))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(when
|
||||
(re-search-forward
|
||||
;; Regexp for searching methods.
|
||||
(concat "(defmethod[ \t\r\n]+" method
|
||||
"\\([ \t\r\n]+:[a-zA-Z]+\\)?"
|
||||
"[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
|
||||
class
|
||||
"\\s-*)")
|
||||
nil t)
|
||||
(setq location (match-beginning 0))))
|
||||
(if (null location)
|
||||
(message "Unable to find location in file")
|
||||
(pop-to-buffer buf)
|
||||
(goto-char location)
|
||||
(recenter)
|
||||
(beginning-of-line))))
|
||||
|
||||
(defun eieio-help-find-class-definition (class file)
|
||||
(let ((filename (find-library-name file))
|
||||
location buf)
|
||||
(when (null filename)
|
||||
(error "Cannot find library %s" file))
|
||||
(setq buf (find-file-noselect filename))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(when
|
||||
(re-search-forward
|
||||
;; Regexp for searching a class.
|
||||
(concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
|
||||
nil t)
|
||||
(setq location (match-beginning 0))))
|
||||
(if (null location)
|
||||
(message "Unable to find location in file")
|
||||
(pop-to-buffer buf)
|
||||
(goto-char location)
|
||||
(recenter)
|
||||
(beginning-of-line))))
|
||||
|
||||
|
||||
(defun eieio-help-mode-augmentation-maybee (&rest unused)
|
||||
"For buffers thrown into help mode, augment for EIEIO.
|
||||
Arguments UNUSED are not used."
|
||||
|
|
@ -597,6 +686,26 @@ Arguments UNUSED are not used."
|
|||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
((looking-at "\\(.+\\) is a generic function")
|
||||
(let ((mname (match-string 1))
|
||||
cname)
|
||||
(while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
|
||||
(setq cname (match-string-no-properties 1))
|
||||
(help-xref-button 2 'eieio-method-def cname
|
||||
mname
|
||||
(cadr (assoc (intern cname)
|
||||
(get (intern mname)
|
||||
'method-locations)))))))
|
||||
((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
|
||||
(let ((cname (match-string-no-properties 1)))
|
||||
(help-xref-button 2 'eieio-class-def cname
|
||||
(get (intern cname) 'class-location))))
|
||||
((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
|
||||
(let ((cname (match-string-no-properties 1)))
|
||||
(help-xref-button 3 'eieio-class-def cname
|
||||
(get (intern cname) 'class-location)))))
|
||||
))))
|
||||
|
||||
;;; SPEEDBAR SUPPORT
|
||||
|
|
@ -698,8 +807,4 @@ INDENT is the current indentation level."
|
|||
|
||||
(provide 'eieio-opt)
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "eieio.el"
|
||||
;; End:
|
||||
|
||||
;;; eieio-opt.el ends here
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
;; Copyright (C) 1999-2002, 2005, 2007-2012 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
||||
;; Version: 0.2
|
||||
;; Keywords: OO, tools
|
||||
;; Package: eieio
|
||||
|
||||
|
|
@ -191,23 +190,24 @@ that path."
|
|||
|
||||
;;; DEFAULT SUPERCLASS baseline methods
|
||||
;;
|
||||
;; First, define methods onto the superclass so all classes
|
||||
;; will have some minor support.
|
||||
;; First, define methods with no class defined. These will work as if
|
||||
;; on the default superclass. Specifying no class will allow these to be used
|
||||
;; when no other methods are found, allowing multiple inheritance to work
|
||||
;; reliably with eieio-speedbar.
|
||||
|
||||
(defmethod eieio-speedbar-description ((object eieio-default-superclass))
|
||||
(defmethod eieio-speedbar-description (object)
|
||||
"Return a string describing OBJECT."
|
||||
(object-name-string object))
|
||||
|
||||
(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass))
|
||||
(defmethod eieio-speedbar-derive-line-path (object)
|
||||
"Return the path which OBJECT has something to do with."
|
||||
nil)
|
||||
|
||||
(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass))
|
||||
(defmethod eieio-speedbar-object-buttonname (object)
|
||||
"Return a string to use as a speedbar button for OBJECT."
|
||||
(object-name-string object))
|
||||
|
||||
(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass)
|
||||
depth)
|
||||
(defmethod eieio-speedbar-make-tag-line (object depth)
|
||||
"Insert a tag line into speedbar at point for OBJECT.
|
||||
By default, all objects appear as simple TAGS with no need to inherit from
|
||||
the special `eieio-speedbar' classes. Child classes should redefine this
|
||||
|
|
@ -220,7 +220,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
|
|||
'speedbar-tag-face
|
||||
depth))
|
||||
|
||||
(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass))
|
||||
(defmethod eieio-speedbar-handle-click (object)
|
||||
"Handle a click action on OBJECT in speedbar.
|
||||
Any object can be represented as a tag in SPEEDBAR without special
|
||||
attributes. These default objects will be pulled up in a custom
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
;; Copyright (C) 1995-1996, 1998-2012 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
||||
;; Version: 1.3
|
||||
;; Keywords: OO, lisp
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -94,21 +93,6 @@ default setting for optimization purposes.")
|
|||
(defvar eieio-optimize-primary-methods-flag t
|
||||
"Non-nil means to optimize the method dispatch on primary methods.")
|
||||
|
||||
;; State Variables
|
||||
;; FIXME: These two constants below should have an `eieio-' prefix added!!
|
||||
(defvar this nil
|
||||
"Inside a method, this variable is the object in question.
|
||||
DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots.
|
||||
|
||||
Note: Embedded methods are no longer supported. The variable THIS is
|
||||
still set for CLOS methods for the sake of routines like
|
||||
`call-next-method'.")
|
||||
|
||||
(defvar scoped-class nil
|
||||
"This is set to a class when a method is running.
|
||||
This is so we know we are allowed to check private parts or how to
|
||||
execute a `call-next-method'. DO NOT SET THIS YOURSELF!")
|
||||
|
||||
(defvar eieio-initializing-object nil
|
||||
"Set to non-nil while initializing an object.")
|
||||
|
||||
|
|
@ -410,6 +394,7 @@ It creates an autoload function for CNAME's constructor."
|
|||
(autoload cname filename doc nil nil)
|
||||
(autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
|
||||
(autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
|
||||
(autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
|
||||
|
||||
))))
|
||||
|
||||
|
|
@ -539,6 +524,23 @@ See `defclass' for more information."
|
|||
(and (eieio-object-p obj)
|
||||
(object-of-class-p obj ,cname))))
|
||||
|
||||
;; 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 using typep, (typep OBJ 'myclass) returns t for objects which
|
||||
;; are subclasses of myclass. For our predicates, however, it is
|
||||
;; important for EIEIO to be backwards compatible, where
|
||||
|
|
@ -781,6 +783,16 @@ See `defclass' for more information."
|
|||
(put cname 'variable-documentation
|
||||
(class-option-assoc options :documentation))
|
||||
|
||||
;; Save the file location where this class is defined.
|
||||
(let ((fname (if load-in-progress
|
||||
load-file-name
|
||||
buffer-file-name))
|
||||
loc)
|
||||
(when fname
|
||||
(when (string-match "\\.elc$" fname)
|
||||
(setq fname (substring fname 0 (1- (length fname)))))
|
||||
(put cname 'class-location fname)))
|
||||
|
||||
;; We have a list of custom groups. Store them into the options.
|
||||
(let ((g (class-option-assoc options :custom-groups)))
|
||||
(mapc (lambda (cg) (add-to-list 'g cg)) groups)
|
||||
|
|
@ -1254,8 +1266,10 @@ IMPL is the symbol holding the method implementation."
|
|||
(eieio-generic-call-methodname ',method)
|
||||
(eieio-generic-call-arglst local-args)
|
||||
)
|
||||
(apply #',impl local-args)
|
||||
;;(,impl local-args)
|
||||
,(if (< emacs-major-version 24)
|
||||
`(apply ,(list 'quote impl) local-args)
|
||||
`(apply #',impl local-args))
|
||||
;(,impl local-args)
|
||||
)))))))
|
||||
|
||||
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
|
||||
|
|
@ -2008,13 +2022,13 @@ reverse-lookup that name, and recurse with the associated slot value."
|
|||
((not (get fsym 'protection))
|
||||
(+ 3 fsi))
|
||||
((and (eq (get fsym 'protection) 'protected)
|
||||
scoped-class
|
||||
(bound-and-true-p scoped-class)
|
||||
(or (child-of-class-p class scoped-class)
|
||||
(and (eieio-object-p obj)
|
||||
(child-of-class-p class (object-class obj)))))
|
||||
(+ 3 fsi))
|
||||
((and (eq (get fsym 'protection) 'private)
|
||||
(or (and scoped-class
|
||||
(or (and (bound-and-true-p scoped-class)
|
||||
(eieio-slot-originating-class-p scoped-class slot))
|
||||
eieio-initializing-object))
|
||||
(+ 3 fsi))
|
||||
|
|
@ -2319,7 +2333,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
|
|||
arguments passed in at the top level.
|
||||
|
||||
Use `next-method-p' to find out if there is a next method to call."
|
||||
(if (not scoped-class)
|
||||
(if (not (bound-and-true-p scoped-class))
|
||||
(error "`call-next-method' not called within a class specific method"))
|
||||
(if (and (/= eieio-generic-call-key method-primary)
|
||||
(/= eieio-generic-call-key method-static))
|
||||
|
|
@ -2403,6 +2417,18 @@ CLASS is the class this method is associated with."
|
|||
(if (< key method-num-lists)
|
||||
(let ((nsym (intern (symbol-name class) (aref emto key))))
|
||||
(fset nsym method)))
|
||||
;; Save the defmethod file location in a symbol property.
|
||||
(let ((fname (if load-in-progress
|
||||
load-file-name
|
||||
buffer-file-name))
|
||||
loc)
|
||||
(when fname
|
||||
(when (string-match "\\.elc$" fname)
|
||||
(setq fname (substring fname 0 (1- (length fname)))))
|
||||
(setq loc (get method-name 'method-locations))
|
||||
(add-to-list 'loc
|
||||
(list class fname))
|
||||
(put method-name 'method-locations loc)))
|
||||
;; Now optimize the entire obarray
|
||||
(if (< key method-num-lists)
|
||||
(let ((eieiomt-optimizing-obarray (aref emto key)))
|
||||
|
|
@ -2807,9 +2833,9 @@ this object."
|
|||
(princ (make-string (* eieio-print-depth 2) ? ))
|
||||
(princ "(")
|
||||
(princ (symbol-name (class-constructor (object-class this))))
|
||||
(princ " \"")
|
||||
(princ (object-name-string this))
|
||||
(princ "\"\n")
|
||||
(princ " ")
|
||||
(prin1 (object-name-string this))
|
||||
(princ "\n")
|
||||
;; Loop over all the public slots
|
||||
(let ((publa (aref cv class-public-a))
|
||||
(publd (aref cv class-public-d))
|
||||
|
|
@ -2876,7 +2902,6 @@ of `eq'."
|
|||
|
||||
)
|
||||
|
||||
|
||||
;;; Obsolete backward compatibility functions.
|
||||
;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue