Update copyright year to 2015

[gnu-emacs] / lisp / emacs-lisp / eieio.el

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index fc5da3198f9042ff05cc23f99b188ead419fa973..d87841cd4d09680d1ef001f819433a0a11b12102 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1,7 +1,7 @@
-;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
+;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects  -*- lexical-binding:t -*-

 ;;;              or maybe Eric's Implementation of Emacs Interpreted Objects
 
 ;;;              or maybe Eric's Implementation of Emacs Interpreted Objects
 

-;; Copyright (C) 1995-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.

 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 1.4
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 1.4


@@ -44,8 +44,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))       ;FIXME: Use cl-lib!
-

 (defvar eieio-version "1.4"
   "Current version of EIEIO.")
 
 (defvar eieio-version "1.4"
   "Current version of EIEIO.")
 


@@ -115,6 +113,7 @@ Options in CLOS not supported in EIEIO:
 
 Due to the way class options are set up, you can add any tags you wish,
 and reference them using the function `class-option'."
 
 Due to the way class options are set up, you can add any tags you wish,
 and reference them using the function `class-option'."

+  (declare (doc-string 4))

   ;; This is eval-and-compile only to silence spurious compiler warnings
   ;; about functions and variables not known to be defined.
   ;; When eieio-defclass code is merged here and this becomes
   ;; This is eval-and-compile only to silence spurious compiler warnings
   ;; about functions and variables not known to be defined.
   ;; When eieio-defclass code is merged here and this becomes


@@ -155,7 +154,7 @@ a string."
 \f
 ;;; CLOS methods and generics
 ;;
 \f
 ;;; CLOS methods and generics
 ;;

