;;;; -*- 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 ;;;; Pascal J. Bourguignon ;;;;MODIFICATIONS ;;;; 2002-09-08 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 ;;;;