From c643d5ade61b6be3dd88eebd54d742f5a6507a31 Mon Sep 17 00:00:00 2001 From: smh <smh> Date: Wed, 23 Nov 1994 23:29:26 +0000 Subject: [PATCH] See ChangeLog.n Wed Nov 23 13:26:58 1994 Steve Haflich --- ChangeLog.n | 64 ++++ Makefile.defs | 22 +- Makefile.generic | 9 + demo/sysdcl.lisp | 60 ++-- hpgl/sysdcl.lisp | 14 +- misc/climgccursor.c | 39 +-- misc/compile-1.lisp | 75 ++--- misc/dev-load-1.lisp | 74 +++-- postscript/sysdcl.lisp | 22 +- sys/defsystem.lisp | 4 + sys/sysdcl.lisp | 661 +++++++++++++++++-------------------- test/sysdcl.lisp | 21 +- test/testdcl.lisp | 13 +- tk-silica/gc-cursor.lisp | 19 +- tk-silica/xt-graphics.lisp | 10 +- tk/foreign-obj.lisp | 4 +- tk/gcontext.lisp | 4 +- tk/xlib.lisp | 4 +- tk/xt-funs.lisp | 11 +- 19 files changed, 582 insertions(+), 548 deletions(-) diff --git a/ChangeLog.n b/ChangeLog.n index a3d137cd..5fb014bb 100644 --- a/ChangeLog.n +++ b/ChangeLog.n @@ -1,3 +1,67 @@ +Wed Nov 23 13:26:58 1994 Steve Haflich (smh@vapor) + +General notes: + + - Converted to use ACL defsystem so CLIM defsystem is no longer loaded. + - Converted to use "clim2" logical pathname. There may be more changes + to make to support remote source trees, etc., but this tree will at + least build in place. + - Until Colin's process-wait vs dynamic-extent changes are merged, this + version will run without mp and crash with mp. + + * Makefile.defs: + Fix TAGS program and added some missing files to tags rules. + + * Makefile.generic + Load logical pathname translations. + Add missing set-case-mode. + + * demo/sysdcl.lisp + Defsystem and logical pathname conversion. + + * hpgl/sysdcl.lisp + Defsystem and logical pathname conversion. + + * misc/climgccursor.c + Changed the gc hook to conform to 4.2.devel.27 changes. + + * misc/compile-1.lisp + Defsystem and logical pathname conversion. + + * misc/dev-load-1.lisp + Defsystem and logical pathname conversion. + + * postscript/sysdcl.lisp + Defsystem and logical pathname conversion. + + * sys/defsystem.lisp + Added warning in case file is ever loaded -- should never be. + + * sys/sysdcl.lisp + Defsystem and logical pathname conversion. + Removed bogus pathname frobbing. + + * test/sysdcl.lisp + Defsystem and logical pathname conversion. + + * test/testdcl.lisp + Defsystem and logical pathname conversion. + + * tk/foreign-obj.lisp + * tk/gcontext.lisp + * tk/xlib.lisp + Clos extension key changed from :fixed-index to clos::fixed-index. + + * tk/xt-funs.lisp + Gc-cursor changes. + + * tk-silica/gc-cursor.lisp + Gc-cursor changes. + + * tk-silica/xt-graphics.lisp + Clos extension key changed from :fixed-index to clos::fixed-index. + + (for 4.2.devel.26 merge): Tue Jun 7 23:44:53 1994 Duane Rettig (duane at clay) diff --git a/Makefile.defs b/Makefile.defs index 113e90f3..935a4781 100644 --- a/Makefile.defs +++ b/Makefile.defs @@ -13,7 +13,7 @@ DEVICE = /dev/null RM = /bin/rm CAT = /bin/cat ECHO = /bin/echo -TAGS = /usr/fi/lib/emacs/etc/etags +TAGS = /usr/fi/etags # /tmp is either on /usr (in which case it points to /usr/tmp) or is on the # root filesystem, which is probably really small. So, use /usr/tmp. TMP = /usr/tmp @@ -393,7 +393,11 @@ POSTSCRIPT_CLIM= postscript/postscript-port.fasl \ HPGL_OBJS= hpgl/pkg.fasl hpgl/hpgl-port.fasl hpgl/hpgl-medium.fasl # Used for tags -ALL_SRC = utils/excl-verification.lisp \ +ALL_SRC = sys/defsystem.lisp \ + sys/distribution-script.lisp \ + sys/load-clim2.lisp \ + sys/sysdcl.lisp \ + utils/excl-verification.lisp \ utils/lisp-package-fixups.lisp \ utils/defpackage.lisp \ utils/packages.lisp \ @@ -546,8 +550,18 @@ ALL_SRC = utils/excl-verification.lisp \ tk/ol-callbacks.lisp \ tk-silica/ol-silica.lisp \ tk-silica/ol-frames.lisp \ - tk-silica/ol-gadgets.lisp - + tk-silica/ol-gadgets.lisp \ + misc/MyDrawingA.c \ + misc/MyDrawingA.h \ + misc/MyDrawingAP.h \ + misc/climgccursor.c \ + misc/olsupport.c \ + misc/xtsupport.c \ + xlib/xlibsupport.c \ + stub-xt.c \ + stub-x.c \ + stub-motif.c \ + misc/clos-preload.cl GENERIC-OBJS= $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) $(CLIM-STANDALONE-OBJS) MOTIF-OBJS = $(LOAD-XM-OBJS) $(XT-TK-OBJS) $(XM-TK-OBJS) $(MOTIF-CLIM-OBJS) diff --git a/Makefile.generic b/Makefile.generic index 690145a3..ff5de2a8 100644 --- a/Makefile.generic +++ b/Makefile.generic @@ -22,10 +22,13 @@ compile-xm: $(MOTIF_OBJS) FORCE (si::system-compile-wrapper \ (function \ (lambda () \ + (load-logical-pathname-translations \"clim2\") \ (setq *compile-print* $(COMPILE_PRINT)) \ (setq sys::*libxt-pathname* \"$(XTLIB)\") \ (setq sys::*libx11-pathname* \"$(XLIB)\") \ (setq sys::*clim-motif-pathname* \"clim-motif$(DEBUGLIB).o\") \ + (setq *ignore-package-name-case* t) \ + (set-case-mode :case-insensitive-lower) \ (load \"misc/compile-1.lisp\") \ (compile-it 'motif-clim))) \ :speed $(SPEED) :debug $(DEBUG) :safety $(SAFETY) \ @@ -41,6 +44,7 @@ compile-ol: $(OPENLOOK_OBJS) FORCE (si::system-compile-wrapper \ (function \ (lambda () \ + (load-logical-pathname-translations \"clim2\") \ (setq *compile-print* $(COMPILE_PRINT)) \ (setf excl:*load-xref-info* $(LOAD_XREF_INFO)) \ (setq sys::*libxt-pathname* \"$(OLXTLIB)\") \ @@ -146,6 +150,7 @@ tk/xm-defs.fasl : tk/xm-defs.lisp clim-xm: FORCE $(MOTIF_OBJS) -$(RM) -f $(CLIMXM) $(ECHO) " \ + (load-logical-pathname-translations \"clim2\") \ (setq sys::*libxt-pathname* \"$(XTLIB)\") \ (setq sys::*libx11-pathname* \"$(XLIB)\") \ (setq sys::*clim-motif-pathname* \"clim-motif$(DEBUGLIB).o\") \ @@ -162,6 +167,7 @@ clim-xm: FORCE $(MOTIF_OBJS) clim-ol: FORCE $(OPENLOOK_OBJS) -$(RM) -f $(CLIMOL) $(ECHO) " \ + (load-logical-pathname-translations \"clim2\") \ (setq sys::*libxt-pathname* \"$(OLXTLIB)\") \ (setq sys::*libx11-pathname* \"$(OLXLIB)\") \ (setq sys::*clim-olit-pathname* \"clim-olit$(DEBUGLIB).o\") \ @@ -177,6 +183,7 @@ clim-ol: FORCE $(OPENLOOK_OBJS) clim-small: FORCE $(ECHO) " \ + (load-logical-pathname-translations \"clim2\") \ (load \"misc/load-xm.lisp\") \ (setq sys::*clim-dump-name* \"$(TMP)/clim.temp_`whoami`\") \ (load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch -backtrace-on-error @@ -195,6 +202,7 @@ train : FORCE train-xm: FORCE $(ECHO) " \ + (load-logical-pathname-translations \"clim2\") \ (setq sys::*libxt-pathname* \"$(XTLIB)\") \ (setq sys::*libx11-pathname* \"$(XLIB)\") \ (setq sys::*clim-motif-pathname* \"clim-motif$(DEBUGLIB).o\") \ @@ -206,6 +214,7 @@ train-xm: FORCE train-ol: FORCE $(ECHO) " \ + (load-logical-pathname-translations \"clim2\") \ (setq sys::*libxt-pathname* \"$(OLXTLIB)\") \ (setq sys::*libx11-pathname* \"$(OLXLIB)\") \ (setq sys::*clim-olit-pathname* \"clim-olit$(DEBUGLIB).o\") \ diff --git a/demo/sysdcl.lisp b/demo/sysdcl.lisp index a795bc9c..725faa27 100644 --- a/demo/sysdcl.lisp +++ b/demo/sysdcl.lisp @@ -7,39 +7,37 @@ "Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." -(clim-defsys:defsystem clim-demo - (:default-pathname #+Genera "SYS:CLIM;REL-2;DEMO;" - #-Genera (frob-pathname "demo") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;DEMO;" - #-Genera (frob-pathname "demo")) - - ("packages") - ("demo-driver" :load-before-compile ("packages")) - ("listener" :load-before-compile ("demo-driver" "packages")) - ("graphics-demos" :load-before-compile ("demo-driver" "packages")) - ("cad-demo" :load-before-compile ("demo-driver" "packages")) - ("navdata" :load-before-compile ("packages")) - ("navfun" :load-before-compile ("demo-driver" "packages" "navdata")) - ("puzzle" :load-before-compile ("demo-driver" "packages")) - ("address-book" :load-before-compile ("demo-driver" "packages")) - ("thinkadot" :load-before-compile ("demo-driver" "packages")) - ("plot" :load-before-compile ("demo-driver" "packages")) - ("color-editor" :load-before-compile ("demo-driver" "packages")) - ("graphics-editor" :load-before-compile ("demo-driver" "packages")) - ("bitmap-editor" :load-before-compile ("demo-driver" "packages")) - ("ico" :load-before-compile ("demo-driver" "packages")) - ("browser" :load-before-compile ("demo-driver" "packages")) - ("peek-frame" :load-before-compile ("demo-driver" "packages")) - #+Allegro - ("process-browser" :load-before-compile ("demo-driver" "packages")) - ("custom-records" :load-before-compile ("demo-driver" "packages")) - ("demo-activity" :load-before-compile ("demo-driver" "packages")) - #+Allegro - ("demo-last") - ("demo-prefill" :features (or Genera Cloe-Runtime))) +(defsystem clim-demo + (:default-pathname "clim2:;demo;") + (:serial + ("packages") + ("demo-driver" (:load-before-compile "packages")) + ("listener" (:load-before-compile "demo-driver" "packages")) + ("graphics-demos" (:load-before-compile "demo-driver" "packages")) + ("cad-demo" (:load-before-compile "demo-driver" "packages")) + ("navdata" (:load-before-compile "packages")) + ("navfun" (:load-before-compile "demo-driver" "packages" "navdata")) + ("puzzle" (:load-before-compile "demo-driver" "packages")) + ("address-book" (:load-before-compile "demo-driver" "packages")) + ("thinkadot" (:load-before-compile "demo-driver" "packages")) + ("plot" (:load-before-compile "demo-driver" "packages")) + ("color-editor" (:load-before-compile "demo-driver" "packages")) + ("graphics-editor" (:load-before-compile "demo-driver" "packages")) + ("bitmap-editor" (:load-before-compile "demo-driver" "packages")) + ("ico" (:load-before-compile "demo-driver" "packages")) + ("browser" (:load-before-compile "demo-driver" "packages")) + ("peek-frame" (:load-before-compile "demo-driver" "packages")) + #+Allegro + ("process-browser" (:load-before-compile "demo-driver" "packages")) + ("custom-records" (:load-before-compile "demo-driver" "packages")) + ("demo-activity" (:load-before-compile "demo-driver" "packages")) + #+Allegro + ("demo-last") + #+(or Genera Cloe-Runtime) ("demo-prefill") + )) #+Genera -(clim-defsys:import-into-sct 'clim-demo +(clim-defsys:import-into-sct 'clim-demo :pretty-name "CLIM Demo" :default-pathname "SYS:CLIM;REL-2;DEMO;" :required-systems '(clim)) diff --git a/hpgl/sysdcl.lisp b/hpgl/sysdcl.lisp index 70f1164b..1439ca7d 100644 --- a/hpgl/sysdcl.lisp +++ b/hpgl/sysdcl.lisp @@ -6,10 +6,10 @@ "Copyright (c) 1993 Franz Inc. All rights reserved" -(clim-defsys:defsystem hpgl-clim - (:default-pathname (frob-pathname "hpgl") - :default-binary-pathname (frob-pathname "hpgl") - :load-before-compile (clim-standalone)) - ("pkg") - ("hpgl-port") - ("hpgl-medium")) +(defsystem hpgl-clim + (:default-pathname "clim2:;hpgl;") + (:serial + clim-standalone + ("pkg") + ("hpgl-port") + ("hpgl-medium"))) diff --git a/misc/climgccursor.c b/misc/climgccursor.c index 945187e0..e0663915 100644 --- a/misc/climgccursor.c +++ b/misc/climgccursor.c @@ -7,8 +7,8 @@ static Widget gc_widget = (Widget)NULL; static Cursor widget_cursor = 0; -extern int (*gc_before)(),(*gc_after)(); -static int (*old_gc_before)(),(*old_gc_after)(); +/* extern int (*gc_before)(),(*gc_after)(); */ +/* static int (*old_gc_before)(),(*old_gc_after)(); */ static find_font_cursor (cursor) int cursor; @@ -54,14 +54,14 @@ Cursor cursor; clim_starting_gc() { - if (old_gc_before) (*old_gc_before)(); - set_the_cursor(find_font_cursor(XC_watch)); + /* if (old_gc_before) (*old_gc_before)(); */ + set_the_cursor(find_font_cursor(XC_watch)); } clim_stopping_gc() { - set_the_cursor(widget_cursor); - if (old_gc_after) (*old_gc_after)(); + set_the_cursor(widget_cursor); + /* if (old_gc_after) (*old_gc_after)(); */ } @@ -75,28 +75,17 @@ int *call_data; } } -init_clim_gc_cursor_stuff(state) -int state; +init_clim_gc_cursor_stuff(vec) + int *vec; { - static int current_state = 0; - if (state != current_state) { - if (state) { - old_gc_before= old_gc_before; - gc_before = clim_starting_gc; - old_gc_after = gc_after; - gc_after = clim_stopping_gc; - signal(SIGPIPE, SIG_IGN); - - } - else { - gc_before = old_gc_before; - gc_after = old_gc_after; - } - } - - current_state = state; + if (vec) { + vec[0] = clim_starting_gc; + vec[1] = clim_stopping_gc; + } + /* Currently nothing to do to stop gc cursor. */ } + set_clim_gc_cursor_widget(widget, cursor) Widget widget; Cursor cursor; diff --git a/misc/compile-1.lisp b/misc/compile-1.lisp index 00615e2d..401925de 100644 --- a/misc/compile-1.lisp +++ b/misc/compile-1.lisp @@ -1,7 +1,7 @@ ;; -*- mode: common-lisp; package: user -*- ;; -;; -[Wed Sep 15 18:09:45 1993 by duane]- -;; +;; -[Thu Nov 10 02:16:15 1994 by smh]- +;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. ;; @@ -27,6 +27,9 @@ ;;;; This should not matter ;;;; (setq *ignore-package-name-case* t) +;; Forgive them, lord, for they know not what they do. +(pushnew :ansi-90 *features*) + (set-case-mode :case-insensitive-lower) #+ignore @@ -41,7 +44,7 @@ (setf (sys:gsgc-switch :stats) t)) (setq comp:generate-call-count-code-switch - (named-function |(> debug 1)| + (named-function |(> debug 1)| (lambda (safety size speed debug) (declare (ignore safety size speed)) (> debug 1)))) @@ -51,50 +54,48 @@ (declare (ignore safety size debug)) (> speed 2)))) -(unless (find-package 'clim-defsystem) - (compile-file-if-needed "sys/defsystem") - (let ((*enable-package-locked-errors* nil)) - (load "sys/defsystem"))) - - +;(unless (find-package 'clim-defsystem) +; (compile-file-if-needed "sys/defsystem") +; (let ((*enable-package-locked-errors* nil)) +; (load "sys/defsystem"))) (defun compile-it (sys) (let ((excl::*update-entry-points* nil)) - (unless (ignore-errors (clim-defsys::find-system sys)) - (load "sys/sysdcl")) - (clim-defsys::compile-system sys :propagate t) + (unless (ignore-errors (excl:find-system 'sys)) + (load "clim2:;sys;sysdcl")) + (excl:compile-system sys :include-components t) (tenuring - (clim-defsys::load-system sys)) + (excl:load-system sys)) + + (load "clim2:;postscript;sysdcl") + (excl:compile-system 'postscript-clim :include-components t) + (excl:load-system 'postscript-clim) - (load "postscript/sysdcl") - (clim-defsys::compile-system 'postscript-clim :propagate t) - (clim-defsys::load-system 'postscript-clim) + (compile-file-if-needed "clim2:;test;test-suite") - (compile-file-if-needed "test/test-suite") + (load "clim2:;test;test-suite") + + (load "clim2:;demo;sysdcl") + (excl:compile-system 'clim-demo :include-components t) + (excl:load-system 'clim-demo) - (load "test/test-suite") - - (load "demo/sysdcl") - (clim-defsys::compile-system 'clim-demo :propagate t) - (clim-defsys::load-system 'clim-demo) - (progn - (load "test/testdcl") - (tenuring - (clim-defsys::compile-system 'testing) - (clim-defsys::load-system 'testing))) - - (when (probe-file "climtoys/sysdcl.lisp") - (load "climtoys/sysdcl.lisp") - (clim-defsys::compile-system 'clim-toys)) - + (load "clim2:;test;testdcl") + (tenuring + (excl:compile-system 'testing) + (excl:load-system 'testing))) + + (when (probe-file "clim2:;climtoys;sysdcl.lisp") + (load "clim2:;climtoys;sysdcl.lisp") + (excl:compile-system 'clim-toys)) + #+ignore (load "compatibility/sysdcl.lisp") - #+ignore (clim-defsys::compile-system 'clim-compatibility :propagate t) + #+ignore (excl:compile-system 'clim-compatibility :include-components t) + + (load "clim2:;hpgl;sysdcl") + (excl:compile-system 'hpgl-clim :include-components t) + (excl:load-system 'hpgl-clim) - (load "hpgl/sysdcl") - (clim-defsys::compile-system 'hpgl-clim :propagate t) - (clim-defsys::load-system 'hpgl-clim) - )) diff --git a/misc/dev-load-1.lisp b/misc/dev-load-1.lisp index 6feaa960..f1963f41 100644 --- a/misc/dev-load-1.lisp +++ b/misc/dev-load-1.lisp @@ -1,7 +1,7 @@ ;; -*- mode: common-lisp; package: user -*- ;; -;; -[Wed Sep 15 18:09:43 1993 by duane]- -;; +;; -[Thu Nov 10 11:24:22 1994 by smh]- +;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. ;; @@ -25,15 +25,18 @@ ;;;; This should not matter ;;;; (setq *ignore-package-name-case* t) +;; Forgive them, lord, for they know not what they do. +(pushnew :ansi-90 *features*) + (set-case-mode :case-insensitive-lower) (tenuring (let ((*load-source-file-info* t) (*record-source-file-info* t) (*load-xref-info* nil)) - (let ((*enable-package-locked-errors* nil)) - (load "sys/defsystem")) - (load "sys/sysdcl"))) + #+never (let ((*enable-package-locked-errors* nil)) + (load "sys/defsystem")) + (load "clim2:;sys;sysdcl"))) (defun load-it (sys &key (load-composer t)) (let ((excl::*update-entry-points* nil) @@ -41,51 +44,52 @@ (*record-source-file-info* t) (*load-xref-info* nil) (excl:*global-gc-behavior* nil)) - - (tenuring + + (tenuring (ecase sys (motif-clim - (load "climg.fasl") - (load "climxm.fasl") - (load "clim-debug.fasl") - (load "clim-debugxm.fasl")) + (load "clim2:;climg.fasl") + (load "clim2:;climxm.fasl") + (load "clim2:;clim-debug.fasl") + (load "clim2:;clim-debugxm.fasl")) (openlook-clim - (load "climg.fasl") - (load "climol.fasl") - (load "clim-debug.fasl") - (load "clim-debugol.fasl"))) + (load "clim2:;climg.fasl") + (load "clim2:;climol.fasl") + (load "clim2:;clim-debug.fasl") + (load "clim2:;clim-debugol.fasl"))) (tenuring - (load "climps.fasl") - (load "climhpgl.fasl") - (load "climdemo.fasl")) + (load "clim2:;climps.fasl") + (load "clim2:;climhpgl.fasl") + (load "clim2:;climdemo.fasl")) - (load "postscript/sysdcl") - (load "demo/sysdcl") + (load "clim2:;postscript;sysdcl") + (load "clim2:;demo;sysdcl") (when load-composer - (ignore-errors - (tenuring + (ignore-errors + (tenuring (require :composer)))) (progn - (load "test/testdcl") - (tenuring - (clim-defsys::load-system 'testing))) + (load "clim2:;test;testdcl") + (tenuring + (excl:load-system 'testing))) - (when (probe-file "climtoys/sysdcl.lisp") - (load "climtoys/sysdcl.lisp") - (clim-defsys::compile-system 'clim-toys) - (tenuring - (clim-defsys::load-system 'clim-toys))) + (when (probe-file "clim2:;climtoys;sysdcl.lisp") + (load "clim2:;climtoys;sysdcl.lisp") + (excl:compile-system 'clim-toys) + (tenuring + (excl:load-system 'clim-toys))) - (clim-defsys::fake-load-system - (cons sys '(postscript-clim clim-demo)) + #+never + (clim-defsys::fake-load-system + (cons sys '(postscript-clim clim-demo)) :recurse t) - + (ignore-errors (load (case sys - (motif-clim "climxm-preload.fasl") - (openlook-clim "climol-preload.fasl")) + (motif-clim "clim2:;climxm-preload.fasl") + (openlook-clim "clim2:;climol-preload.fasl")) :if-does-not-exist nil))))) diff --git a/postscript/sysdcl.lisp b/postscript/sysdcl.lisp index 8749866d..981682fb 100644 --- a/postscript/sysdcl.lisp +++ b/postscript/sysdcl.lisp @@ -6,18 +6,16 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." -(clim-defsys:defsystem postscript-clim - (:default-pathname #+Genera "SYS:CLIM;REL-2;POSTSCRIPT;" - #-Genera (frob-pathname "postscript") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;POSTSCRIPT;" - #-Genera (frob-pathname "postscript") - :load-before-compile (clim-standalone)) - ("pkgdcl") - #+Allegro ("postscript-s") - ("postscript-port") - ("postscript-medium") - ("read-afm") - ("laserwriter-metrics")) +(defsystem postscript-clim + (:default-pathname "clim2:;postscript;") + (:serial + clim-standalone + ("pkgdcl") + #+Allegro ("postscript-s") + ("postscript-port") + ("postscript-medium") + ("read-afm") + ("laserwriter-metrics"))) #+Genera (clim-defsys:import-into-sct 'postscript-clim diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp index 8616d26e..9704582f 100644 --- a/sys/defsystem.lisp +++ b/sys/defsystem.lisp @@ -34,6 +34,10 @@ ;; Yes, I know it's not yet an ANSI spec. That's why this is called ;; ANSI-90, corresponding to what we think the spec will be, in late 1990. +(eval-when (compile load eval) + (warn "This file is no longer used in the Allegro port. \ +Something is wrong if this warning appears!")) + #+(or CCL-2 Allegro Minima) ;Have to assume this won't blow up anybody's lisp (eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :ansi-90 *features*)) diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp index 36b8c920..b728c503 100644 --- a/sys/sysdcl.lisp +++ b/sys/sysdcl.lisp @@ -56,7 +56,7 @@ (eval-when (compile load eval) -#+(or Allegro +#+(or Allegro Minima) (pushnew :clim-uses-lisp-stream-classes *features*) @@ -87,372 +87,320 @@ ) ;eval-when -(setq clim-defsys:*load-all-before-compile* t) - -#-Genera -(defun frob-pathname (subdir - &optional (dir #+Allegro excl::*source-pathname* - #+Lucid lcl::*source-pathname* - #+Cloe-Runtime #p"E:\\CLIM2\\SYS\\SYSDCL.LSP" - #-(or Allegro Lucid Cloe-Runtime) - (or *compile-file-pathname* - *load-pathname*))) - (namestring - (make-pathname - :defaults dir - :directory (append (butlast (pathname-directory dir)) (list subdir))))) - -#+Genera -(defun frob-pathname (subdir &optional (dir sys:fdefine-file-pathname)) - (namestring - (make-pathname - :defaults dir - :directory (append (butlast (pathname-directory dir)) - (mapcar #'string-upcase (list subdir)))))) +;#-Allegro (setq clim-defsys:*load-all-before-compile* t) +; +;#-Genera +;(defun frob-pathname (subdir +; &optional (dir #+Allegro excl::*source-pathname* +; #+Lucid lcl::*source-pathname* +; #+Cloe-Runtime #p"E:\\CLIM2\\SYS\\SYSDCL.LSP" +; #-(or Allegro Lucid Cloe-Runtime) +; (or *compile-file-pathname* +; *load-pathname*))) +; (namestring +; (make-pathname +; :defaults dir +; :directory (append (butlast (pathname-directory dir)) (list subdir))))) +; +;#+Genera +;(defun frob-pathname (subdir &optional (dir sys:fdefine-file-pathname)) +; (namestring +; (make-pathname +; :defaults dir +; :directory (append (butlast (pathname-directory dir)) +; (mapcar #'string-upcase (list subdir)))))) -(clim-defsys:defsystem clim-utils - (:default-pathname #+Genera "SYS:CLIM;REL-2;UTILS;" - #-Genera (frob-pathname "utils") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;UTILS;" - #-Genera (frob-pathname "utils")) +(defsystem clim-utils + (:default-pathname "clim2:;utils;") ;; These files establish a uniform Lisp environment - ("excl-verification" :features Allegro) - ("lucid-before" :features lucid) - ("lisp-package-fixups") - ("defpackage" :features (or Allegro (not ANSI-90))) - ("packages") - ("coral-char-bits" :features CCL-2) - ("defun-utilities") ;; extract-declarations and friends - ("defun" :features (or Genera (not ANSI-90))) - ("reader") - ("clos-patches") - ("clos") - ("condpat" :features CLIM-conditions) ;get the define-condition macro - - ;; General Lisp extensions - ("utilities") - ("lisp-utilities") - ("processes") - ("queue") - ("timers" :load-before-compile ("queue" "processes")) - ("protocols") - - ;; Establish a uniform stream model - ("clim-streams") - ("cl-stream-classes" :features (not clim-uses-lisp-stream-classes)) - ("minima-stream-classes" :features Minima) - ("cl-stream-functions" :features (and (not clim-uses-lisp-stream-functions) (not Lucid))) - ("lucid-stream-functions" :features Lucid) - ("genera-streams" :features Genera) - ("excl-streams" :features Allegro) - ("ccl-streams" :features CCL-2) - - ;; Basic utilities for Silica and CLIM - ("clim-macros") - ("transformations" :load-before-compile ("condpat")) - ("regions") - ("region-arithmetic") - ("extended-regions") - ("base-designs") - ("designs")) - -(clim-defsys:defsystem clim-silica - (:default-pathname #+Genera "SYS:CLIM;REL-2;SILICA;" - #-Genera (frob-pathname "silica") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;SILICA;" - #-Genera (frob-pathname "silica") - :needed-systems (clim-utils) - :load-before-compile (clim-utils)) - ;; "Silica" - ("macros") - ("classes") - ("text-style") - ("sheet") - ("mirror") - ("event") - ("port") - ("medium") - ("framem") - ("graphics") - ("pixmaps") - ("std-sheet") - - ;; "Windshield", aka "DashBoard" + (:serial + "excl-verification" + #+lucid "lucid-before" + "lisp-package-fixups" + #+(or Allegro (not ANSI-90)) "defpackage" + "packages" + #+CCL-2 "coral-char-bits" + "defun-utilities" ;; extract-declarations and friends + #+(or Genera (not ANSI-90)) "defun" + "reader" + "clos-patches" + "clos" + #+CLIM-conditions "condpat" ;get the define-condition macro + + ;; General Lisp extensions + "utilities" + "lisp-utilities" + "processes" + "queue" + ("timers" (:load-before-compile "queue" "processes")) + "protocols" + + ;; Establish a uniform stream model + "clim-streams" + #-clim-uses-lisp-stream-classes "cl-stream-classes" + #+Minima "minima-stream-classes" + #+(and (not clim-uses-lisp-stream-functions) (not Lucid)) "cl-stream-functions" + #+Lucid "lucid-stream-functions" + #+Genera "genera-streams" + #+Allegro "excl-streams" + #+CCL-2 "ccl-streams" + + ;; Basic utilities for Silica and CLIM + "clim-macros" + ("transformations" #+CLIM-conditions (:load-before-compile "condpat")) + "regions" + "region-arithmetic" + "extended-regions" + "base-designs" + "designs" + )) + +(defsystem clim-silica + (:default-pathname "clim2:;silica;") + (:serial + clim-utils + + ;; "Silica" + "macros" + "classes" + "text-style" + "sheet" + "mirror" + "event" + "port" + "medium" + "framem" + "graphics" + "pixmaps" + "std-sheet" + + ;; "Windshield", aka "DashBoard" ;; First the layout gadgets - ("layout") - ("db-layout") - ("db-box") - ("db-table") - - ;; Then the "physical" gadgets - ("gadgets") - ("db-border") - ("db-scroll") - ("scroll-pane") - ("db-button") - ("db-label" - :load-before-compile ("db-border")) - ("db-slider")) - -(clim-defsys:defsystem clim-standalone - (:default-pathname #+Genera "SYS:CLIM;REL-2;CLIM;" - #-Genera (frob-pathname "clim") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;CLIM;" - #-Genera (frob-pathname "clim") - :needed-systems (clim-utils clim-silica) - :load-before-compile (clim-utils clim-silica)) - - ;; Basic tools - ("gestures") - ("defprotocol") - ("stream-defprotocols") - ("defresource") - ("temp-strings") - ("coral-defs" :features CCL-2) - ("clim-defs") - - ;; Definitions and protocols - ("stream-class-defs") - ("interactive-defs") - ("cursor") - ("view-defs") - ("input-defs") - ("input-protocol") - ("output-protocol") - - ;; Output recording - ("recording-defs" - :load-before-compile ("clim-defs")) - ("formatted-output-defs") - ("recording-protocol" - :load-before-compile ("recording-defs")) - ("text-recording" - :load-before-compile ("recording-protocol")) - ("graphics-recording" - :load-before-compile ("recording-protocol")) - ("design-recording" - :load-before-compile ("graphics-recording")) - - ;; Input editing - ("interactive-protocol" - :load-before-compile ("clim-defs")) - ("input-editor-commands") - - ;; Incremental redisplay - ("incremental-redisplay" - :load-before-compile ("clim-defs" "recording-protocol")) - - ;; Windows - ("coordinate-sorted-set") - ("r-tree") - ("window-stream") - ("pixmap-streams") - - ;; Presentation types - ("ptypes1" - :load-before-compile ("clim-defs")) - ("completer" - :load-before-compile ("ptypes1")) - ("presentations" - :load-before-compile ("ptypes1")) - ("translators" - :load-before-compile ("presentations")) - ("histories" - :load-before-compile ("presentations")) - ("ptypes2" - :load-before-compile ("translators")) - ("standard-types" - :load-before-compile ("ptypes2")) - ("excl-presentations" - :load-before-compile ("presentations") - :features Allegro) - - ;; Formatted output - ("table-formatting" - :load-before-compile ("clim-defs" "incremental-redisplay")) - ("graph-formatting" - :load-before-compile ("clim-defs" "incremental-redisplay")) - ("surround-output" - :load-before-compile ("clim-defs" "incremental-redisplay")) - ("text-formatting" - :load-before-compile ("clim-defs" "incremental-redisplay")) - - ;; Pointer tracking - ("tracking-pointer") - ("dragging-output" - :load-before-compile ("tracking-pointer")) - - ;; Gadgets - ("db-stream") - ("gadget-output") - - ;; Application building substrate - ("accept" - :load-before-compile ("clim-defs" "ptypes2")) - ("present" - :load-before-compile ("clim-defs" "ptypes2")) - ("command" - :load-before-compile ("clim-defs" "ptypes2")) - ("command-processor" - :load-before-compile ("clim-defs" "command")) - ("basic-translators" - :load-before-compile ("ptypes2" "command")) - ("frames" - :load-before-compile ("clim-defs" "command-processor")) - ("default-frame" - :load-before-compile ("frames")) - ("activities" - :load-before-compile ("frames")) - ("db-menu" - :load-before-compile ("frames")) - ("db-list" - :load-before-compile ("db-menu")) - ("db-text" - :load-before-compile ("frames")) - ("noting-progress" - :load-before-compile ("frames")) - ("menus" - :load-before-compile ("defresource" "clim-defs")) - ("accept-values" - :load-before-compile ("clim-defs" "incremental-redisplay" "frames")) - ("drag-and-drop" - :load-before-compile ("frames")) - ("item-list-manager") - - ;; Bootstrap everything - ("stream-trampolines" - :load-before-compile ("defprotocol" "stream-defprotocols")) - ("lucid-after" :features lucid) - ("prefill" :features (or Genera Cloe-Runtime))) + "layout" + "db-layout" + "db-box" + "db-table" + + ;; Then the "physical" gadgets + "gadgets" + "db-border" + "db-scroll" + "scroll-pane" + "db-button" + ("db-label" (:load-before-compile "db-border")) + "db-slider" + )) + +(defsystem clim-standalone + (:default-pathname "clim2:;clim;") + (:serial + clim-utils + clim-silica + + ;; Basic tools + "gestures" + "defprotocol" + "stream-defprotocols" + "defresource" + "temp-strings" + #+CCL-2 "coral-defs" + "clim-defs" + + ;; Definitions and protocols + "stream-class-defs" + "interactive-defs" + "cursor" + "view-defs" + "input-defs" + "input-protocol" + "output-protocol" + + ;; Output recording + ("recording-defs" (:load-before-compile "clim-defs")) + "formatted-output-defs" + ("recording-protocol" (:load-before-compile "recording-defs")) + ("text-recording" (:load-before-compile "recording-protocol")) + ("graphics-recording" (:load-before-compile "recording-protocol")) + ("design-recording" (:load-before-compile "graphics-recording")) + + ;; Input editing + ("interactive-protocol" (:load-before-compile "clim-defs")) + "input-editor-commands" + + ;; Incremental redisplay + ("incremental-redisplay" (:load-before-compile "clim-defs" "recording-protocol")) + + ;; Windows + "coordinate-sorted-set" + "r-tree" + "window-stream" + "pixmap-streams" + + ;; Presentation types + ("ptypes1" (:load-before-compile "clim-defs")) + ("completer" (:load-before-compile "ptypes1")) + ("presentations" (:load-before-compile "ptypes1")) + ("translators" (:load-before-compile "presentations")) + ("histories" (:load-before-compile "presentations")) + ("ptypes2" (:load-before-compile "translators")) + ("standard-types" (:load-before-compile "ptypes2")) + #+Allegro ("excl-presentations" (:load-before-compile "presentations")) + + ;; Formatted output + ("table-formatting" (:load-before-compile "clim-defs" "incremental-redisplay")) + ("graph-formatting" (:load-before-compile "clim-defs" "incremental-redisplay")) + ("surround-output" (:load-before-compile "clim-defs" "incremental-redisplay")) + ("text-formatting" (:load-before-compile "clim-defs" "incremental-redisplay")) + + ;; Pointer tracking + "tracking-pointer" + ("dragging-output" (:load-before-compile "tracking-pointer")) + + ;; Gadgets + "db-stream" + "gadget-output" + + ;; Application building substrate + ("accept" (:load-before-compile "clim-defs" "ptypes2")) + ("present" (:load-before-compile "clim-defs" "ptypes2")) + ("command" (:load-before-compile "clim-defs" "ptypes2")) + ("command-processor" (:load-before-compile "clim-defs" "command")) + ("basic-translators" (:load-before-compile "ptypes2" "command")) + ("frames" (:load-before-compile "clim-defs" "command-processor")) + ("default-frame" (:load-before-compile "frames")) + ("activities" (:load-before-compile "frames")) + ("db-menu" (:load-before-compile "frames")) + ("db-list" (:load-before-compile "db-menu")) + ("db-text" (:load-before-compile "frames")) + ("noting-progress" (:load-before-compile "frames")) + ("menus" (:load-before-compile "defresource" "clim-defs")) + ("accept-values" (:load-before-compile "clim-defs" "incremental-redisplay" "frames")) + ("drag-and-drop" (:load-before-compile "frames")) + "item-list-manager" + + ;; Bootstrap everything + ("stream-trampolines" (:load-before-compile "defprotocol" "stream-defprotocols")) + #+lucid "lucid-after" + #+(or Genera Cloe-Runtime) "prefill" + )) #+Allegro -(clim-defsys:defsystem xlib - (:default-pathname #+Genera "SYS:CLIM;REL-2;XLIB;" - #-Genera (frob-pathname "xlib") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;XLIB;" - #-Genera (frob-pathname "xlib") - :needed-systems (clim-standalone) - :load-before-compile (clim-standalone)) - ("pkg") - #+++ignore ("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp" - "xlib/last.lisp"))) - ("ffi") - ("xlib-defs" #|:load-before-compile ("ffi") |#) ; Takes forever to ; compile... - #-svr4 ("load-xlib") - ("xlib-funs" :load-before-compile ("ffi")) - ("x11-keysyms" :load-before-compile ("ffi")) - #-svr4 - ("last" :load-before-compile ("load-xlib" "xlib-funs"))) +(defsystem xlib + (:default-pathname "clim2:;xlib;") + (:serial + clim-standalone + + "pkg" + #+ignore ("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp" + "xlib/last.lisp"))) + "ffi" + ("xlib-defs" #|(:load-before-compile "ffi") |#) ; Takes forever to compile... + #-svr4 ("load-xlib") + ("xlib-funs" (:load-before-compile "ffi")) + ("x11-keysyms" (:load-before-compile "ffi")) + #-svr4 + ("last" (:load-before-compile "load-xlib" "xlib-funs")) + )) #+Allegro (macrolet ((define-xt-system (name file &rest modules) - `(clim-defsys:defsystem ,name - (:default-pathname #+Genera "SYS:CLIM;REL-2;TK;" - #-Genera (frob-pathname "tk") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK;" - #-Genera (frob-pathname "tk") - :needed-systems (xlib) - :load-before-compile (xlib)) - (,file) - #+svr4 - ("last" :pathname - (namestring (merge-pathnames - "last.lisp" - (frob-pathname "xlib"))) - :binary-pathname - (namestring (merge-pathnames - "last.fasl" - (frob-pathname "xlib")))) - ("pkg") - ("macros") - ("xt-defs") ; Used to be 'xtk'. - ("xt-funs") - ("foreign-obj") - ;; Xlib stuff - ("xlib") - ("font") - ("gcontext") - ("graphics") - - ;; Toolkit stuff - ("meta-tk") - ("make-classes") - ("foreign") - ("widget") - ("resources") - ("event") - ("callbacks") - ("xt-classes") - ("xt-init") - ,@modules))) - - (define-xt-system xm-tk "load-xm" - ("xm-defs") - ("xm-funs") - ("xm-classes") - ("xm-callbacks") - ("xm-init") - ("xm-widgets") - ("xm-font-list") - ("xm-protocols") - ("convenience") - ("make-widget")) - - (define-xt-system ol-tk "load-ol" - ("ol-defs") - ("ol-funs") - ("ol-classes") - ("ol-init") - ("ol-widgets") - ("ol-callbacks") - ("make-widget"))) + `(defsystem ,name + (:default-pathname "clim2:;tk;") + (:serial + xlib + (,file) + #+svr4 + ("last" :pathname "clim2:;xlib;") + ("pkg") + ("macros") + ("xt-defs") ; Used to be 'xtk'. + ("xt-funs") + ("foreign-obj") + ;; Xlib stuff + ("xlib") + ("font") + ("gcontext") + ("graphics") + + ;; Toolkit stuff + ("meta-tk") + ("make-classes") + ("foreign") + ("widget") + ("resources") + ("event") + ("callbacks") + ("xt-classes") + ("xt-init") + ,@modules)))) + +(define-xt-system xm-tk "load-xm" + ("xm-defs") + ("xm-funs") + ("xm-classes") + ("xm-callbacks") + ("xm-init") + ("xm-widgets") + ("xm-font-list") + ("xm-protocols") + ("convenience") + ("make-widget")) + +(define-xt-system ol-tk "load-ol" + ("ol-defs") + ("ol-funs") + ("ol-classes") + ("ol-init") + ("ol-widgets") + ("ol-callbacks") + ("make-widget")) + + ) ;macrolet #+Allegro -(clim-defsys:defsystem motif-clim - (:default-pathname #+Genera "SYS:CLIM;REL-2;TK-SILICA;" - #-Genera (frob-pathname "tk-silica") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK-SILICA;" - #-Genera (frob-pathname "tk-silica") - :needed-systems (clim-standalone xm-tk) - :load-before-compile (clim-standalone xm-tk)) - ("pkg") - ("xt-silica") - ("xt-stipples") - ("xm-silica") - ("xt-graphics") - ("image") - ("xt-frames") - ("xm-frames") - ("xm-dialogs") - ("xt-gadgets") - ("xm-gadgets") - ("xt-pixmaps") - ("gc-cursor") - ("last")) +(defsystem motif-clim + (:default-pathname "clim2:;tk-silica;") + (:serial + clim-standalone + xm-tk + + ("pkg") + ("xt-silica") + ("xt-stipples") + ("xm-silica") + ("xt-graphics") + ("image") + ("xt-frames") + ("xm-frames") + ("xm-dialogs") + ("xt-gadgets") + ("xm-gadgets") + ("xt-pixmaps") + ("gc-cursor") + ("last"))) #+Allegro -(clim-defsys:defsystem openlook-clim - (:default-pathname #+Genera "SYS:CLIM;REL-2;TK-SILICA;" - #-Genera (frob-pathname "tk-silica") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TK-SILICA;" - #-Genera (frob-pathname "tk-silica") - :needed-systems (clim-standalone ol-tk) - :load-before-compile (clim-standalone ol-tk)) - ("pkg") - ("xt-silica") - ("xt-stipples") - ("ol-silica") - ("xt-graphics") - ("image") - ("xt-frames") - ("ol-frames") - ("xt-gadgets") - ("ol-gadgets") - ("xt-pixmaps") - ("gc-cursor") - ("last")) +(defsystem openlook-clim + (:default-pathname "clim2:;tk-silica;") + (:serial + clim-standalone + ol-tk + + ("pkg") + ("xt-silica") + ("xt-stipples") + ("ol-silica") + ("xt-graphics") + ("image") + ("xt-frames") + ("ol-frames") + ("xt-gadgets") + ("ol-gadgets") + ("xt-pixmaps") + ("gc-cursor") + ("last"))) #+CCL-2 @@ -560,7 +508,6 @@ #|| -() ;; You get the general idea... (defun clone-CLIM () @@ -597,16 +544,16 @@ (let* ((file (cl:translate-logical-pathname file)) (directory (nthcdr (mismatch dir1 (pathname-directory file) :from-end t) (pathname-directory file))) - (file1 (make-pathname :directory (append dir1 directory) + (file1 (make-pathname :directory (append dir1 directory) :version :newest :defaults file)) (file2 (make-pathname :directory (append dir2 directory) :version :newest :defaults file))) - (when (y-or-n-p "Do comparison for ~A.~A ? " + (when (y-or-n-p "Do comparison for ~A.~A ? " (pathname-name file) (pathname-type file)) (srccom:source-compare file1 file2)) - (when (y-or-n-p "Copy ~A.~A ? " + (when (y-or-n-p "Copy ~A.~A ? " (pathname-name file) (pathname-type file)) (scl:copy-file file1 (make-pathname :version :wild :defaults file2))))))) diff --git a/test/sysdcl.lisp b/test/sysdcl.lisp index ef46b852..6600a5fd 100644 --- a/test/sysdcl.lisp +++ b/test/sysdcl.lisp @@ -4,18 +4,15 @@ "Copyright (c) 1992 Symbolics, Inc. All rights reserved." -(clim-defsys:defsystem clim-tests - (:default-pathname #+Genera "SYS:CLIM;REL-2;TEST;" - #-Genera (frob-pathname "test") - :default-binary-pathname #+Genera "SYS:CLIM;REL-2;TEST;" - #-Genera (frob-pathname "test")) - - ("test-suite") - ("test") - ("test-buttons") - ("test-sliders") - ("simple-test") - ("postscript-tests")) +(defsystem clim-tests + (:default-pathname "clim2:;test;") + (:serial + ("test-suite") + ("test") + ("test-buttons") + ("test-sliders") + ("simple-test") + ("postscript-tests"))) #+Genera (clim-defsys:import-into-sct 'clim-tests diff --git a/test/testdcl.lisp b/test/testdcl.lisp index 59b99268..adf02fff 100644 --- a/test/testdcl.lisp +++ b/test/testdcl.lisp @@ -5,12 +5,11 @@ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) -(clim-defsys:defsystem testing - (:default-pathname (frob-pathname "test") - :default-binary-pathname (frob-pathname "test")) +(defsystem testing + (:default-pathname "clim2:;test;") ("test-pkg") - ("test-driver" :load-before-compile ("test-pkg")) - ("test-clim-tests" :load-before-compile ("test-driver")) - ("test-clim" :load-before-compile ("test-driver")) - ("test-demos" :load-before-compile ("test-driver")) + ("test-driver" (:load-before-compile "test-pkg")) + ("test-clim-tests" (:load-before-compile "test-driver")) + ("test-clim" (:load-before-compile "test-driver")) + ("test-demos" (:load-before-compile "test-driver")) ) diff --git a/tk-silica/gc-cursor.lisp b/tk-silica/gc-cursor.lisp index 98fee42f..7bd5edba 100644 --- a/tk-silica/gc-cursor.lisp +++ b/tk-silica/gc-cursor.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: xm-silica -*- ;; -;; -[]- +;; -[Fri Nov 11 15:11:52 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -26,13 +26,22 @@ (in-package :xm-silica) (defvar *use-clim-gc-cursor* nil) -(defvar *inited-gc-cursor* nil) +(defvar *gc-before* nil) +(defvar *gc-after* nil) (defun init-gc-cursor (frame) (when *use-clim-gc-cursor* - (unless *inited-gc-cursor* - (tk::init_clim_gc_cursor_stuff 1) - (setq *inited-gc-cursor* t)) + (unless *gc-before* ; Do just once. + (let ((vec (vector nil nil))) + (format excl:*initial-terminal-io* "~&Vec before ~s~%" vec) + (tk::init_clim_gc_cursor_stuff vec) + (format excl:*initial-terminal-io* "~&Vec after ~s~%" vec) + (force-output excl:*initial-terminal-io*) + (setq *gc-before* (svref vec 0) + *gc-after* (svref vec 1)) + (pushnew *gc-before* (excl::gc-before-hooks)) + (pushnew *gc-after* (excl::gc-after-hooks)) + )) (let* ((sheet (frame-top-level-sheet frame)) (mirror (and sheet (sheet-direct-mirror sheet)))) (if mirror diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index df18b314..f4398343 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: tk-silica -*- ;; -;; -[Mon Sep 13 18:25:58 1993 by colin]- +;; -[Mon Sep 26 02:04:49 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -25,10 +25,10 @@ (in-package :tk-silica) (defclass ink-gcontext (tk::gcontext) - ((last-clip-region-tick :initform nil :fixed-index 2) - (last-line-style :initform nil :fixed-index 3) - (shift-tile-origin :initform nil :fixed-index 4) - (ink-clip-region :initform nil :fixed-index 5))) + ((last-clip-region-tick :initform nil clos::fixed-index 2) + (last-line-style :initform nil clos::fixed-index 3) + (shift-tile-origin :initform nil clos::fixed-index 4) + (ink-clip-region :initform nil clos::fixed-index 5))) (defmacro ink-gcontext-last-clip-region-tick (gcontext) `(locally (declare (optimize (speed 3) (safety 0))) diff --git a/tk/foreign-obj.lisp b/tk/foreign-obj.lisp index 632aca42..ea7f0e84 100644 --- a/tk/foreign-obj.lisp +++ b/tk/foreign-obj.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- ;; -;; -[]- +;; -[Mon Sep 26 02:02:28 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -29,7 +29,7 @@ (defclass display (ff:foreign-pointer) ((context :initarg :context :reader display-context) (xid->object-mapping :initform (make-hash-table :test #'equal) - :fixed-index 0))) + clos::fixed-index 0))) (defmacro display-xid->object-mapping (object) `(locally (declare (optimize (speed 3) (safety 0))) diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp index 5892c4e1..f0ec9ea9 100644 --- a/tk/gcontext.lisp +++ b/tk/gcontext.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- ;; -;; -[]- +;; -[Mon Sep 26 02:02:53 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -125,7 +125,7 @@ ',name))) (defclass gcontext (display-object) - ((cached-clip-mask :initform nil :fixed-index 1))) + ((cached-clip-mask :initform nil clos::fixed-index 1))) (defmethod initialize-instance :after ((gcontext gcontext) &key diff --git a/tk/xlib.lisp b/tk/xlib.lisp index 61963872..fa035ef7 100644 --- a/tk/xlib.lisp +++ b/tk/xlib.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- ;; -;; -[Mon Jun 21 13:55:59 1993 by colin]- +;; -[Mon Sep 26 02:03:59 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -42,7 +42,7 @@ (defclass display-object (ff:foreign-pointer) ((display :initarg :display - :fixed-index 0))) + clos::fixed-index 0))) (defclass screen (display-object) ()) diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp index 91be82c4..3a8b6cd7 100644 --- a/tk/xt-funs.lisp +++ b/tk/xt-funs.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: xt -*- ;; -;; -[Thu Jul 8 11:51:27 1993 by layer]- +;; -[Thu Nov 10 19:28:13 1994 by smh]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -387,11 +387,12 @@ :return-type :unsigned-integer) (ff:defforeign 'init_clim_gc_cursor_stuff - :call-direct t - :arguments '(fixnum) - :arg-checking nil + ;; :call-direct t + ;; :arguments '(fixnum) + ;; :arg-checking nil :entry-point (ff:convert-to-lang "init_clim_gc_cursor_stuff") - :return-type :unsigned-integer) + ;; :return-type :unsigned-integer + ) (ff:defforeign 'set_clim_gc_cursor_widget :call-direct t -- GitLab