pjb-object.el

;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;******************************************************************************
;;;;FILE:               pjb-object.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             emacs
;;;;USER-INTERFACE:     emacs
;;;;DESCRIPTION
;;;;
;;;;    This is a root class for my classes.
;;;;    The main purpose is to implement here compatibility stuff.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;;    2002-09-08 <PJB> Creation.
;;;;BUGS
;;;;LEGAL
;;;;    LGPL
;;;;
;;;;    Copyright Pascal J. Bourguignon 2002 - 2011
;;;;
;;;;    This library is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU Lesser General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    This library is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;;    Lesser General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Lesser General Public
;;;;    License along with this library; if not, write to the Free Software
;;;;    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
;;;;
;;;;******************************************************************************
(require 'pjb-cl)
(require 'eieio)

(provide 'pjb-object)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(put 'make-instance 'lisp-indent-function 2)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PjbObject

(defclass PjbObject nil
  (;;attributes
   (object-id
    :initform nil
    :initarg  :object-id
    :accessor object-id
    :type (or null string)
    :documentation
    "The id of this object (eieio has it in its internals, but not CLOS).")
   );;end attributes
  (:documentation
   "This is a root class for my classes.
    The main purpose is to implement here compatibility stuff.")
  );;PjbObject



(defmacro defmethod* (name &rest things)
  "In emacs-24 eieio rejects defmethod with more than one specialization."
  (let* ((qualifiers (loop while (and (atom (car things)) (not (null (car things))))
                        collect (pop things)))
         (lambda-list (pop things))
         (body things)
         (mandatories (loop
                         while (and lambda-list
                                    (not (member (car lambda-list) '(&optional &rest &body &key &allow-other-keys &aux))))
                         collect (pop lambda-list)))
         (other-parameters lambda-list)
         (first-parameter (pop mandatories))
         (checks '()))
    `(defmethod ,name ,@qualifiers
       (,first-parameter
        ,@(mapcar (lambda (parameter)
                    (if (listp parameter)
                        (progn
                          (push parameter checks)
                          (first parameter))
                        parameter))
                  mandatories)
        ,@other-parameters)
       ,@(mapcar (lambda (check)
                   (cons 'check-type check))
                 checks)
       ,@body)))


;;;; THE END ;;;;