LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032819. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "COMPAT" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "PCL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2756388071. :AUTHOR "REL3" :LENGTH-IN-BYTES 2449. :LENGTH-IN-BLOCKS 3. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ;;;-*-Mode:LISP; Package: PCL; Base:10; Syntax:Common-lisp; -*-;;;;;; *************************************************************************;;; Copyright (c) 1985 Xerox Corporation.  All rights reserved.;;;;;; Use and copying of this software and preparation of derivative works;;; based upon this software are permitted.  Any distribution of this;;; software or derivative works must comply with all applicable United;;; States export control laws.;;; ;;; This software is made available AS IS, and Xerox Corporation makes no;;; warranty about the software, its performance or its conformity to any;;; specification.;;; ;;; Any person obtaining a copy of this software is requested to send their;;; name and post office or electronic mail address to:;;;   CommonLoops Coordinator;;;   Xerox Artifical Intelligence Systems;;;   2400 Hanover St.;;;   Palo Alto, CA 94303;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa);;;;;; Suggestions, comments and requests for improvements are also welcome.;;; *************************************************************************;;;(in-package 'pcl)(defmacro run-super () '(call-next-method))(defun convert-with-first-arg (first-arg use-slot-value)  (iterate ((opc in first-arg))    (or (listp opc) (setq opc (list opc)))    (collect      ;; Can't use the obvious backquote in Genera!      (let ((entry ()))(when use-slot-value  (push t entry)  (push :use-slot-value entry))(when (cddr opc)  (push (caddr opc) entry)  (push :class entry))(when (cadr opc)  (push (cadr opc) entry)  (push :prefix entry))(cons (car opc) entry)))))(defmacro with (objects-prefixes-and-classes &body body)  `(with-slots ,(convert-with-first-arg objects-prefixes-and-classes nil)     . ,body))(defmacro with* (objects-prefixes-and-classes &body body)  `(with-slots ,(convert-with-first-arg objects-prefixes-and-classes t)     . ,body))(defmacro defmeth (name&options arglist &body body)  (cond ((not (listp name&options)) `(defmethod ,name&options ,arglist ,@body))((every #'symbolp (cdr name&options)) `(defmethod ,@name&options ,arglist ,@body))(t (let ((setf ()))   (dolist (opt (cdr name&options))     (when (and (listp opt) (eq (car opt) ':setf))       (return (setq setf opt))))   `(defmethod-setf ,(car name&options)    ,@(remove setf (cdr name&options))    ,arglist    ,(cadr setf)      ,@body)))))fun make-color (&key red green blue &allow-other-keys); for expansion  (declare (type (number 0 1) red green blue)   (values color)))(defun color-rgb (color)  (declare (type color color)   (values red green blue)))(defun color-red (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(defun color-green (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(defun color-blue (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(deftype resource-id () 'integer)(deftype drawable () '(or window pixmap)); Atoms are accepted as