-(defmacro defgeneric (method args &optional doc-string)
+(defmacro defgeneric (method _args &optional doc-string)

   "Create a generic function METHOD.
 DOC-STRING is the base documentation for this class.  A generic
 function has no body, as its purpose is to decide which method body
   "Create a generic function METHOD.
 DOC-STRING is the base documentation for this class.  A generic
 function has no body, as its purpose is to decide which method body


@@ -163,6 +162,7 @@ is appropriate to use.  Uses `defmethod' to create methods, and calls
 `defgeneric' for you.  With this implementation the ARGS are
 currently ignored.  You can use `defgeneric' to apply specialized
 top level documentation to a method."
 `defgeneric' for you.  With this implementation the ARGS are
 currently ignored.  You can use `defgeneric' to apply specialized
 top level documentation to a method."

+  (declare (doc-string 3))

   `(eieio--defalias ',method
                     (eieio--defgeneric-init-form ',method ,doc-string)))
 
   `(eieio--defalias ',method
                     (eieio--defgeneric-init-form ',method ,doc-string)))
 


@@ -191,6 +191,7 @@ Summary:
                      ((typearg class-name) arg2 &optional opt &rest rest)
     \"doc-string\"
      body)"
                      ((typearg class-name) arg2 &optional opt &rest rest)
     \"doc-string\"
      body)"

+  (declare (doc-string 3))

   (let* ((key (if (keywordp (car args)) (pop args)))
         (params (car args))
         (arg1 (car params))
   (let* ((key (if (keywordp (car args)) (pop args)))
         (params (car args))
         (arg1 (car params))


@@ -246,13 +247,14 @@ Where each VAR is the local variable given to the associated
 SLOT.  A slot specified without a variable name is given a
 variable name of the same name as the slot."
   (declare (indent 2))
 SLOT.  A slot specified without a variable name is given a
 variable name of the same name as the slot."
   (declare (indent 2))

-  ;; Transform the spec-list into a symbol-macrolet spec-list.
+  (require 'cl-lib)
+  ;; Transform the spec-list into a cl-symbol-macrolet spec-list.

   (let ((mappings (mapcar (lambda (entry)
                            (let ((var  (if (listp entry) (car entry) entry))
                                  (slot (if (listp entry) (cadr entry) entry)))
                              (list var `(slot-value ,object ',slot))))
                          spec-list)))
   (let ((mappings (mapcar (lambda (entry)
                            (let ((var  (if (listp entry) (car entry) entry))
                                  (slot (if (listp entry) (cadr entry) entry)))
                              (list var `(slot-value ,object ',slot))))
                          spec-list)))

-    (append (list 'symbol-macrolet mappings)
+    (append (list 'cl-symbol-macrolet mappings)

            body)))
 \f
 ;;; Simple generators, and query functions.  None of these would do
            body)))
 \f
 ;;; Simple generators, and query functions.  None of these would do


@@ -322,7 +324,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
 (defmacro eieio-class-parent (class)
   "Return first parent class to CLASS.  (overload of variable)."
   `(car (eieio-class-parents ,class)))
 (defmacro eieio-class-parent (class)
   "Return first parent class to CLASS.  (overload of variable)."
   `(car (eieio-class-parents ,class)))

-(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4")
+(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."
   (eieio--check-type class-p class)


@@ -523,7 +525,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 (or (not next) (not (car next)))
        (next (car eieio-generic-call-next-method-list))
        )
     (if (or (not next) (not (car next)))

-       (apply 'no-next-method (car newargs) (cdr newargs))
+       (apply #'no-next-method (car newargs) (cdr newargs))

       (let* ((eieio-generic-call-next-method-list
              (cdr eieio-generic-call-next-method-list))
             (eieio-generic-call-arglst newargs)
       (let* ((eieio-generic-call-next-method-list
              (cdr eieio-generic-call-next-method-list))
             (eieio-generic-call-arglst newargs)


@@ -535,27 +537,7 @@ Use `next-method-p' to find out if there is a next method to call."
 ;;; Here are some CLOS items that need the CL package
 ;;
 
 ;;; Here are some CLOS items that need the CL package
 ;;
 

-(defsetf eieio-oref eieio-oset)
-
-(if (eval-when-compile (fboundp 'gv-define-expander))
-    ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
-    ;; follows aliases.
-    nil
-(defsetf slot-value eieio-oset)
-
-;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
-(define-setf-method oref (obj slot)
-  (with-no-warnings
-    (require 'cl)
-    (let ((obj-temp (gensym))
-         (slot-temp (gensym))
-         (store-temp (gensym)))
-      (list (list obj-temp slot-temp)
-           (list obj `(quote ,slot))
-           (list store-temp)
-           (list 'set-slot-value obj-temp slot-temp
-                 store-temp)
-           (list 'slot-value obj-temp slot-temp))))))
+(gv-define-simple-setter eieio-oref eieio-oset)

 
 \f
 ;;;
 
 \f
 ;;;


@@ -651,7 +633,7 @@ dynamically set from SLOTS."
   "Method invoked when an attempt to access a slot in OBJECT fails.")
 
 (defmethod slot-missing ((object eieio-default-superclass) slot-name
   "Method invoked when an attempt to access a slot in OBJECT fails.")
 
 (defmethod slot-missing ((object eieio-default-superclass) slot-name

-                        operation &optional new-value)
+                        _operation &optional _new-value)

   "Method invoked when an attempt to access a slot in OBJECT fails.
 SLOT-NAME is the name of the failed slot, OPERATION is the type of access
 that was requested, and optional NEW-VALUE is the value that was desired
   "Method invoked when an attempt to access a slot in OBJECT fails.
 SLOT-NAME is the name of the failed slot, OPERATION is the type of access
 that was requested, and optional NEW-VALUE is the value that was desired


@@ -684,7 +666,7 @@ EIEIO can only dispatch on the first argument, so the first two are swapped."
   "Called if there are no implementations for OBJECT in METHOD.")
 
 (defmethod no-applicable-method ((object eieio-default-superclass)
   "Called if there are no implementations for OBJECT in METHOD.")
 
 (defmethod no-applicable-method ((object eieio-default-superclass)

-                                method &rest args)
+                                method &rest _args)

   "Called if there are no implementations for OBJECT in METHOD.
 OBJECT is the object which has no method implementation.
 ARGS are the arguments that were passed to METHOD.
   "Called if there are no implementations for OBJECT in METHOD.
 OBJECT is the object which has no method implementation.
 ARGS are the arguments that were passed to METHOD.


@@ -734,7 +716,7 @@ first and modify the returned object.")
 (defgeneric destructor (this &rest params)
   "Destructor for cleaning up any dynamic links to our object.")
 
 (defgeneric destructor (this &rest params)
   "Destructor for cleaning up any dynamic links to our object.")
 

-(defmethod destructor ((this eieio-default-superclass) &rest params)
+(defmethod destructor ((_this eieio-default-superclass) &rest _params)

   "Destructor for cleaning up any dynamic links to our object.
 Argument THIS is the object being destroyed.  PARAMS are additional
 ignored parameters."
   "Destructor for cleaning up any dynamic links to our object.
 Argument THIS is the object being destroyed.  PARAMS are additional
 ignored parameters."


@@ -760,7 +742,7 @@ Implement this function and specify STRINGS in a call to
 `call-next-method' to provide additional summary information.
 When passing in extra strings from child classes, always remember
 to prepend a space."
 `call-next-method' to provide additional summary information.
 When passing in extra strings from child classes, always remember
 to prepend a space."

-  (eieio-object-name this (apply 'concat strings)))
+  (eieio-object-name this (apply #'concat strings)))

 
 (defvar eieio-print-depth 0
   "When printing, keep track of the current indentation depth.")
 
 (defvar eieio-print-depth 0
   "When printing, keep track of the current indentation depth.")


@@ -859,24 +841,31 @@ this object."
 \f
 ;;; Unimplemented functions from CLOS
 ;;
 \f
 ;;; Unimplemented functions from CLOS
 ;;

-(defun change-class (obj class)
+(defun change-class (_obj _class)

   "Change the class of OBJ to type CLASS.
 This may create or delete slots, but does not affect the return value
 of `eq'."
   (error "EIEIO: `change-class' is unimplemented"))
 
   "Change the class of OBJ to type CLASS.
 This may create or delete slots, but does not affect the return value
 of `eq'."
   (error "EIEIO: `change-class' is unimplemented"))
 

+;; Hook ourselves into help system for describing classes and methods.
+(add-hook 'help-fns-describe-function-functions 'eieio-help-generic)
+(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
+

 ;;; Interfacing with edebug
 ;;
 ;;; Interfacing with edebug
 ;;

-(defun eieio-edebug-prin1-to-string (object &optional noescape)
+(defun eieio-edebug-prin1-to-string (print-function object &optional noescape)

   "Display EIEIO OBJECT in fancy format.
   "Display EIEIO OBJECT in fancy format.

-Overrides the edebug default.
-Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
+
+Used as advice around `edebug-prin1-to-string', held in the
+variable PRINT-FUNCTION.  Optional argument NOESCAPE is passed to
+`prin1-to-string' when appropriate."

   (cond ((class-p object) (eieio-class-name object))
        ((eieio-object-p object) (object-print object))
        ((and (listp object) (or (class-p (car object))
                                 (eieio-object-p (car object))))
   (cond ((class-p object) (eieio-class-name object))
        ((eieio-object-p object) (object-print object))
        ((and (listp object) (or (class-p (car object))
                                 (eieio-object-p (car object))))

-        (concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")"))
-       (t (prin1-to-string object noescape))))
+        (concat "(" (mapconcat #'eieio-edebug-prin1-to-string object " ")
+                 ")"))
+       (t (funcall print-function object noescape))))

 
 (add-hook 'edebug-setup-hook
          (lambda ()
 
 (add-hook 'edebug-setup-hook
          (lambda ()


@@ -900,23 +889,13 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
            (def-edebug-spec class-constructor form)
            (def-edebug-spec generic-p form)
            (def-edebug-spec with-slots (list list def-body))
            (def-edebug-spec class-constructor form)
            (def-edebug-spec generic-p form)
            (def-edebug-spec with-slots (list list def-body))

-           ;; I suspect this isn't the best way to do this, but when
-           ;; cust-print was used on my system all my objects
-           ;; appeared as "#1 =" which was not useful.  This allows
-           ;; edebug to print my objects in the nice way they were
-           ;; meant to with `object-print' and `class-name'
-           ;; (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string)
-           )
-         )
-
-;;; Autoloading some external symbols, and hooking into the help system
-;;
+           (advice-add 'edebug-prin1-to-string
+                       :around #'eieio-edebug-prin1-to-string)))

 
 \f
 ;;; Start of automatically extracted autoloads.
 \f
 
 \f
 ;;; Start of automatically extracted autoloads.
 \f

-;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;;  "928623502e8bf40454822355388542b5")
+;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "ab711689b2bae8a7d8c4b1e99c892306")

 ;;; Generated autoloads from eieio-custom.el
 
 (autoload 'customize-object "eieio-custom" "\
 ;;; Generated autoloads from eieio-custom.el
 
 (autoload 'customize-object "eieio-custom" "\


@@ -927,9 +906,7 @@ Optional argument GROUP is the sub-group of slots to display.
 
 ;;;***
 \f
 
 ;;;***
 \f

-;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
-;;;;;;  eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;;  "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "889c0a935dddf758dbb65488470ffa06")

 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\


@@ -938,33 +915,22 @@ If optional ROOT-CLASS, then start with that, otherwise start with
 variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)
 variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)

-(defalias 'describe-class 'eieio-describe-class)

 
 

-(autoload 'eieio-describe-class "eieio-opt" "\
-Describe a CLASS defined by a string or symbol.
+(autoload 'eieio-help-class "eieio-opt" "\
+Print help description for CLASS.

 If CLASS is actually an object, then also display current values of that object.
 If CLASS is actually an object, then also display current values of that object.

-Optional HEADERFCN should be called to insert a few bits of info first.
-
-\(fn CLASS &optional HEADERFCN)" t nil)
-
-(autoload 'eieio-describe-constructor "eieio-opt" "\
-Describe the constructor function FCN.
-Uses `eieio-describe-class' to describe the class being constructed.

 
 

-\(fn FCN)" t nil)
-(defalias 'describe-generic 'eieio-describe-generic)
+\(fn CLASS)" nil nil)

 
 

-(autoload 'eieio-describe-generic "eieio-opt" "\
-Describe the generic function GENERIC.
-Also extracts information about all methods specific to this generic.
+(autoload 'eieio-help-constructor "eieio-opt" "\
+Describe CTR if it is a class constructor.

 
 

-\(fn GENERIC)" t nil)
+\(fn CTR)" nil nil)

 
 

-(autoload 'eieio-help-mode-augmentation-maybee "eieio-opt" "\
-For buffers thrown into help mode, augment for EIEIO.
-Arguments UNUSED are not used.
+(autoload 'eieio-help-generic "eieio-opt" "\
+Describe GENERIC if it is a generic function.

 
 

-\(fn &rest UNUSED)" nil nil)
+\(fn GENERIC)" nil nil)

 
 ;;;***
 \f
 
 ;;;***
 \f