/[cmucl]/src/pcl/macros.lisp
ViewVC logotype

Diff of /src/pcl/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.29 by gerd, Wed Jun 18 09:23:09 2003 UTC revision 1.30 by rtoy, Fri Mar 19 15:19:03 2010 UTC
# Line 36  Line 36 
36  ;;;  ;;;
37    
38  (in-package :pcl)  (in-package :pcl)
39    (intl:textdomain "cmucl")
40    
41  (declaim (declaration class variable-rebinding method-name  (declaim (declaration class variable-rebinding method-name
42                        method-lambda-list))                        method-lambda-list))
# Line 97  Line 98 
98         (loop (when (null .plist-tail.) (return nil))         (loop (when (null .plist-tail.) (return nil))
99               (setq ,key (pop .plist-tail.))               (setq ,key (pop .plist-tail.))
100               (when (null .plist-tail.)               (when (null .plist-tail.)
101                 (error "Malformed plist in doplist, odd number of elements."))                 (error _"Malformed plist in doplist, odd number of elements."))
102               (setq ,val (pop .plist-tail.))               (setq ,val (pop .plist-tail.))
103               (progn ,@bod)))))               (progn ,@bod)))))
104    
# Line 127  Line 128 
128    (or (gethash symbol *find-class*)    (or (gethash symbol *find-class*)
129        (unless dont-create-p        (unless dont-create-p
130          (unless (legal-class-name-p symbol)          (unless (legal-class-name-p symbol)
131            (error "~@<~S is not a legal class name.~@:>" symbol))            (error _"~@<~S is not a legal class name.~@:>" symbol))
132          (setf (gethash symbol *find-class*) (make-find-class-cell symbol)))))          (setf (gethash symbol *find-class*) (make-find-class-cell symbol)))))
133    
134  (defvar *create-classes-from-internal-structure-definitions-p* t)  (defvar *create-classes-from-internal-structure-definitions-p* t)
# Line 139  Line 140 
140             (ensure-non-standard-class symbol))             (ensure-non-standard-class symbol))
141        (cond ((null errorp) nil)        (cond ((null errorp) nil)
142              ((legal-class-name-p symbol)              ((legal-class-name-p symbol)
143               (error "No class named ~S." symbol))               (error _"No class named ~S." symbol))
144              (t              (t
145               (error "~S is not a legal class name." symbol)))))               (error _"~S is not a legal class name." symbol)))))
146    
147  (defun find-class-predicate-from-cell (symbol cell &optional (errorp t))  (defun find-class-predicate-from-cell (symbol cell &optional (errorp t))
148    (unless (find-class-cell-class cell)    (unless (find-class-cell-class cell)
# Line 152  Line 153 
153    (symbolp x))    (symbolp x))
154    
155  (defun find-class (symbol &optional (errorp t) environment)  (defun find-class (symbol &optional (errorp t) environment)
156    "Returns the PCL class metaobject named by SYMBOL. An error of type    _N"Returns the PCL class metaobject named by SYMBOL. An error of type
157     SIMPLE-ERROR is signaled if the class does not exist unless ERRORP     SIMPLE-ERROR is signaled if the class does not exist unless ERRORP
158     is NIL in which case NIL is returned. SYMBOL cannot be a keyword."     is NIL in which case NIL is returned. SYMBOL cannot be a keyword."
159    (declare (ignore environment))    (declare (ignore environment))
# Line 205  Line 206 
206                    (fdefinition (class-predicate-name new-value))))                    (fdefinition (class-predicate-name new-value))))
207            (update-ctors 'setf-find-class :class new-value :name name))            (update-ctors 'setf-find-class :class new-value :name name))
208          new-value)          new-value)
209        (error "~S is not a legal class name." name)))        (error _"~S is not a legal class name." name)))
210    
211  (defun (setf find-class-predicate) (new-value symbol)  (defun (setf find-class-predicate) (new-value symbol)
212    (if (legal-class-name-p symbol)    (if (legal-class-name-p symbol)
213        (setf (find-class-cell-predicate (find-class-cell symbol)) new-value)        (setf (find-class-cell-predicate (find-class-cell symbol)) new-value)
214        (error "~S is not a legal class name." symbol)))        (error _"~S is not a legal class name." symbol)))
215    
216  (defmacro function-funcall (form &rest args)  (defmacro function-funcall (form &rest args)
217    `(funcall (the function ,form) ,@args))    `(funcall (the function ,form) ,@args))

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5