From 3b54d081cc6e3887808b3dc27e6dd0ad7d35d1c1 Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski <daniel@turtleware.eu> Date: Sun, 7 May 2017 10:11:29 +0200 Subject: [PATCH] cleanup: use ANSI Common Lisp eval-when style replace eval, load, compile with :execute, :load-toplevel, :compile-toplevel. Done in semi-automatic way. --- aclpc/acl-frames.lisp | 6 +++--- aclpc/acl-medium.lisp | 2 +- aclpc/acl-scroll.lisp | 4 ++-- aclpc/pkgdcl.lisp | 4 ++-- clim/basic-translators.lisp | 2 +- clim/clim-defs.lisp | 2 +- clim/db-menu.lisp | 2 +- clim/db-stream.lisp | 2 +- clim/frames.lisp | 6 +++--- clim/gestures.lisp | 2 +- clim/histories.lisp | 4 ++-- clim/input-editor-commands.lisp | 2 +- clim/input-protocol.lisp | 2 +- clim/interactive-defs.lisp | 2 +- clim/interactive-protocol.lisp | 2 +- clim/japanese-input-editor.lisp | 2 +- clim/lucid-after.lisp | 2 +- clim/ptypes1.lisp | 14 +++++++------- clim/surround-output.lisp | 2 +- clim/tracking-pointer.lisp | 2 +- clim/translators.lisp | 2 +- compatibility/clim1-compatibility.lisp | 4 ++-- compatibility/packages.lisp | 4 ++-- demo/browser.lisp | 6 +++--- demo/cad-demo.lisp | 6 +++--- demo/custom-records.lisp | 2 +- demo/japanese-graphics-editor.lisp | 4 ++-- demo/navfun.lisp | 26 +++++++++++++------------- misc/clos-preload.cl | 2 +- misc/compile-1.lisp | 2 +- misc/pixmaps.lisp | 4 ++-- postscript/postscript-port.lisp | 2 +- pre-silica/cloe-implementation.lisp | 2 +- pre-silica/define-application.lisp | 4 ++-- pre-silica/defs-graphics-generics.lisp | 2 +- pre-silica/genera-implementation.lisp | 2 +- silica/gadgets.lisp | 2 +- silica/graphics.lisp | 4 ++-- silica/protocols.lisp | 6 +++--- specs/design-classes.lisp | 2 +- specs/rendering-conventions.lisp | 2 +- sys/compile.lisp | 4 ++-- sys/defsystem.lisp | 12 ++++++------ sys/load.lisp | 2 +- sys/sysdcl-pc.lisp | 4 ++-- sys/sysdcl.lisp | 4 ++-- test/test-driver.lisp | 2 +- tk/convenience.lisp | 8 ++++---- tk/gcontext.lisp | 4 ++-- tk/load-xm.lisp | 2 +- tk/xlib.lisp | 6 +++--- tk/xm-widgets.lisp | 2 +- utils/autoconstructor.lisp | 2 +- utils/cl-stream-functions.lisp | 4 ++-- utils/cl-streams.lisp | 6 +++--- utils/clos-patches.lisp | 4 ++-- utils/clos.lisp | 6 +++--- utils/defpackage.lisp | 4 ++-- utils/defun-utilities.lisp | 6 +++--- utils/defun.lisp | 4 ++-- utils/designs.lisp | 2 +- utils/excl-verification.lisp | 4 ++-- utils/lisp-package-fixups.lisp | 4 ++-- utils/lisp-utilities.lisp | 12 ++++++------ utils/lucid-stream-functions.lisp | 4 ++-- utils/packages.lisp | 2 +- utils/processes.lisp | 10 +++++----- utils/protocols.lisp | 6 +++--- utils/utilities.lisp | 2 +- xlib/ffi.lisp | 16 ++++++++-------- 70 files changed, 152 insertions(+), 152 deletions(-) diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp index ffd2db28..5f6717bf 100644 --- a/aclpc/acl-frames.lisp +++ b/aclpc/acl-frames.lisp @@ -288,7 +288,7 @@ (setf (aref stringvar newlen) #\null) (setf (fill-pointer stringvar) newlen)) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant *nstringify-buffer-default-size* 2048) (defvar nstringify-buffer (make-array *nstringify-buffer-default-size* :fill-pointer t @@ -1127,7 +1127,7 @@ to be run from another." (car dotted-pair) (cdr dotted-pair) (code-char 0) (cdr dotted-pair) (code-char 0)))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; All pathnames returned by SELECT-FILE must fit in the scratch string, ;; so make it pretty big. (defconstant *scratch-string-length* 2048) @@ -1139,7 +1139,7 @@ to be run from another." (defparameter *scratch-c-string* (ff:allocate-fobject-c `(:array :char ,*scratch-string-length*))) -(eval-when (compile eval load) +(eval-when (:compile-toplevel :execute :load-toplevel) ;; this type useful since we don't open code anonymous types well yet: (ff:def-foreign-type foreign-string (:array :char 1)) ) diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp index ff4a20ee..11044f28 100644 --- a/aclpc/acl-medium.lisp +++ b/aclpc/acl-medium.lisp @@ -1819,7 +1819,7 @@ device-independent bitmap, an icon, nor a cursor.")) (setf (gethash "magenta" table) +magenta+) table)) -(eval-when (load eval) +(eval-when (:load-toplevel :execute) (initialize-named-colors)) (defun clim-internals::kana-process-gesture (istream gesture type) diff --git a/aclpc/acl-scroll.lisp b/aclpc/acl-scroll.lisp index 208a2193..3775d441 100644 --- a/aclpc/acl-scroll.lisp +++ b/aclpc/acl-scroll.lisp @@ -16,7 +16,7 @@ (in-package :silica) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (define-event-class scrollbar-event (event) ((sheet :reader event-sheet :initarg :sheet) (orientation :initarg :orientation :reader scrollbar-event-orientation) @@ -474,7 +474,7 @@ (resize-sheet child nwidth nheight) ;;; get the viewport sized correctly! (allocate-space child nwidth nheight))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; Turn this on as long as it gets turned off in pkgdcl.lisp (setq excl:*enable-package-locked-errors* common-lisp-user::*lock-preference*) (provide :climnt)) diff --git a/aclpc/pkgdcl.lisp b/aclpc/pkgdcl.lisp index 1882e804..f429f76f 100644 --- a/aclpc/pkgdcl.lisp +++ b/aclpc/pkgdcl.lisp @@ -15,7 +15,7 @@ #-(and mswindows 64bit) t) ;; Invite everybody to the party. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (require :climg) ;; [rfe4951]: not needed anymore: ;; (require :ffcompat) @@ -48,7 +48,7 @@ #:make-windows-font-named ;make a windows font from a name )) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :aclmerge *features*) (pushnew :os-threads *features*)) diff --git a/clim/basic-translators.lisp b/clim/basic-translators.lisp index 6ba5a75e..b6a2a94f 100644 --- a/clim/basic-translators.lisp +++ b/clim/basic-translators.lisp @@ -43,7 +43,7 @@ (presentation-subtypep-1 type-name context-name) (presentation-typep object context-type)))))))) -(eval-when (compile eval load) +(eval-when (:compile-toplevel :execute :load-toplevel) ;; Only the PRESENTATION-MENU translator lives in this (unless (find-command-table 'presentation-menu-command-table :errorp nil) (make-command-table 'presentation-menu-command-table :inherit-from nil)) diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp index a666d7fd..0916b7e6 100644 --- a/clim/clim-defs.lisp +++ b/clim/clim-defs.lisp @@ -88,7 +88,7 @@ ,(if record-supplied record `(stream-recording-p ,new-stream)) ,(if draw-supplied draw `(stream-drawing-p ,new-stream))))))) -(eval-when (compile eval load) +(eval-when (:compile-toplevel :execute :load-toplevel) (defvar *output-record-constructor-cache* (make-hash-table)) (defmacro construct-output-record (type &rest initargs &environment env) diff --git a/clim/db-menu.lisp b/clim/db-menu.lisp index ca1293c7..d627dc0f 100644 --- a/clim/db-menu.lisp +++ b/clim/db-menu.lisp @@ -27,7 +27,7 @@ ((next-menu :initform nil :initarg :next-menu))) ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in ??? ;;; (unless (ignore-errors (find-class 'pull-down-menu)) ;;; (defclass pull-down-menu () ()))) diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp index 0fd25d73..bea8e485 100644 --- a/clim/db-stream.lisp +++ b/clim/db-stream.lisp @@ -378,7 +378,7 @@ () (:default-initargs :default-view +gadget-dialog-view+)) -(eval-when (compile) +(eval-when (:compile-toplevel) ;; defined later in the compilation... (declaim (special *default-menu-text-style*)) ) diff --git a/clim/frames.lisp b/clim/frames.lisp index 2ae4cc0b..5942f109 100644 --- a/clim/frames.lisp +++ b/clim/frames.lisp @@ -138,7 +138,7 @@ (frame standard-application-frame)) (adjust-layout-requirements frame (frame-current-layout frame))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun define-application-frame-1 (name state-variables pane-descriptions &key top-level layouts command-table) @@ -233,7 +233,7 @@ `',layout))) layouts)))) `(progn - (eval-when (compile) + (eval-when (:compile-toplevel) (when ',command-table (setf (compile-time-property ',(first command-table) 'command-table-name) t)) (define-application-frame-1 ',name ',slots ,pane-constructors @@ -1370,7 +1370,7 @@ (process-command-event sheet event)) ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in ??? ;;; (unless (ignore-errors (find-class 'activity-frame)) ;;; (defclass activity-frame () ()))) diff --git a/clim/gestures.lisp b/clim/gestures.lisp index 871dcb78..c99c5fc0 100644 --- a/clim/gestures.lisp +++ b/clim/gestures.lisp @@ -15,7 +15,7 @@ ;;; as per CLtL. ;;; 2) The set of possible "mouse buttons" is :LEFT, :MIDDLE, and :RIGHT. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; Button indices are 0, 1, or 2 (defun-inline button-index (name) diff --git a/clim/histories.lisp b/clim/histories.lisp index b08bb098..ca25ebd0 100644 --- a/clim/histories.lisp +++ b/clim/histories.lisp @@ -361,11 +361,11 @@ (view nil)) #+(and allegro aclpc) -(eval-when (compile load) +(eval-when (:compile-toplevel :load-toplevel) (setf (find-class 'presentation-history-element) nil)) #+(and allegro aclpc) -(eval-when (compile) +(eval-when (:compile-toplevel) (warn "~S structure hacked for bug2419" 'presentation-history-element)) (defun make-presentation-type-history (type &key (maximum-length *default-history-length*) diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp index 7307fca2..f2f5e49f 100644 --- a/clim/input-editor-commands.lisp +++ b/clim/input-editor-commands.lisp @@ -10,7 +10,7 @@ ;;; on INPUT-EDITING-STREAM-MIXIN rather than on our specific implementation of ;;; an input editor. This may prove to be a foolish decision down the pike. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *ie-command-arglist* '(stream input-buffer gesture numeric-argument)) ) diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp index ef37a1d1..4473d30b 100644 --- a/clim/input-protocol.lisp +++ b/clim/input-protocol.lisp @@ -413,7 +413,7 @@ (process-abort-gesture stream gesture)))) ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in ??? ;;; (unless (ignore-errors (find-class 'interactor-pane)) ;;; (defclass interactor-pane () ())) diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp index 2f488c7d..bceed944 100644 --- a/clim/interactive-defs.lisp +++ b/clim/interactive-defs.lisp @@ -22,7 +22,7 @@ ;; Noise strings and ACCEPT results -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (noise-string (:constructor make-noise-string-1)) display-string text-style diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp index 03da2395..fe25a7c2 100644 --- a/clim/interactive-protocol.lisp +++ b/clim/interactive-protocol.lisp @@ -1059,7 +1059,7 @@ ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in ??? ;;; (unless (ignore-errors (find-class 'accept-values-pane)) ;;; (defclass accept-values-pane () ())) diff --git a/clim/japanese-input-editor.lisp b/clim/japanese-input-editor.lisp index 2ffa3ef0..21fdf1d9 100644 --- a/clim/japanese-input-editor.lisp +++ b/clim/japanese-input-editor.lisp @@ -5,7 +5,7 @@ (in-package :clim-internals) #-ics -(eval-when (compile) +(eval-when (:compile-toplevel) (warn "~S contains fat strings but is being compiled with a non-ICS lisp" excl:*source-pathname*)) diff --git a/clim/lucid-after.lisp b/clim/lucid-after.lisp index 9e2e6e73..d6d29d71 100644 --- a/clim/lucid-after.lisp +++ b/clim/lucid-after.lisp @@ -43,7 +43,7 @@ (pushnew 'rehash-ptypes *restart-cleanup-functions*)) -(eval-when (load) +(eval-when (:load-toplevel) (pushnew :clim-2-0 *features*) (defparameter *clim-repacking-date* (universal-time-string (get-universal-time))) #+ignore ;breaks in 2.0 diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp index 6a813b4e..c1f760be 100644 --- a/clim/ptypes1.lisp +++ b/clim/ptypes1.lisp @@ -306,7 +306,7 @@ t) ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in ??? ;;; (unless (ignore-errors (find-class 'basic-history)) ;;; (defclass basic-history () ()))) @@ -566,7 +566,7 @@ the same name as a CLOS class."))) ;; Generate the expander function and pass it to load-presentation-type-abbreviation `(define-group ,name define-presentation-type-abbreviation - (eval-when (compile) + (eval-when (:compile-toplevel) #+(or Genera Cloe-Runtime Minima (and MCL CCL-2)) (setf (compile-time-property ',name 'presentation-type-abbreviation) ,function) @@ -747,7 +747,7 @@ ;; Generate the form that stores all the information and defines the ;; automatically-defined presentation methods `(progn - (eval-when (compile) + (eval-when (:compile-toplevel) (ensure-presentation-type ',name ',parameters ',options ',direct-supertypes ',description ',history ',parameters-are-types @@ -1558,12 +1558,12 @@ ;;; Presentation generic functions have their own class just so we can define ;;; one method that aids in implementing presentation-method-combination #-(and MCL CCL-2) -(eval-when (eval load compile) +(eval-when (:execute :load-toplevel :compile-toplevel) (defclass presentation-generic-function (standard-generic-function #+Minima-Developer standard-object) () (:metaclass closer-mop:funcallable-standard-class)) -) ;end of (eval-when (eval load compile) +) ;end of (eval-when (:execute :load-toplevel :compile-toplevel) #+CLIM-extends-CLOS (defvar *presentation-method-argument-class*) @@ -1604,7 +1604,7 @@ ;;; extension to call-method ;;;--- If combined methods were generated during compile-file, this would need ;;;--- to get an environment argument from somewhere -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (define-method-combination presentation-method-combination () ((around (:around)) (before (:before)) @@ -1672,7 +1672,7 @@ (if bindings `(let* ,bindings ,form) form))))))) -) ;end of (eval-when (compile load eval) +) ;end of (eval-when (:compile-toplevel :load-toplevel :execute) ;;;; Definitions of Presentation Generic Functions diff --git a/clim/surround-output.lisp b/clim/surround-output.lisp index 61b1a9d8..d90fa07b 100644 --- a/clim/surround-output.lisp +++ b/clim/surround-output.lisp @@ -9,7 +9,7 @@ (defvar *border-shape-drawer-alist* nil) -(eval-when (eval compile load) +(eval-when (:execute :compile-toplevel :load-toplevel) (defparameter *border-shape-drawer-arglist* '(stream record left top right bottom)) diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp index 7a6e50d6..424502f4 100644 --- a/clim/tracking-pointer.lisp +++ b/clim/tracking-pointer.lisp @@ -7,7 +7,7 @@ ;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. ;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;;; For compile-time checking. (defvar *tracking-pointer-clauses* nil) ;each clause looks like (name arglist) diff --git a/clim/translators.lisp b/clim/translators.lisp index 724b200a..fb9253cf 100644 --- a/clim/translators.lisp +++ b/clim/translators.lisp @@ -20,7 +20,7 @@ (setq clos-internals::*invalidate-clim-handler-caches* #'invalidate-presentation-caches) ;;; maybe this wants to be taken out after the load-only phase? -(eval-when (compile load #+(or aclpc acl86win32) eval) +(eval-when (:compile-toplevel :load-toplevel #+(or aclpc acl86win32) :execute) (defvar *translator-function-arglist* '(object presentation context-type frame event window x y))) diff --git a/compatibility/clim1-compatibility.lisp b/compatibility/clim1-compatibility.lisp index 118b1006..651a16f8 100644 --- a/compatibility/clim1-compatibility.lisp +++ b/compatibility/clim1-compatibility.lisp @@ -9,7 +9,7 @@ ;;; Compatibility stubs for CLIM 1.1 -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; We use this below to flag the compatibility code... (pushnew :CLIM-1-compatibility *features*)) @@ -130,7 +130,7 @@ (transform-position transform x y)) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun probably-stream-or-medium-p (symbol) (and (symbolp symbol) ;;--- This is really not completely safe diff --git a/compatibility/packages.lisp b/compatibility/packages.lisp index 5708817d..5f0b56f2 100644 --- a/compatibility/packages.lisp +++ b/compatibility/packages.lisp @@ -7,7 +7,7 @@ ;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *clim-1-symbols* '(*abort-characters* *activation-characters* @@ -109,7 +109,7 @@ `(progn ,@body)) ;; Import the above symbols into the CLIM package, then export them -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (let ((clim (find-package :clim))) (dolist (symbol *clim-1-symbols*) (import symbol clim) diff --git a/demo/browser.lisp b/demo/browser.lisp index 64459df4..5ffd90d5 100644 --- a/demo/browser.lisp +++ b/demo/browser.lisp @@ -170,13 +170,13 @@ ;; This is the most basic instantiable sort of call node. ;; Commands and translators are written on this, not on BASIC-CALL-NODE. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass call-node (basic-call-node) ()) ) ;; CALL-SUBNODEs are a stripped-down version of CALL-NODEs, which mostly ;; means that most commands and translators don't operate on subnodes. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass call-subnode (basic-call-node) ()) ) @@ -189,7 +189,7 @@ ;; Ellipsis nodes -(eval-when (load compile eval) +(eval-when (:load-toplevel :compile-toplevel :execute) (defclass ellipsis-call-node (basic-call-node) ((replaced-node :reader ellipsis-node-replaced-node :initarg :replaced-node))) diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp index 23df5f68..5ded3174 100644 --- a/demo/cad-demo.lisp +++ b/demo/cad-demo.lisp @@ -183,7 +183,7 @@ (defclass input (connection) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass input (connection) ())) (defmethod presentation-type ((input input)) @@ -206,7 +206,7 @@ (defclass output (connection) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass output (connection) ())) (defmethod presentation-type ((output output)) @@ -230,7 +230,7 @@ (:default-initargs :size *component-size*)) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass component (basic-thing) ((inputs :initform nil) diff --git a/demo/custom-records.lisp b/demo/custom-records.lisp index 3c9bd205..e56062bd 100644 --- a/demo/custom-records.lisp +++ b/demo/custom-records.lisp @@ -137,7 +137,7 @@ ;; Eat up the initargs that records are supposed to handle (declare (ignore object type single-box))) -(eval-when (compile) +(eval-when (:compile-toplevel) (proclaim '(inline make-data-point))) (defun make-data-point (u v) diff --git a/demo/japanese-graphics-editor.lisp b/demo/japanese-graphics-editor.lisp index bf1d9b9e..7cbcab17 100644 --- a/demo/japanese-graphics-editor.lisp +++ b/demo/japanese-graphics-editor.lisp @@ -10,12 +10,12 @@ ;;; Ensure that the japanese characters are compiled ;;; with the correct external-format. -(eval-when (compile) +(eval-when (:compile-toplevel) (when (streamp comp::*compile-file-stream*) (setf (stream-external-format comp::*compile-file-stream*) :utf8))) #-ics -(eval-when (compile) +(eval-when (:compile-toplevel) (warn "~S contains fat strings but is being compiled with a non-ICS lisp" excl:*source-pathname*)) diff --git a/demo/navfun.lisp b/demo/navfun.lisp index e728cc89..ec21ce3f 100644 --- a/demo/navfun.lisp +++ b/demo/navfun.lisp @@ -61,7 +61,7 @@ :accessor position-deviation))) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass fp-point () ((latitude :initarg :latitude :accessor point-latitude) @@ -106,7 +106,7 @@ :accessor position-longname))) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass named-position (ground-position) ((name :initarg :name :accessor position-name) @@ -125,7 +125,7 @@ (write (position-name position) :stream stream :escape nil)))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun degminsec (degrees &optional (minutes 0) (seconds 0)) (float (/ (+ (* degrees 3600) (* minutes 60) seconds) 3600))) @@ -235,7 +235,7 @@ (defclass airport (named-position) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass airport (named-position) ())) (defmethod draw-position ((airport airport) stream &optional label) @@ -255,7 +255,7 @@ (defclass vor (named-position) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass waypoint (named-position) ()) (defclass vor (named-position) ())) @@ -299,7 +299,7 @@ (defclass ndb (named-position) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass ndb (named-position) ())) (defmethod describe-position-object ((ndb ndb) stream) @@ -310,7 +310,7 @@ (defclass named-intersection (named-position) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass named-intersection (named-position) ())) (defmethod draw-position ((intersection named-intersection) stream &optional label) @@ -327,7 +327,7 @@ (defclass visual-checkpoint (named-position) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass visual-checkpoint (named-position) ())) @@ -395,7 +395,7 @@ (legs :initarg :legs :accessor route-legs))) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass basic-route-segment () ((at :initarg :at :accessor route-segment-at))) @@ -438,7 +438,7 @@ (defclass route (basic-route) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass route (basic-route) ())) (defun route-segment-position-name (route-segment) @@ -473,7 +473,7 @@ (defclass victor-airway (basic-route) ()) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass victor-airway-segment (basic-route-segment) ((properties :accessor victor-airway-segment-properties) (next-leg :accessor victor-airway-segment-next-leg))) @@ -575,7 +575,7 @@ :accessor aircraft-hobs-or-tach))) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass aircraft () ((identification :initarg :identification ; Aircraft tail number :accessor aircraft-identification) @@ -689,7 +689,7 @@ (color :initarg :color :accessor flight-plan-color))) #+allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defclass flight-plan () ((type :initarg :type :accessor flight-plan-type) (aircraft-id :initarg :aircraft-id :accessor flight-plan-aircraft-id) diff --git a/misc/clos-preload.cl b/misc/clos-preload.cl index 1637b5ca..7f43f509 100644 --- a/misc/clos-preload.cl +++ b/misc/clos-preload.cl @@ -22,7 +22,7 @@ (in-package :clos) -(eval-when (compile) +(eval-when (:compile-toplevel) (unless (boundp 'si::*clos-preload-packages*) (setq si::*clos-preload-packages* nil))) diff --git a/misc/compile-1.lisp b/misc/compile-1.lisp index f0d57006..be4c5510 100644 --- a/misc/compile-1.lisp +++ b/misc/compile-1.lisp @@ -12,7 +12,7 @@ (pushnew :ansi-90 *features*) #+(and allegro microsoft) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :acl86win32 *features*)) ;;;; Set up translations so we can find stuff. diff --git a/misc/pixmaps.lisp b/misc/pixmaps.lisp index a9bad955..41cadca9 100644 --- a/misc/pixmaps.lisp +++ b/misc/pixmaps.lisp @@ -86,7 +86,7 @@ #+Genera (SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES "-*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-") -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (scl:export 'clim::(with-output-to-pixmap-stream) 'clim)) (defmacro with-output-to-pixmap-stream ((stream) &body body) @@ -102,7 +102,7 @@ #+Genera (SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES "-*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-") -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (scl:export 'clim::(copy-area allocate-pixmap deallocate-pixmap copy-to-pixmap copy-from-pixmap diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp index fe21e90c..6e665054 100644 --- a/postscript/postscript-port.lisp +++ b/postscript/postscript-port.lisp @@ -1164,7 +1164,7 @@ end } def ;;;********************************************************************** ;;; This needs to be loaded before the next form is compiled. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (define-graphics-generic draw-postscript-literal (string x y) :positions-to-transform (x y) ) ) diff --git a/pre-silica/cloe-implementation.lisp b/pre-silica/cloe-implementation.lisp index ff813a8b..c4665221 100644 --- a/pre-silica/cloe-implementation.lisp +++ b/pre-silica/cloe-implementation.lisp @@ -47,7 +47,7 @@ ;;; -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; Define the new key chars for Cloe CLIM. Regular Cloe defines 0-127, we define ;; 128-139 as the F-keys (F1 thru F12), 140 for c-sh-A, and 141 as c-sh-V diff --git a/pre-silica/define-application.lisp b/pre-silica/define-application.lisp index 6bfa9a54..33c614d6 100644 --- a/pre-silica/define-application.lisp +++ b/pre-silica/define-application.lisp @@ -52,7 +52,7 @@ #-Genera t (setf (window-label top-level-sheet) name)))) -(eval-when (eval compile load) +(eval-when (:execute :compile-toplevel :load-toplevel) (defstruct (frame-descriptor (:print-function print-frame-descriptor)) name @@ -176,7 +176,7 @@ `(list ',name ',type ,@options))) pane-descriptions))) `(progn - (eval-when (compile) + (eval-when (:compile-toplevel) (when ',command-table (setf (compile-time-property ',(first command-table) 'command-table-name) t)) (define-application-frame-1 ',name ',slots ,pane-descriptions diff --git a/pre-silica/defs-graphics-generics.lisp b/pre-silica/defs-graphics-generics.lisp index 47534df2..e518a2b9 100644 --- a/pre-silica/defs-graphics-generics.lisp +++ b/pre-silica/defs-graphics-generics.lisp @@ -6,7 +6,7 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. Portions copyright (c) 1989, 1990 International Lisp Associates." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; NOTE: if you change this list of keywords, you also have to change the keyword arguments ;; accepted by (CLOS:METHOD INVOKE-WITH-DRAWING-OPTIONS (DRAWING-STATE-MIXIN T)) diff --git a/pre-silica/genera-implementation.lisp b/pre-silica/genera-implementation.lisp index e348dc1f..bfa12797 100644 --- a/pre-silica/genera-implementation.lisp +++ b/pre-silica/genera-implementation.lisp @@ -6,7 +6,7 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Defined below -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(special *sheet-device*)) #+IMach (proclaim '(special *small-sheet-device*))) diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index bbefb32b..66c1a50e 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -784,7 +784,7 @@ The text-field must have the focus before you can call this function.")) :height h :min-height 0 :max-height max-height)))) ;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) +;;;(eval-when (:compile-toplevel :load-toplevel :execute) ;;; ;;mm: 11Jan95 - this is defined later in clim\db-strea ;;; (unless (ignore-errors (find-class 'clim-stream-pane)) ;;; (defclass clim-stream-pane () ()))) diff --git a/silica/graphics.lisp b/silica/graphics.lisp index 369c937d..37098315 100644 --- a/silica/graphics.lisp +++ b/silica/graphics.lisp @@ -8,7 +8,7 @@ ;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;; NOTE: if you change this list of keywords, you also have to change the keyword arguments ;; accepted by (CLOS:METHOD INVOKE-WITH-DRAWING-OPTIONS (DRAWING-STATE-MIXIN T)) @@ -66,7 +66,7 @@ ) ;eval-when -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun write-graphics-function-transformer (name medium-graphics-function-name diff --git a/silica/protocols.lisp b/silica/protocols.lisp index 2737d34b..f0086f24 100644 --- a/silica/protocols.lisp +++ b/silica/protocols.lisp @@ -50,13 +50,13 @@ (defmacro defprotocol (name supers &rest options) (declare (ignore supers options)) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) (setf (find-protocol ',name) (make-instance 'protocol :name ',name)))) (defmacro defrole (class supers slots &rest options) (declare (ignore supers options)) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) #+PCL (pcl::do-standard-defsetf ,@(mapcan #'(lambda (slot) @@ -88,7 +88,7 @@ t)) required-arg-specs)) (extra-args (and pos (subseq arg-specs pos)))) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) ;; Define a group named (OPERATION PROTOCOL NAME), since we can ;; have multiple DEFOPERATIONs for the same operation in ;; different protocols (used to just be named NAME). diff --git a/specs/design-classes.lisp b/specs/design-classes.lisp index c3c7026e..4a302ff0 100644 --- a/specs/design-classes.lisp +++ b/specs/design-classes.lisp @@ -2,7 +2,7 @@ (defvar *classes*) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :eps-bbox cl:*features*)) (defmacro with-postscript-stream ((stream pathname) &body body) diff --git a/specs/rendering-conventions.lisp b/specs/rendering-conventions.lisp index ee272a35..4aef6eb0 100644 --- a/specs/rendering-conventions.lisp +++ b/specs/rendering-conventions.lisp @@ -51,7 +51,7 @@ (loop for y from dtop below dbottom do (graphics:draw-point (+ x .5) (+ y .5))))))))))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :eps-bbox cl:*features*)) (defmacro with-postscript-stream ((stream pathname) &body body) diff --git a/sys/compile.lisp b/sys/compile.lisp index 408ef0d0..059ddac5 100644 --- a/sys/compile.lisp +++ b/sys/compile.lisp @@ -10,7 +10,7 @@ (proclaim '(optimize (speed 3) (safety 1) (debug 1))) #+(and allegro microsoft) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :acl86win32 *features*)) #+microsoft @@ -27,7 +27,7 @@ ;; should probably change ANSI-90 to ANSI-CL throughout the CLIM code but ;; until then... (aclpc gets this feature in defsystem) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :ansi-90 *features*) (setf (logical-pathname-translations "clim2") `((";**;*.*" ,*clim-root*))) diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp index 3c7d82b7..2c135b27 100644 --- a/sys/defsystem.lisp +++ b/sys/defsystem.lisp @@ -35,7 +35,7 @@ ;; ANSI-90, corresponding to what we think the spec will be, in late 1990. #+Allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (warn "This file is no longer used in the Allegro port. \ Something is wrong if this warning appears!")) @@ -45,7 +45,7 @@ Something is wrong if this warning appears!")) (pushnew :ansi-90 *features*)) #+Genera -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (multiple-value-bind (major minor) (sct:get-system-version) (declare (ignore minor)) (when (>= major 437) @@ -111,7 +111,7 @@ Something is wrong if this warning appears!")) ;;; *** A temporary workaround, easier than fixing all references to ;;; *** LISP:<foo>. --RWK 20.Nov.90 #+ANSI-90 -(eval-when (eval compile load) +(eval-when (:execute :compile-toplevel :load-toplevel) (flet ((fix-package (pack-name add-name) (setq add-name (string add-name)) (let ((pack (find-package pack-name))) @@ -136,12 +136,12 @@ Something is wrong if this warning appears!")) ;;; #-(or Minima Genera) -(eval-when (eval load compile) +(eval-when (:execute :load-toplevel :compile-toplevel) (shadow (list (intern (symbol-name :make-pathname) :lisp) (intern (symbol-name :pathname-directory) :lisp)))) #-(or Minima Genera) -(eval-when (eval load compile) +(eval-when (:execute :load-toplevel :compile-toplevel) (export (list (intern (symbol-name :make-pathname) :clim-defsystem) (intern (symbol-name :pathname-directory) :clim-defsystem)))) @@ -1211,7 +1211,7 @@ pathname fields are evaluated." ;; The following are used to prevent multiple compilations/loads from occuring ;; during a single call to LOAD-SYSTEM or COMPILE-SYSTEM. -(eval-when (eval compile) +(eval-when (:execute :compile-toplevel) (proclaim '(special *loaded-systems* *loaded-modules* *compiled-systems* *compiled-modules* *tracep*))) diff --git a/sys/load.lisp b/sys/load.lisp index 9e6d6e9d..807b7ba6 100644 --- a/sys/load.lisp +++ b/sys/load.lisp @@ -4,7 +4,7 @@ (in-package :user) #+(and Allegro (or microsoft mswindows)) -(eval-when (compile load eval) (push :acl86win32 *features*)) +(eval-when (:compile-toplevel :load-toplevel :execute) (push :acl86win32 *features*)) #+acl86win32 (let ((excl::*enable-package-locked-errors* nil)) diff --git a/sys/sysdcl-pc.lisp b/sys/sysdcl-pc.lisp index 5639e59e..fd705997 100644 --- a/sys/sysdcl-pc.lisp +++ b/sys/sysdcl-pc.lisp @@ -6,7 +6,7 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;;; Tell the world that we're here ;;;--- These need to be in the CLIM.fasl also. @@ -43,7 +43,7 @@ ;;; our own trampolines which will call our generic function, and then write default ;;; methods which will invoke the COMMON-LISP package equivalents. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) #+(or Allegro Minima) diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp index 8c257662..4d9f3072 100644 --- a/sys/sysdcl.lisp +++ b/sys/sysdcl.lisp @@ -17,7 +17,7 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;;; Tell the world that we're here ;;;--- These need to be in the CLIM.fasl also. @@ -57,7 +57,7 @@ ;;; our own trampolines which will call our generic function, and then write default ;;; methods which will invoke the COMMON-LISP package equivalents. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) #+(or allegro Minima diff --git a/test/test-driver.lisp b/test/test-driver.lisp index e680312a..96304387 100644 --- a/test/test-driver.lisp +++ b/test/test-driver.lisp @@ -843,7 +843,7 @@ ;; How can we wait for a frame to be created. Grab hold of it and then ;; run some commands on it. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (require :prof)) (defun do-frame-test-with-profiling (test &key (type :time) prefix) diff --git a/tk/convenience.lisp b/tk/convenience.lisp index 27659895..ec470114 100644 --- a/tk/convenience.lisp +++ b/tk/convenience.lisp @@ -5,13 +5,13 @@ (in-package :tk) #-(version>= 6 1) -(eval-when (eval compile) +(eval-when (:execute :compile-toplevel) (defmacro define-convenience-class (class superclasses entry-point) (let ((c-function-name (intern (substitute #\_ #\- (lispify-tk-name entry-point :package nil))))) `(progn - (eval-when (eval compile) + (eval-when (:execute :compile-toplevel) (defforeign ',c-function-name :entry-point (ff:convert-foreign-name ,entry-point) :call-direct t @@ -39,13 +39,13 @@ (xt_manage_child o)) o)))))))) #+(version>= 6 1) -(eval-when (eval compile) +(eval-when (:execute :compile-toplevel) (defmacro define-convenience-class (class superclasses entry-point) (let ((c-function-name (intern (substitute #\_ #\- (lispify-tk-name entry-point :package nil))))) `(progn - (eval-when (eval compile) + (eval-when (:execute :compile-toplevel) (def-foreign-call (,c-function-name ,entry-point) ((w :foreign-address) (x :foreign-address) (y :foreign-address) (z :int fixnum)) :returning :foreign-address diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp index dc202346..4db0aa01 100644 --- a/tk/gcontext.lisp +++ b/tk/gcontext.lisp @@ -4,7 +4,7 @@ (in-package :tk) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) #+ignore (defconstant *gcontext-components* '((function :int) @@ -41,7 +41,7 @@ (defun make-xgcvalues () (clim-utils::allocate-cstruct 'x11::xgcvalues :initialize t)) -(eval-when (compile eval) +(eval-when (:compile-toplevel :execute) #+ignore (defun gcontext-component-to-slot-definition (x) (destructuring-bind diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp index b7f1a174..cab334f1 100644 --- a/tk/load-xm.lisp +++ b/tk/load-xm.lisp @@ -4,7 +4,7 @@ (cl:in-package #:user) -(eval-when (compile eval load) +(eval-when (:compile-toplevel :execute :load-toplevel) (require :climg)) (defvar sys::*clim-library-search-path* '("/usr/X11/lib/" "/usr/X11R6/lib/" "/usr/local/lib/" diff --git a/tk/xlib.lisp b/tk/xlib.lisp index 1108bb38..9c7de55d 100644 --- a/tk/xlib.lisp +++ b/tk/xlib.lisp @@ -30,7 +30,7 @@ (defclass window (drawable) ((plist :accessor window-property-list :initform nil))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant *window-set-attributes-bit-mask* '(background-pixmap background-pixel border-pixmap border-pixel bit-gravity win-gravity backing-store backing-planes backing-pixel @@ -46,7 +46,7 @@ (defun make-xwindowattributes () (clim-utils::allocate-cstruct 'x11::xwindowattributes :initialize t)) -(eval-when (compile eval) +(eval-when (:compile-toplevel :execute) (defmacro define-window-reader (name &optional decoder &rest args) `(defmethod ,(intern (format nil "~A-~A" 'window name)) ((window window)) ,(let ((body @@ -292,7 +292,7 @@ (setq *x-io-error-handler-address* (register-foreign-callable 'x-io-error-handler))))) -(eval-when (load) +(eval-when (:load-toplevel) (setup-error-handlers)) (define-condition x-colormap-full (serious-condition) ()) diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp index 7884689b..e31d812e 100644 --- a/tk/xm-widgets.lisp +++ b/tk/xm-widgets.lisp @@ -110,7 +110,7 @@ (defvar *empty-compound-string* nil) - (eval-when (compile) (declaim (special *font-list-tags*))) + (eval-when (:compile-toplevel) (declaim (special *font-list-tags*))) (defun partition-compound-string (s f &key (start 0) (end (length s))) (unless (eql (length s) 0) diff --git a/utils/autoconstructor.lisp b/utils/autoconstructor.lisp index 2a489778..4e996773 100644 --- a/utils/autoconstructor.lisp +++ b/utils/autoconstructor.lisp @@ -93,7 +93,7 @@ ;; the compile time environment that a function with this name and ;; this argument list has been defined. The portable way to do this ;; is with defun. - (eval-when (compile load eval) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(notinline ,name)) (proclaim '(function ,name))) #+++ignore ;; See if FUNCTION proclamation is sufficient. diff --git a/utils/cl-stream-functions.lisp b/utils/cl-stream-functions.lisp index 19a0993f..725358a8 100644 --- a/utils/cl-stream-functions.lisp +++ b/utils/cl-stream-functions.lisp @@ -47,7 +47,7 @@ (when (eq (first optional-args) '&optional) (pop optional-args)) `(define-group ,name write-forwarding-cl-output-stream-function - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) (defun ,name (,@required-args &optional stream ,@optional-args) (cond ((null stream) (setq stream *standard-output*)) ((eq stream t) (setq stream *terminal-io*))) @@ -96,7 +96,7 @@ (when (member (first (last method-lambda-list)) lambda-list-keywords) (setf method-lambda-list (butlast method-lambda-list))) `(define-group ,name write-forwarding-cl-input-stream-function - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) ,(if eof (let ((args `(eof-error-p eof-value ,@(and (not (eq eof :no-recursive)) '(recursive-p))))) diff --git a/utils/cl-streams.lisp b/utils/cl-streams.lisp index d8975229..dda1d5c6 100644 --- a/utils/cl-streams.lisp +++ b/utils/cl-streams.lisp @@ -126,7 +126,7 @@ ;; Shadow the Common Lisp function with one that calls the generic function, ;; except in Genera and Cloe where the Common Lisp function will work #-(or Genera (and MCL CCL-2)) - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) #-(or Genera (and MCL CCL-2)) (defun ,name (,@required-args &optional stream ,@optional-args) (case stream @@ -172,7 +172,7 @@ ;;; -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun order-preserving-set-difference (set-one set-two) #-(and MCL CCL-2) (set-difference set-one set-two) #+(and MCL CCL-2) (nreverse (set-difference set-one set-two))) @@ -196,7 +196,7 @@ ;; Shadow the Common Lisp function with one that calls the generic function, ;; except in Genera or Cloe where the Common Lisp function will work #-(or Genera (and MCL CCL-2)) - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) #-(or Genera (and MCL CCL-2)) ,(if eof (let ((args `(eof-error-p eof-value ,@(and (not (eq eof :no-recursive)) diff --git a/utils/clos-patches.lisp b/utils/clos-patches.lisp index 17d67dd8..d38bc26a 100644 --- a/utils/clos-patches.lisp +++ b/utils/clos-patches.lisp @@ -35,7 +35,7 @@ sys::*compile-file-environment*)) #+(and allegro never-in-a-million-years) -(eval-when (compile) +(eval-when (:compile-toplevel) (warn "~S hacked for lack of environment support in 4.1" 'compile-file-environment-p)) #+(or (and MCL CCL-2) Clozure) @@ -90,7 +90,7 @@ ;;; by load-reference-to-presentation-type-class isn't sufficient without this, ;;; because a MAKE-LOAD-FORM form for a presentatation type class could be evaluated ;;; before a superclass has been defined. -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (setq compiler::.random-forms-max. 0)) diff --git a/utils/clos.lisp b/utils/clos.lisp index a9f467d4..dd3f58cc 100644 --- a/utils/clos.lisp +++ b/utils/clos.lisp @@ -11,7 +11,7 @@ (in-package :clim-utils) #+Allegro-v4.0-constructors -(eval-when (compile eval load) (require :constructor)) +(eval-when (:compile-toplevel :execute :load-toplevel) (require :constructor)) ;;; ---------------- ;;; Constructors @@ -36,7 +36,7 @@ (defmacro define-constructor (name class lambda-list &body initargs) (let ((rest-arg (member '&rest lambda-list))) `(progn - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) (defun ,name ,lambda-list ,@(when rest-arg `((declare (dynamic-extent ,(second rest-arg))))) @@ -106,7 +106,7 @@ ;(defvar *dynamic-classes* (make-hash-table :test #'equal)) ; -;(eval-when (compile load eval) (proclaim '(inline %make-standard-class))) +;(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline %make-standard-class))) ;(defun %make-standard-class (name supers) ; ; #+Lucid diff --git a/utils/defpackage.lisp b/utils/defpackage.lisp index 70054898..ecdbbeb5 100644 --- a/utils/defpackage.lisp +++ b/utils/defpackage.lisp @@ -12,7 +12,7 @@ #+(or Allegro Lucid) (defpackage :clim-lisp) #-(or Allegro Lucid) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package :clim-lisp) (make-package "CLIM-LISP" :use '("COMMON-LISP")))) @@ -61,7 +61,7 @@ :key #'first))) (when bad-option (warn "Unknown ~S option: ~S" 'defpackage (first bad-option)))) - `(eval-when (compile load eval) + `(eval-when (:compile-toplevel :load-toplevel :execute) (let ((,package-var (make-package-aux ',package-name :use nil ,@(when nicknames `(:nicknames ',(mapcar #'string nicknames))) diff --git a/utils/defun-utilities.lisp b/utils/defun-utilities.lisp index bece22ac..2109daa8 100644 --- a/utils/defun-utilities.lisp +++ b/utils/defun-utilities.lisp @@ -75,7 +75,7 @@ ;;;; don't use define-group, because it does a excl::record-source-file, ;;;; which will be also done by defun! This causes duplicate definition in ;;;; file warnings. - (eval-when (compile load eval) (proclaim '(inline ,name))) + (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name))) (defun ,name ,lambda-list ,@body))) @@ -101,7 +101,7 @@ `(let ((,native-string-var ,string-exp)) ,@body)) - (eval-when (compile load eval) (export 'with-native-string)) + (eval-when (:compile-toplevel :load-toplevel :execute) (export 'with-native-string)) (defun mb-to-string (mb-vector) (let* ((lgth (length mb-vector)) @@ -109,4 +109,4 @@ (dotimes (i lgth string) (setf (schar string i) (code-char (aref mb-vector i)))))) - (eval-when (compile load eval) (export 'mb-to-string))) + (eval-when (:compile-toplevel :load-toplevel :execute) (export 'mb-to-string))) diff --git a/utils/defun.lisp b/utils/defun.lisp index f03320da..dacc8fb3 100644 --- a/utils/defun.lisp +++ b/utils/defun.lisp @@ -220,7 +220,7 @@ :downward-p ,downward-p) ,@body)) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (lisp:defun lintern (symbol) (intern (symbol-name symbol) #+Genera :future-common-lisp #-Genera :lisp)) ) @@ -357,7 +357,7 @@ #-PCL `(cl:method ,function-name ,specifier-list ,@qualifiers))) #+(and allegro (not acl86win32) (version>= 4 1)) -(eval-when (compile load eval) (require :scm)) +(eval-when (:compile-toplevel :load-toplevel :execute) (require :scm)) #+(and allegro (not acl86win32) (version>= 4 1)) (excl::define-simple-parser defmethod scm::defmethod-parser) diff --git a/utils/designs.lisp b/utils/designs.lisp index c8287c74..c9333ca6 100644 --- a/utils/designs.lisp +++ b/utils/designs.lisp @@ -331,7 +331,7 @@ Try closing color-intensive applications such as Netscape, or try~%~ setting the colormap X resource to yes to get a private colormap,~%~ then restart your application.") -(eval-when (#-allegro compile load eval) +(eval-when (#-allegro :compile-toplevel :load-toplevel :execute) (define-condition palette-full (error) ((palette :initarg :palette :reader palette-full-palette) (color :initarg :color :reader palette-full-color)) diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp index 5de85be1..3e147bfd 100644 --- a/utils/excl-verification.lisp +++ b/utils/excl-verification.lisp @@ -26,11 +26,11 @@ v5: Fix postscript, GC cursor, Windows text field bugs, speed up (in-package :sys) #+ignore -(eval-when (compile) +(eval-when (:compile-toplevel) (assert (member excl::*current-case-mode* '(:case-insensitive-lower :case-insensitive-upper)))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :clim *features*) (pushnew :clim-2 *features*) (pushnew :clim-2.1 *features*) diff --git a/utils/lisp-package-fixups.lisp b/utils/lisp-package-fixups.lisp index 26475402..ce36809d 100644 --- a/utils/lisp-package-fixups.lisp +++ b/utils/lisp-package-fixups.lisp @@ -42,7 +42,7 @@ ;;; I left a copy of this form in defsystem.lisp so that defsystem ;;; can be compiled (it has lots of references to LISP: symbols). #+(and ANSI-90 (not Allegro)) -(eval-when (eval compile load) +(eval-when (:execute :compile-toplevel :load-toplevel) (flet ((fix-package (pack-name add-name) (setq add-name (string add-name)) (let ((pack (find-package pack-name))) @@ -65,7 +65,7 @@ ;;; is really to add the ANSI names COMMON-LISP and COMMON-LISP-USER ;;; to the LISP and USER packages found in non-ANSI Lisps. #-(or Allegro aclpc) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (flet ((clean-up-package (old-package-name primary-name required-nicknames) (let* ((package (or (find-package old-package-name) (find-package primary-name))) diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp index 9a2695d9..97a06f5b 100644 --- a/utils/lisp-utilities.lisp +++ b/utils/lisp-utilities.lisp @@ -48,7 +48,7 @@ (reverse ,run-time-vals)) ,wrapped-body))))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun decode-once-only-arguments (variables) (let ((vars nil) (env nil) @@ -399,7 +399,7 @@ (defvar *gensymbol* 0) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun gensymbol (&rest parts) (declare (dynamic-extent parts)) (when (null parts) (setf parts '(gensymbol))) @@ -507,11 +507,11 @@ (when ,condition-value (setf ,@unwind-forms))))))) #-(and ansi-90 (not allegro) (not Symbolics)) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(declaration non-dynamic-extent))) #+aclpc -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(declaration non-dynamic-extent ignorable))) #+(and ansi-90 (not allegro) (not aclpc) (not Symbolics)) @@ -924,7 +924,7 @@ (let ((function-name (make-symbol (cl:format nil "~A-~A-~A" symbol indicator 'property)))) `(progn (defun ,function-name ,lambda-list ,@body) - (eval-when (load eval) (setf (get ',symbol ',indicator) #',function-name))))) + (eval-when (:load-toplevel :execute) (setf (get ',symbol ',indicator) #',function-name))))) (defmacro do-delimited-substrings (((string &key (start 0) end) (start-index-var end-index-var &optional char-var)) @@ -1266,7 +1266,7 @@ (find-class name errorp environment))) #+(and allegro never-never-and-never) -(eval-when (compile) +(eval-when (:compile-toplevel) (warn "~S hacked for lack of environment support in 4.1" 'find-class-that-works)) diff --git a/utils/lucid-stream-functions.lisp b/utils/lucid-stream-functions.lisp index 160afb29..3c54fc90 100644 --- a/utils/lucid-stream-functions.lisp +++ b/utils/lucid-stream-functions.lisp @@ -15,7 +15,7 @@ ;;; just for development #+ignore -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defparameter sym-list '("PEEK-CHAR" "READ-BYTE" "READ-CHAR" "UNREAD-CHAR" "READ-CHAR-NO-HANG" "LISTEN" "READ-LINE" "CLEAR-INPUT" "WRITE-BYTE" "WRITE-CHAR" @@ -200,7 +200,7 @@ ;;; Higher level lisp printing functions. -(eval-when (load) +(eval-when (:load-toplevel) (let ((original-lucid-closure (or (getf (symbol-plist 'lisp:format) :original-lucid-closure) (setf (getf (symbol-plist 'lisp:format) :original-lucid-closure) diff --git a/utils/packages.lisp b/utils/packages.lisp index 2c2f43d4..cdab7f39 100644 --- a/utils/packages.lisp +++ b/utils/packages.lisp @@ -3005,7 +3005,7 @@ modifier-key-index-name)) #+(or aclpc acl86win32) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (intern '#:non-dynamic-extent (find-package :clim-utils))) (defpackage clim-silica diff --git a/utils/processes.lisp b/utils/processes.lisp index 85f57ab7..ac9bf024 100644 --- a/utils/processes.lisp +++ b/utils/processes.lisp @@ -11,7 +11,7 @@ ;;; Locks #+Allegro -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) ;;; (require :mdproc) (require :process)) @@ -231,7 +231,7 @@ (warn "No implementation of MAKE-PROCESS for this system.") )) -(eval-when (compile load eval) (proclaim '(inline processp))) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline processp))) (defun processp (object) #+(and MCL CCL-2) (member object '(:user :event :interrupt)) #+Lucid (lcl:processp object) @@ -265,7 +265,7 @@ #+(and MCL CCL-2) (defvar *current-process* :user) -(eval-when (compile load eval) (proclaim '(inline current-process))) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline current-process))) (defun current-process () #+Lucid lcl:*current-process* #+Allegro mp:*current-process* @@ -280,7 +280,7 @@ #+SBCL sb-thread:*current-thread* ) -(eval-when (compile load eval) (proclaim '(inline all-processes))) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline all-processes))) (defun all-processes () #+Lucid lcl:*all-processes* #+Allegro mp:*all-processes* @@ -299,7 +299,7 @@ #-(or Lucid Genera) (all-processes) ) -(eval-when (compile load eval) (proclaim '(inline process-yield))) +(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline process-yield))) (defun process-yield () #+Lucid (lcl:process-allow-schedule) #+Allegro (mp:process-allow-schedule) diff --git a/utils/protocols.lisp b/utils/protocols.lisp index 178f2f51..f37f2312 100644 --- a/utils/protocols.lisp +++ b/utils/protocols.lisp @@ -28,7 +28,7 @@ (defmacro defprotocol (name supers &rest options) (declare (ignore supers options)) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) (setf (find-protocol ',name) (make-instance 'protocol :name ',name)))) @@ -47,7 +47,7 @@ (defmacro defrole (class supers slots &rest options) (declare (ignore supers options)) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) #+PCL (pcl::do-standard-defsetf ,@(mapcan #'(lambda (slot) @@ -106,7 +106,7 @@ (setq trampoline-extra-args (append (ldiff extra-args keyword-args) (unless (member '&rest extra-args) `(&rest keyword-arguments))))) - `(eval-when (compile eval load) + `(eval-when (:compile-toplevel :execute :load-toplevel) #-VDPCL ,@defgeneric ;PCL's defgeneric fails. (let* ((protocol (find-protocol ',protocol)) (operation diff --git a/utils/utilities.lisp b/utils/utilities.lisp index 68f53561..e15d5b5c 100644 --- a/utils/utilities.lisp +++ b/utils/utilities.lisp @@ -20,7 +20,7 @@ (warn warn-string) nil) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro with-collection (&body body) `(let (($with-collection-result$ nil) $with-collection-tail$) diff --git a/xlib/ffi.lisp b/xlib/ffi.lisp index 2517b838..138a7c41 100644 --- a/xlib/ffi.lisp +++ b/xlib/ffi.lisp @@ -9,11 +9,11 @@ (defmacro def-exported-constant (name value) ;; define the constant and export it from :x11 `(progn - (eval-when (eval load compile) + (eval-when (:execute :load-toplevel :compile-toplevel) (export ',name)) (defconstant ,name ,value))) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defun transmogrify-ff-type (type) (if (consp type) (case (car type) @@ -27,7 +27,7 @@ (defmacro def-exported-foreign-synonym-type (new-name old-name) `(progn - (eval-when (eval load compile) + (eval-when (:execute :load-toplevel :compile-toplevel) (export ',new-name)) (ff::def-c-typedef ,new-name ,@(transmogrify-ff-type old-name)))) @@ -47,7 +47,7 @@ (mapcar #'(lambda (x) (fintern "~A-~A" name (car x))) slots)))) - `(eval-when (eval load compile) + `(eval-when (:execute :load-toplevel :compile-toplevel) (export '(,@(make-exports name) ,@(make-exports array-name))))) ,(flet ((foo-slot (slot) @@ -144,9 +144,9 @@ #-(version>= 6 1) (defmacro def-exported-foreign-function ((name &rest options) &rest args) `(progn - (eval-when (eval load compile) + (eval-when (:execute :load-toplevel :compile-toplevel) (export ',name)) - (eval-when (compile eval load) + (eval-when (:compile-toplevel :execute :load-toplevel) ,(let ((c-name (ff:convert-foreign-name (second (assoc :name options)))) (return-type (or (second (assoc :return-type options)) 'void))) @@ -195,9 +195,9 @@ #+(version>= 6 1) (defmacro def-exported-foreign-function ((name &rest options) &rest args) `(progn - (eval-when (eval load compile) + (eval-when (:execute :load-toplevel :compile-toplevel) (export ',name)) - (eval-when (compile eval load) + (eval-when (:compile-toplevel :execute :load-toplevel) ,(let ((c-name (second (assoc :name options))) (return-type (or (second (assoc :return-type options)) 'void))) -- GitLab