diff --git a/.cvsignore b/.cvsignore index 61eaed77c9a79e786579be18302971162b28893d..a5af790809d82f4409380ad7f58e212bd9c4e358 100755 --- a/.cvsignore +++ b/.cvsignore @@ -12,4 +12,6 @@ stub-xt.c test-suite-reportol.lisp test-suite-reportxm.lisp update.log -compile.out +*.out +*.zip +dist diff --git a/ChangeLog.n b/ChangeLog.n index 007351e325668e192c07af7c68aba8c7c1bd6217..d85f0af94fe03b3ac273fb4df486892fa5ce12e0 100644 --- a/ChangeLog.n +++ b/ChangeLog.n @@ -10,10 +10,229 @@ Tests for new features: <`no new features', `no tests for new features', or <standard changelog date stamp> * <changes go here...> +******************************************************************************* +2.2.2.1 -- join from acl50 branch +next merge tag: acl50_merge2 + ******************************************************************************* 2.2.1.17 -- join from acl50 branch (versions 2.2.1.13 to 2.2.1.16) +(this should have been version 2.2.2.0, but was 2.2.1.17 instead) next merge tag: acl50_merge1 +******************************************************************************* +2.2.1.29 + +Tue Jul 21 09:35:09 1998 Kevin Layer <layer@ultra> + + * buildclim.cl, + * Makefile.generic: remove :print-startup-message argument to + generate-application + +Mon Jul 20 15:00:38 1998 Kevin Layer <layer@ultra> + + * tk-silica/xt-silica.lisp: remove :survive-dumplisp reference + * Makefile.defs: remove climgg.fasl from depends + * Makefile.generic: remove climgg.fasl rule + * hpgl/hpgl-medium.lisp: fix compile time warnings + * hpgl/hpgl-port.lisp: fix compile time warnings + * misc/compile-1.lisp: add back wnn and hpgl module compilation + * tk/gcontext.lisp: fix compile time warnings + +******************************************************************************* +2.2.1.28 + +Mon Jul 20 12:00:00 1998 Jeff Morrill <jmorrill@pointnclick.com> + + * misc/compile-1: don't compile systems that are obsolete or broken + * tk-silica/xm-silica: resolve spr17831 & spr17939 regarding + destroying a widget that is already destroyed + * utils/last: provide :climnt for #+mswindows + * tk-silica/gc-cursor: implement reinitialize-gc-cursor + * silica/db-label: repaint generic label panes correctly + * silica/db-scroll: use method dispatch rather than typep and + confused reader conditionalizations + * aclpc/acl-widget: don't divide by zero when scrolling + * aclpc/acl-scroll: lots of scroll bar fixes + * aclpc/acl-prel: be more careful when printing warnings + in order to avoid recursive warning loop + * aclpc/acl-port: better font mapping + * aclpc/acl-medium: fixes for flipping-ink, pixmaps + * aclpc/acl-frames: fixes for menu-choose, select-file, noting-progress + * aclpc/acl-dc: various changes to device context handling + * aclpc/acl-class: two fixes for better handling of OnCommand events. + +******************************************************************************* +2.2.1.27 + +Sat Jul 11 08:42:42 1998 Kevin Layer <layer@ultra> + + * utils/last.lisp: patch loading fix + +******************************************************************************* +2.2.1.26 + +Wed Jul 08 16:21:38 1998 <layer@HOBART> + + * utils/defun.lisp: bug7098: fix package qualifier for + define-simple-parser + +******************************************************************************* +2.2.1.25 + +Mon Jul 6 16:07:31 1998 Kevin Layer <layer@ultra> + + fix copyright notices + +Mon Jul 06 14:45:24 1998 <layer@HOBART> + + * tk-silica/gc-cursor.cl: start of gc hook fix + * Makefile.generic: fix tags rule + * aclpc/acl-frames.lisp: bug7092: package qualify some + check-last-error calls + * clim/db-list.lisp: bug7092: add initialize-pull-down-menu and + make-pull-down-menu back. + * clim/design-recording.lisp: bug7092: add nyi definition + * aclpc/acl-class.lisp: bug7092: fix ffi calls + +******************************************************************************* +2.2.1.24 + +Mon Jul 06 12:36:16 1998 <layer@HOBART> + + * utils/last.lisp: conditionalize load-patches call based on + version of lisp + +******************************************************************************* +2.2.1.23 + +Mon July 1 1998 + Possible source tree for release 5.0 of ACL. + + * aclpc/acl-class: Fix problems with LoadCursor and activate-default-gadget + * aclpc/acl-dc: Explore better device contexts + * aclpc/acl-frames: Fix problems with error checking + * aclpc/acl-medium: Fix problems with foreground & background colors + * aclpc/acl-port: Fix problems drawing from a background thread + * aclpc/acl-port: Use FormatMessage to get error messages from NT + * aclpc/acl-widget: Mostly stuff to support BBN's widget use + * aclpc/pkgdcl: Put back package lock stuff since it won't build otherwise + * aclpc/winwidgh: Move foreign function definitions here + * clim/db-menu: support non-native menu-bars better + * tk-silica/gc-cursor: don't trust svref (spr17568) + * utils/last: provide required arguments + * utils/transformations: optimization + +******************************************************************************* +2.2.1.22 + +Mon Jun 22 1998 + + * aclpc/acl-class: mostly just cleanup + * aclpc/acl-frames: fix command-table bugs for BBN + * aclpc/acl-medium: fix medium-draw-string* for newline, + make draw-pattern sorta work for stipples + * aclpc/acl-mirror: improved look & feel + * aclpc/acl-port: fix text-size problems + * aclpc/acl-prel: improved look & feel, improved error messages + * aclpc/acl-widget: work on menu-bar widgets for BBN + * clim/output-protocol: null medium is a transient initial state + we should tolerate + * silica/db-border: fix bug in macro LABELLING (#+microsoft-32) + * utils/packages: bump version id + +******************************************************************************* +2.2.1.21 + +Tue Jun 9 23:55:40 1998 Kevin Layer <layer@ultra> + + * Makefile.defs: new file utils/last, for patches + * Makefile.sgi4d-svr4: don't link with -lcvt, because it doesn't + exist on grape and isn't (apparently) needed anymore + * aclpc/acl-scroll.lisp: remove setting of + excl::*enable-package-locked-errors* to nil + * aclpc/pkgdcl.lisp: ditto + * aclpc/sysdcl.lisp: new file utils/last, for patches + * misc/compile-1.lisp: remove dead code + * misc/dev-load-1.lisp: remove dead code + * sys/compile.lisp: new file utils/last.fasl + * sys/sysdcl.lisp: new file utils/last.lisp + * tk/xlib.lisp: in (method initialize-instance :after (image)) + allocate with x11::system-malloc instead of excl::malloc, because + the latter can't be freed with free(), which is what will happen + to this memory (eventually) + * tk-silica/xt-silica.lisp: warnings for unix + * utils/last.lisp: new file to load patches + * xlib/xlib-funs.lisp: new system-malloc + +******************************************************************************* +2.2.1.20 + +Mon Jun 1 16:05:13 1998 Kevin Layer <layer@ultra> + + * Makefile.generic: windows/unix hacking + the rest is to reduce the number of warnings on UNIX to 1 + * clim/frames.lisp + * clim/text-formatting.lisp + * homegrown/db-menu.lisp + * hpgl/hpgl-medium.lisp + * misc/MyDrawingA.c + * misc/compile-1.lisp + * tk/resources.lisp + * tk/widget.lisp + * tk/xlib.lisp + * tk-silica/image.lisp + * tk-silica/xt-gadgets.lisp + * tk-silica/xt-graphics.lisp + * tk-silica/xt-silica.lisp + * wnn/strings.c + +******************************************************************************* +2.2.1.19 (from pnc) + +* tk-silica/xt-frames and xt-silica: spr17465, stop windows from + iconifying in Sparc Common Desktop Environment when switching + workspaces. +* clim/command-processor: added comments describing spr16572 inability + of the command-processor to detect invalid commands. +* aclpc/acl-widget: native implementation of outlining-pane +* aclpc/acl-frames: implement noting-progress thermometer +* aclpc/acl-class: fix bugs with pointer cursor and button show-as-default +* aclpc/*: cleanup; fix some of the many bugs with colors and patterns + +******************************************************************************* +Fri May 29 08:58:03 1998 Kevin Layer <layer@ultra> + + new files: + * Makefile.linux + changed files: + * Makefile: for `linux' host + +******************************************************************************* +2.2.1.18 -- public release on ACL 5.0.beta + +1998-05-27 <layer@HOBART> + + * makedist.sh: tweaks + * readme.win32: changes from Jeff Morrill + +1998-05-26 <layer@HOBART> + + new files + * makedist.sh + * readme.win32 + +******************************************************************************* +2.2.1.17 (from pnc) + +Tues May 26 9:00:00 1998 Jeff Morrill <jmorrill@pointnclick.com> + + * silica/classes: Fix default back/fore of medium (for NT) + * postscript/postscript-medium: define nyi + * demo/custom-records: fix little bug + * clim/menus: cleanup + * aclpc/*.lisp: Cleaned up, reduced compiler warnings, + and fixed several bugs found during testing + ******************************************************************************* 2.2.1.16 diff --git a/Makefile b/Makefile index 71c4c13466976f6a5a31e67b52cf30f4dc6d0de4..559ae200bed33064ab18f101a1ff7888e5ce3913 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $Header: /repo/cvs.copy/clim2/Makefile,v 1.85 1998/05/19 18:50:19 layer Exp $ +# $Header: /repo/cvs.copy/clim2/Makefile,v 1.86 1998/08/06 23:15:35 layer Exp $ # If ../makefile.top doesn't exist, then you must specify HOST=xxx on the # `make' command line. @@ -12,6 +12,10 @@ HOST = sun4-svr4 endif endif +ifeq ($(OS_NAME),linux) +HOST = linux +endif + ifeq ($(OS_NAME),hp-ux) HOST = hpprism endif diff --git a/Makefile.defs b/Makefile.defs index bd38b87d02b5df3757689f55651bc0e76249003f..893edd94236685b379c8cab4a824dd13602f0094 100644 --- a/Makefile.defs +++ b/Makefile.defs @@ -1,4 +1,4 @@ -# $Id: Makefile.defs,v 1.46 1998/05/19 18:50:19 layer Exp $ +# $Id: Makefile.defs,v 1.47 1998/08/06 23:15:35 layer Exp $ # # Makefile.defs for CLIM 2.0 @@ -78,7 +78,7 @@ WNN_UNDEFS=misc/undefinedsymbols.wnn PRODUCT-GENERIC-FASLS = \ climg.fasl climdemo.fasl clim-debug.fasl climps.fasl \ - climgg.fasl climhpgl.fasl + climhpgl.fasl # climgg.fasl PRODUCT-XM-FASLS = climxm.fasl clim-debugxm.fasl PRODUCT-OL-FASLS = climol.fasl clim-debugol.fasl @@ -144,7 +144,7 @@ GENERIC-FASLS= \ clim/db-stream.fasl clim/gadget-output.fasl clim/accept.fasl \ clim/present.fasl clim/command.fasl clim/command-processor.fasl \ clim/basic-translators.fasl clim/frames.fasl clim/panes.fasl \ - clim/default-frame.fasl clim/activities.fasl \ + clim/default-frame.fasl clim/activities.fasl clim/db-menu.fasl \ clim/noting-progress.fasl clim/menus.fasl clim/accept-values.fasl \ clim/drag-and-drop.fasl clim/item-list-manager.fasl \ postscript/pkgdcl.fasl postscript/postscript-s.fasl \ @@ -162,12 +162,12 @@ DEMO-FASLS= \ demo/custom-records.fasl demo/demo-activity.fasl \ test/test-suite.fasl demo/demo-last.fasl - -HOMEGROWN-GADGET-FASLS= \ - homegrown/db-menu.fasl homegrown/db-list.fasl \ - homegrown/db-text.fasl homegrown/db-button.fasl \ - homegrown/db-slider.fasl homegrown/scroll-pane.fasl \ - homegrown/db-label.fasl homegrown/last.fasl +# not used anymore +#HOMEGROWN-GADGET-FASLS= \ +# homegrown/db-menu.fasl homegrown/db-list.fasl \ +# homegrown/db-text.fasl homegrown/db-button.fasl \ +# homegrown/db-slider.fasl homegrown/scroll-pane.fasl \ +# homegrown/db-label.fasl homegrown/last.fasl GENERIC-XT-FASLS= \ tk/pkg.fasl tk/foreign-obj.fasl tk/macros.fasl tk/xlib.fasl \ @@ -187,7 +187,8 @@ XM-FASLS= \ tk-silica/xt-frames.fasl tk-silica/xm-frames.fasl \ tk-silica/xm-dialogs.fasl tk-silica/xt-gadgets.fasl \ tk-silica/xm-gadgets.fasl tk-silica/xt-pixmaps.fasl \ - tk-silica/gc-cursor.fasl tk-silica/last.fasl + tk-silica/gc-cursor.fasl \ + utils/last.fasl OL-FASLS= \ tk/load-ol.fasl $(GENERIC-XT-FASLS) \ diff --git a/Makefile.generic b/Makefile.generic index e237f1b23d1d47af7cf7b095f5b897eed930fe57..8d3b8877da8646e1bde7fbb884d5d3d855092c75 100644 --- a/Makefile.generic +++ b/Makefile.generic @@ -1,4 +1,4 @@ -# $Id: Makefile.generic,v 1.48 1998/05/19 18:50:20 layer Exp $ +# $Id: Makefile.generic,v 1.49 1998/08/06 23:15:36 layer Exp $ # Makefile.generic for CLIM 2.0 ifeq ($(OS_NAME),windows) @@ -13,6 +13,10 @@ ifneq ($(OS_NAME),windows) compile_depends = wnn.$(SHARED_EXT) endif +ifeq ($(OS_NAME),windows) +runlisp_args = -o compile.out +endif + compile: FORCE $(PRODUCT-OBJS) $(ICS-PRODUCT-OBJS) $(compile_depends) rm -f build.tmp echo '(setq sys::*libtk-pathname* "$(TKLIB)")' >> build.tmp @@ -35,10 +39,12 @@ compile: FORCE $(PRODUCT-OBJS) $(ICS-PRODUCT-OBJS) $(compile_depends) echo '#-mswindows (compile-it (quote $(SYSTEM)))' >> build.tmp echo '(exit 0)' >> build.tmp (eval '$(SET_LIBRARY_PATH)'; \ - sh ../src/runlisp.sh -f build.tmp -o compile.out $(CL) $(CLOPTS)) + sh ../src/runlisp.sh -f build.tmp $(runlisp_args) $(CL) $(CLOPTS)) +ifeq ($(OS_NAME),windows) # various programs expect to see the result of the compile on stdout, so # cat it now: @cat compile.out +endif # Concatenation @@ -55,10 +61,11 @@ climdemo.fasl: $(DEMO-FASLS) ls -lt climdemo.fasl >> Clim-sizes.n ls -lt climdemo.fasl -climgg.fasl: $(HOMEGROWN-GADGET-FASLS) - $(CAT) $(HOMEGROWN-GADGET-FASLS) > climgg.fasl - ls -lt climgg.fasl >> Clim-sizes.n - ls -lt climgg.fasl +# not used anymore: +#climgg.fasl: $(HOMEGROWN-GADGET-FASLS) +# $(CAT) $(HOMEGROWN-GADGET-FASLS) > climgg.fasl +# ls -lt climgg.fasl >> Clim-sizes.n +# ls -lt climgg.fasl clim-debug.fasl: $(DEBUG-FASLS) $(CAT) $(DEBUG-FASLS) > clim-debug.fasl @@ -140,7 +147,6 @@ $(CLIM): FORCE $(PRODUCT-OBJS) $(ICS-PRODUCT-OBJS) (load-it '$(SYSTEM)))) \ :autoload-warning nil \ :image-only t \ - :print-startup-message :default \ :purify t \ :debug-on-error t \ :internal-debug \"build-clim.out\" \ @@ -231,8 +237,9 @@ clean: clean-notes: cd notes; find . -name '*.lisp' -print | xargs rm -f -tags: - $(TAGS) $(ALL_SRC) +tags: FORCE + rm -f TAGS + find . -name '*.lisp' -print | xargs $(TAGS) -a wc: wc $(ALL_SRC) diff --git a/Makefile.linux b/Makefile.linux new file mode 100644 index 0000000000000000000000000000000000000000..a0049a55bd1cbc61c9d8d0de4fa7ca043bfa9e70 --- /dev/null +++ b/Makefile.linux @@ -0,0 +1,25 @@ +# $Id: Makefile.linux,v 1.2 1998/08/06 23:15:36 layer Exp $ + +include Makefile.defs + +Makefile=Makefile.linux + +XINCLUDES=-I/usr/X11R6/include + +TKLIB=-lXm -lXpm -lXext +XTLIB=-lXt +XLIB=-lX11 + +SET_LIBRARY_PATH = LD_RUN_PATH=/usr/X11R6/lib:/lib:/usr/lib; export LD_RUN_PATH + +PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS) + +#MOTIFXTRAS=-lgen + +#PICFLAGS = -K pic +SHAREFLAGS = +MAKE_SHARED = ld -shared -L/usr/X11R6/lib +STD_DEFINES = -DSVR4 -DSYSV +AR = ar cq + +include Makefile.generic diff --git a/Makefile.sgi4d-svr4 b/Makefile.sgi4d-svr4 index 9d602a3e971eacdd4270cbac9d183a4e9c364f2e..dac56933b2c29f296d03bc7c52ae1f29b103f3d3 100644 --- a/Makefile.sgi4d-svr4 +++ b/Makefile.sgi4d-svr4 @@ -1,4 +1,4 @@ -# $Header: /repo/cvs.copy/clim2/Makefile.sgi4d-svr4,v 1.13 1998/05/19 18:50:20 layer Exp $ +# $Id: Makefile.sgi4d-svr4,v 1.14 1998/08/06 23:15:36 layer Exp $ # # Makefile.sigi4d-svr4 for CLIM 2.0 # @@ -9,7 +9,7 @@ Makefile=Makefile.sgi4d-svr4 TKLIB=-lXm XTLIB=-lXt -XLIB=-lX11 -lcvt +XLIB=-lX11 # -lcvt XINCLUDES=-I/usr/include diff --git a/aclpc/acl-class.lisp b/aclpc/acl-class.lisp index eea0641c10170e54220470cffb9979be7be254e7..0930217e361a5050535b415d331f22b49c465ed3 100644 --- a/aclpc/acl-class.lisp +++ b/aclpc/acl-class.lisp @@ -1,4 +1,22 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-class.lisp,v 1.9 1998/08/06 23:15:41 layer Exp $ #|**************************************************************************** * * @@ -69,8 +87,8 @@ (defvar *ctlmodstate* (make-modstate)) (defvar *win-result* 0) -(defparameter arrow-cursor (ct::callocate win::hcursor)) -(defparameter application-icon (ct::callocate win::hicon)) +(defparameter arrow-cursor (ct:callocate win:hcursor)) +(defparameter application-icon (ct:callocate win:hicon)) ;; window procedure unwinding state (defvar *window-proc-return-reason* nil) @@ -90,22 +108,15 @@ (defun init-cursors () ;; put back old cursor mechanism for the moment (cim 9/13/96) - (setf arrow-cursor - (win:LoadCursor - (ct::null-handle win::hinst) - (ct::ccallocate (char *) :initial-value win::IDC_ARROW))) + (setf arrow-cursor (win:LoadCursor 0 win:IDC_ARROW)) + (when (zerop arrow-cursor) + (check-last-error "LoadCursor" :action :warn)) ;; this just does the icon now - the cursor stuff is all handled in ;; realize-cursor methods in acl-port (cim 9/12/96) - (setf application-icon - (win:LoadIcon - (ct::null-handle win::hinst) - (ct::ccallocate (char *) :initial-value win:IDI_APPLICATION)))) - -;;;;; This is disgusting. Object-oriented programs shouldn't do this. JPM. -;;;(eval-when (compile load eval) -;;; ;;mm: 11Jan95 - this is defined later in ??? -;;; (unless (ignore-errors (find-class 'silica::hlist-pane)) -;;; (defclass silica::hlist-pane () ()))) + (setf application-icon (win:LoadIcon 0 win:IDI_APPLICATION)) + (when (zerop application-icon) + (check-last-error "LoadIcon" :action :warn)) + t) ;;; Gather up the argument information and invoke the window procedure. ;;; +++ at some point merge this in with the cg mechanism for lisp @@ -162,26 +173,32 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; callback for the windowproc for all CLIM windows. -(defun innermost-sheet-pointer-cursor (sheet) - (and sheet - (or (sheet-pointer-cursor sheet) - (innermost-sheet-pointer-cursor (sheet-parent sheet))))) - -(defvar *cursor-cache* nil) +(defun set-cursor (sheet cursor) + (let ((wincursor (realize-cursor (port sheet) cursor))) + ;; SetCursor doesn't seem to be the right thing. + ;; Each time the mouse moves, Windows sets the cursor back + ;; to the default for the class and then sends a WM_SETCURSOR + ;; message where we get a chance to SetCursor again. + (win:setClassLong (sheet-mirror sheet) + -12 ; GCL_HCURSOR + wincursor) + (win:setcursor wincursor) + t)) -(defun maybe-set-cursor (window) - (let* ((sheet (mirror->sheet *acl-port* window)) - (cursor (or (port-grab-cursor *acl-port*) +(defun maybe-set-cursor (sheet) + ;; This has a bug that it doesn't call defwindowproc + ;; when the sheet is a text field. This should get you the ibeam + ;; cursor because that's the cursor for that class + (let* ((cursor (or (port-grab-cursor *acl-port*) (sheet-pointer-cursor sheet) - ;;(innermost-sheet-pointer-cursor sheet) ;;(pointer-cursor (port-pointer *acl-port*)) ))) - (when (and cursor - (not (eq cursor :default)) - (not (eq cursor *cursor-cache*))) - (setq *cursor-cache* cursor) ; not sure the cache works - (win:setcursor (realize-cursor *acl-port* cursor)) - t))) + (if cursor + (set-cursor sheet cursor) + (let ((parent (sheet-parent sheet))) + (or (and parent (maybe-set-cursor parent)) + (and (setq cursor (pointer-cursor (port-pointer (port sheet)))) + (set-cursor sheet cursor))))))) (defvar *level* 0) @@ -207,25 +224,26 @@ ) ;; Process WM_MOUSEMOVE -(defun message-mousemove (window msg wparam lparam) +(defun onmousemove (window msg wparam lparam) (let ((mx (loword lparam)) (my (hiword lparam)) (keys wparam) (sheet (mirror->sheet *acl-port* window))) (declare (ignore keys)) - (note-pointer-motion *acl-port* sheet mx my) (setq *win-result* - (win::defwindowproc window msg wparam lparam)))) + (if (note-pointer-motion *acl-port* sheet mx my) + (win:defwindowproc window msg wparam lparam) + win:false)))) ;; Process WM_SETCURSOR -(defun message-setcursor (window msg wparam lparam) +(defun onsetcursor (window msg wparam lparam) ;; There is a bug that you get these messages even ;; when the cursor is not moving. JPM 5/98. (let* ((hit-code (loword lparam))) - (cond ((and (eql hit-code win:htclient) (maybe-set-cursor window)) + (cond ((eql hit-code win:htclient) + (maybe-set-cursor (mirror->sheet *acl-port* window)) (setq *win-result* win:true)) (t - (setq *cursor-cache* nil) (setf (pointer-cursor (port-pointer *acl-port*)) :default) ;; If the hit-code is not HTCLIENT, then its not CLIM's problem. ;; If it is in the client area, then DefWindowProc is supposed @@ -235,62 +253,46 @@ (message-default window msg wparam lparam))))) ;; Process WM_PAINT -(defun message-paint (window msg wparam lparam) +(defun onpaint (window msg wparam lparam) (declare (ignore wparam msg lparam)) - (let* ((udrect (ct::ccallocate win:rect)) - (berase 0) ; (ct::ccallocate win:bool) - (update (win::getUpdateRect window udrect berase)) - (sheet (mirror->sheet *acl-port* window)) - ;; +++rl added to validate everything because of multiple - ;; (continuous) repaints with maximized window - (vdrect (ct::ccallocate win:rect))) - ;; +++rl same as comment above - (win::getClientRect window vdrect) - (if update - (let ((ilef (ct::cref win::rect udrect win::left)) - (itop (ct::cref win::rect udrect win::top)) - (irig (ct::cref win::rect udrect win::right)) - (ibot (ct::cref win::rect udrect win::bottom))) - (win::validateRect window vdrect) ; needed? - (unless (or (= ilef irig) (= itop ibot)) ;does this happen alot? - (when sheet - (handle-event - sheet - (allocate-event 'window-repaint-event - :native-region (sheet-native-region sheet) - :region (make-bounding-rectangle ilef itop irig ibot) - :sheet sheet)))))))) + (let ((sheet (mirror->sheet *acl-port* window))) + (let* ((udrect (ct:ccallocate win:rect)) + (berase 0) + (update (win:getUpdateRect window udrect berase)) + ;; +++rl added to validate everything because of multiple + ;; (continuous) repaints with maximized window + (vdrect (ct:ccallocate win:rect))) + ;; +++rl same as comment above + (win:getClientRect window vdrect) + (if update + (let ((ilef (ct:cref win:rect udrect left)) + (itop (ct:cref win:rect udrect top)) + (irig (ct:cref win:rect udrect right)) + (ibot (ct:cref win:rect udrect bottom))) + (win:validateRect window vdrect) ; needed? + (unless (or (= ilef irig) (= itop ibot)) ;does this happen alot? + (when sheet + (handle-event + sheet + (allocate-event + 'window-repaint-event + :native-region (sheet-native-region sheet) + :region (make-bounding-rectangle ilef itop irig ibot) + :sheet sheet)) + ))))))) ;; Process WM_DRAWITEM -(defun message-drawitem (window msg wparam lparam) +(defun ondrawitem (window msg wparam lparam) (declare (ignore wparam msg window)) - #+aclpc ;; pnc Aug97 for clim2bug740 - (progn - (incf *drawitem-started*) - (multiple-value-bind (ctltype ctlid itemid itemaction itemstate - hwnditem hdcitem rcitem itemdata) - (drawitemstruct-info lparam) - (let ((hwnd (ct::ccallocate win::hwnd)) - (hdc (ct::ccallocate win::hdc)) - (state itemstate) - (rect rcitem)) - (setf (ct:handle-value win::hwnd hwnd) hwnditem) - (setf (ct:handle-value win::hdc hdc) hdcitem) - (let ((sheet (mirror->sheet *acl-port* hwnd))) - (when sheet (incf *buttons-drawn*) - (silica::draw-picture-button (mirror->sheet *acl-port* hwnd) - state hdc rect))))) - *win-result*) - #-aclpc ;+++ fix this for ACLPC +++ ;; someone who knows how to use the pc ff interface should get ;; rid of all these memrefs! (cim 10/4/96) - (let ((hwnd (ct::ccallocate win::hwnd)) - (hdc (ct::ccallocate win::hdc)) + (let ((hwnd (ct:ccallocate win:hwnd)) + (hdc (ct:ccallocate win:hdc)) (state (sys:memref-int lparam 0 16 :unsigned-long)) (rect (+ lparam 28))) - (setf (ct:handle-value win::hwnd hwnd) + (setf (ct:handle-value win:hwnd hwnd) (sys:memref-int lparam 0 20 :unsigned-long)) - (setf (ct:handle-value win::hdc hdc) + (setf (ct:handle-value win:hdc hdc) (sys:memref-int lparam 0 24 :unsigned-long)) (let ((sheet (mirror->sheet *acl-port* hwnd))) (when sheet @@ -298,24 +300,24 @@ state hdc rect))))) ;; Process WM_CTLCOLOREDIT -(defun message-ctlcoloredit (window msg wparam lparam) +(defun onctlcoloredit (window msg wparam lparam) (setq *win-result* (message-default window msg wparam lparam)) - (let ((hwnd (ct::ccallocate win::hwnd)) - (hdc (ct::ccallocate win::hdc))) - (setf (ct:handle-value win::hwnd hwnd) lparam - (ct:handle-value win::hdc hdc) wparam) + (let ((hwnd (ct:ccallocate win:hwnd)) + (hdc (ct:ccallocate win:hdc))) + (setf (ct:handle-value win:hwnd hwnd) lparam + (ct:handle-value win:hdc hdc) wparam) (let ((sheet (mirror->sheet *acl-port* hwnd))) (when sheet (when (and (typep sheet 'silica::hpbutton-pane) (slot-value sheet 'silica::pixmap)) - (let ((rect (ct::ccallocate win::rect))) - (win::getclientrect hwnd rect) + (let ((rect (ct:ccallocate win:rect))) + (win:getclientrect hwnd rect) (silica::draw-picture-button sheet 0 hdc rect))) (setf *win-result* (adjust-gadget-colors sheet hdc)))))) ;; Process WM_COMMAND -(defun message-command (window msg wparam lparam) +(defun oncommand (window msg wparam lparam) (declare (ignore msg)) (let ((wloword (loword wparam)) (whiword (hiword wparam)) @@ -323,131 +325,135 @@ (pointer (port-pointer *acl-port*)) (modifier-state (make-modifier-state)) (gadget nil) - (hwnd (ct::ccallocate win::hwnd))) + (hwnd (ct:ccallocate win:hwnd))) ;;mm: defined in acl-mirr.lsp later (declare (special *gadget-id->window*)) (when pointer (flush-pointer-motion *acl-port*)) - (if (and (= lparam 0) ; menu item - (= whiword 0)) ; otherwise control (or accelerator) - (let* ((frame (pane-frame sheet)) - (command-table (frame-command-table frame)) - (command (cdr (aref *menu-id->command-table* wloword)))) - ;; pr Aug97 - (with-slots (clim-internals::disabled-commands) frame - (if (member (car command) clim-internals::disabled-commands) - (win::messagebeep 200) - (queue-put (slot-value *acl-port* 'event-queue) - (allocate-event 'presentation-event - :frame frame - :sheet (frame-top-level-sheet frame) - :presentation-type - `(command :command-table ,command-table) - :value command))))) - (progn - (setf (ct:handle-value win::hwnd hwnd) lparam) - ;;mm: for the moment, the following seems superfluous - ;;(setf hwndid (silica::gadget-id->window sheet wloword)) - (setf gadget (mirror->sheet *acl-port* hwnd)) - (if (typep gadget 'silica::mswin-combo-box-pane) - (let ((sheet (mirror->sheet *acl-port* window))) - (when (and sheet (= whiword win::cbn_closeup)) - (with-slots (event-queue) *acl-port* - (queue-put - event-queue - (multiple-value-bind (left top right bottom) - (mirror-client-region-internal* *acl-port* hwnd window) - (declare (ignore right bottom)) - (allocate-event 'silica::window-change-event - :native-x (+ left 1) - :native-y (+ top 1) - :button +pointer-left-button+ - :modifier-state 0 - :pointer pointer - :sheet sheet - :mswin-control gadget)))))) - ;; else - (if (typep gadget 'silica::mswin-text-edit) - (let ((sheet (mirror->sheet *acl-port* window))) - (when (and sheet (= whiword win:en_killfocus)) - - (with-slots (event-queue) *acl-port* + (cond ((and (zerop lparam) ; menu item + (zerop whiword)) ; otherwise control (or accelerator) + (let* ((frame (pane-frame sheet)) + (command (cdr (aref *menu-id->command-table* wloword)))) + ;; pr Aug97 + (with-slots (clim-internals::disabled-commands) frame + (if (member (car command) clim-internals::disabled-commands) + (win:messagebeep 200) + #+old + (queue-put (slot-value *acl-port* 'event-queue) + (allocate-event + 'presentation-event + :frame frame + :sheet (frame-top-level-sheet frame) + :presentation-type + `(command :command-table ,command-table) + :value command)) + (execute-command-in-frame + frame command) + )))) + (t + (setf (ct:handle-value win:hwnd hwnd) lparam) + ;;mm: for the moment, the following seems superfluous + ;;(setf hwndid (silica::gadget-id->window sheet wloword)) + (setf gadget (mirror->sheet *acl-port* hwnd)) + (cond ((typep gadget 'silica::mswin-combo-box-pane) + (let ((sheet (mirror->sheet *acl-port* window))) + (when (and sheet (= whiword win:cbn_closeup)) + (with-slots (event-queue) *acl-port* + (queue-put + event-queue + (multiple-value-bind (left top right bottom) + (mirror-client-region-internal* *acl-port* hwnd window) + (declare (ignore right bottom)) + (allocate-event 'silica::window-change-event + :native-x (+ left 1) + :native-y (+ top 1) + :button +pointer-left-button+ + :modifier-state 0 + :pointer pointer + :sheet sheet + :mswin-control gadget))))))) + ((typep gadget 'silica::mswin-text-edit) + (let ((sheet (mirror->sheet *acl-port* window))) + (when (and sheet (= whiword win:en_killfocus)) + + (with-slots (event-queue) *acl-port* ;handle-event ; gadget + (multiple-value-bind (left top right bottom) + (mirror-client-region-internal* *acl-port* hwnd window) + (declare (ignore right bottom)) + (queue-put event-queue + (allocate-event + 'silica::window-change-event + :native-x (+ left 1) + :native-y (+ top 1) + :button +pointer-left-button+ + :modifier-state 0 + :pointer pointer + :sheet sheet + :mswin-control gadget))))))) + ((or (not (typep gadget 'silica::hlist-pane)) + (= whiword hln_selchange)) + (when (typep gadget 'silica::hlist-pane) + (win:setfocus window)) + (with-slots (event-queue) *acl-port* + (multiple-value-bind (left top right bottom) (mirror-client-region-internal* *acl-port* hwnd window) (declare (ignore right bottom)) (queue-put event-queue - (allocate-event 'silica::window-change-event - :native-x (+ left 1) - :native-y (+ top 1) - :button +pointer-left-button+ - :modifier-state 0 - :pointer pointer - :sheet sheet - :mswin-control gadget)))))) - ;; else - (when (or (not (typep gadget 'silica::hlist-pane)) - (= whiword win:hln_selchange)) - (when (typep gadget 'silica::hlist-pane) - (win::setfocus window)) - (with-slots (event-queue) *acl-port* - - (multiple-value-bind (left top right bottom) - (mirror-client-region-internal* *acl-port* hwnd window) - (declare (ignore right bottom)) - (queue-put event-queue - (allocate-event 'silica::window-change-event - :native-x (+ left 1) - :native-y (+ top 1) - :button +pointer-left-button+ - :modifier-state modifier-state - :pointer pointer - :sheet sheet - :mswin-control gadget))))))))) + (allocate-event + 'silica::window-change-event + :native-x (+ left 1) + :native-y (+ top 1) + :button +pointer-left-button+ + :modifier-state modifier-state + :pointer pointer + :sheet sheet + :mswin-control gadget)))))))) (clear-winproc-result *win-result*) *win-result*)) ;; Process WM_VSCROLL -(defun message-vscroll (window msg wparam lparam) +(defun onvscroll (window msg wparam lparam) (let* ((type (loword wparam)) (position (hiword wparam)) (hwnd (if (zerop lparam) window lparam)) ; JPM for rfe353 - (message (cond ((eql msg win::wm_hscroll) :horizontal) - ((eql msg win::wm_vscroll) :vertical))) - (flag (cond ((eql msg win::wm_hscroll) win:sb_horz) - ((eql msg win::wm_vscroll) win:sb_vert))) + (message (cond ((eql msg win:wm_hscroll) :horizontal) + ((eql msg win:wm_vscroll) :vertical))) + (flag (cond ((eql msg win:wm_hscroll) win:sb_horz) + ((eql msg win:wm_vscroll) win:sb_vert))) (sheet (mirror->sheet *acl-port* hwnd))) (declare (fixnum action position)) (multiple-value-bind (action amount) - (cond ((eql type win::sb_lineup) - (win::setScrollPos window flag - (- (win::getScrollPos window flag) 1) 1) + (cond ((eql type win:sb_lineup) + (win:setScrollPos window flag + (- (win:getScrollPos window flag) 1) 1) (values :relative-jump -1)) - ((eql type win::sb_linedown) - (win::setScrollPos window flag - (+ (win::getScrollPos window flag) 1) 1) + ((eql type win:sb_linedown) + (win:setScrollPos window flag + (+ (win:getScrollPos window flag) 1) 1) (values :relative-jump +1)) - ((eql type win::sb_pageup) - (win::setScrollPos window flag - (- (win::getScrollPos window flag) 1) 1) + ((eql type win:sb_pageup) + (win:setScrollPos window flag + (- (win:getScrollPos window flag) 1) 1) (values :screenful -1)) - ((eql type win::sb_pagedown) - (win::setScrollPos window flag - (+ (win::getScrollPos window flag) 1) 1) + ((eql type win:sb_pagedown) + (win:setScrollPos window flag + (+ (win:getScrollPos window flag) 1) 1) (values :screenful +1)) - ((eql type win::sb_thumbposition) - (win::setScrollPos window flag position 1) + ((eql type win:sb_thumbposition) + (win:setScrollPos window flag position 1) (values :percentage position)) ((and *realtime-scrollbar-tracking* - (eql type win::sb_thumbtrack)) - (win::setScrollPos window flag position 1) + (eql type win:sb_thumbtrack)) + (win:setScrollPos window flag position 1) (values :percentage position)) - ((eql type win::sb_top) - (win::setScrollPos window flag 0 1) + ((eql type win:sb_top) + (win:setScrollPos window flag 0 1) (values :percentage 0)) - ((eql type win::sb_bottom) - (win::setScrollPos window flag *win-scroll-grain* 1) + ((eql type win:sb_bottom) + (win:setScrollPos window flag *win-scroll-grain* 1) (values :percentage 100))) (when (and action sheet) (with-slots (event-queue) *acl-port* @@ -465,22 +471,22 @@ (declaim (special *setting-sheet-mirror-edges*)) ;; Process WM_MOVE -(defun message-move (window msg wparam lparam) +(defun onmove (window msg wparam lparam) (let ((sheet (mirror->sheet *acl-port* window))) (if (and sheet (not (eq sheet *setting-sheet-mirror-edges*)) - (not (win::IsIconic window))) + (not (win:IsIconic window))) (progn (handle-event sheet (allocate-event 'window-configuration-event :sheet sheet)) ;; set return value to 0 (clear-winproc-result *win-result*)) - (setq *win-result* (win::defwindowproc window msg wparam lparam))) + (setq *win-result* (win:defwindowproc window msg wparam lparam))) *win-result*)) ;; Process WM_GETMINMAXINFO -(defun message-getminmaxinfo (window msg wparam lparam) +(defun ongetminmaxinfo (window msg wparam lparam) #+aclpc ;; pnc Aug97 for clim2bug740 (let ((sheet (mirror->sheet *acl-port* window))) (if (typep sheet 'acl-top-level-sheet) @@ -496,10 +502,10 @@ (sys:memref-int lparam 0 28 win:uint) min-height) (clear-winproc-result *win-result*))) #+acl86win32 - (setq *win-result* (win::defwindowproc window msg wparam lparam)) + (setq *win-result* (win:defwindowproc window msg wparam lparam)) #+aclpc - (ct::%set-long *win-result* 4 0 - (win::defwindowproc window msg wparam lparam))) + (ct:%set-long *win-result* 4 0 + (win:defwindowproc window msg wparam lparam))) *win-result*) #-aclpc ; +++ fix this for aclpc +++ (let ((sheet (mirror->sheet *acl-port* window))) @@ -513,14 +519,14 @@ (sys:memref-int lparam 0 28 :unsigned-long) min-height) (clear-winproc-result *win-result*))) #+acl86win32 - (setq *win-result* (win::defwindowproc window msg wparam lparam)) + (setq *win-result* (win:defwindowproc window msg wparam lparam)) #+aclpc - (ct::%set-long *win-result* 4 0 - (win::defwindowproc window msg wparam lparam))) + (ct:%set-long *win-result* 4 0 + (win:defwindowproc window msg wparam lparam))) *win-result*)) ;; PROCESS EN_UPDATE -(defun message-en-update (window msg wparam lparam) +(defun onupdate (window msg wparam lparam) (declare (ignore msg wparam lparam)) (let ((sheet (mirror->sheet *acl-port* window))) (when sheet @@ -534,7 +540,7 @@ *win-result*)) ;; Process WM_KEYDOWN -(defun message-keydown (window msg wparam lparam) +(defun onkeydown (window msg wparam lparam) (flush-pointer-motion *acl-port*) (let* ((code wparam) (pass nil) @@ -545,13 +551,14 @@ (eql code win:vk_control) (eql code win:vk_menu)) (setq pass t)) - (let* ((capstate (win::getKeyState win:vk_capital)) - (numstate (win::getKeyState win:vk_numlock)) - (shiftstate (win::getKeyState win:vk_shift)) - (controlstate (win::getKeyState win:vk_control)) - (metastate (win::getKeyState win:vk_menu))) + (let* ((capstate (win:getKeyState win:vk_capital)) + (numstate (win:getKeyState win:vk_numlock)) + (shiftstate (win:getKeyState win:vk_shift)) + (controlstate (win:getKeyState win:vk_control)) + (metastate (win:getKeyState win:vk_menu))) #+debugg - (format *standard-output* "caps=~a num=~a shift=~a ctrl=~a meta=~a code=~a~%" + (format *standard-output* + "caps=~a num=~a shift=~a ctrl=~a meta=~a code=~a~%" capstate numstate shiftstate controlstate metastate code) (setf (modstate-control *modstate*) @@ -569,18 +576,16 @@ (if pass (progn (setq pass nil) - #+acl86win32 - (setq *win-result* (win::defwindowproc window msg wparam lparam)) - #+aclpc - (ct::%set-long *win-result* 4 0 - (win::defwindowproc window msg wparam lparam)) - ;;added this so that port modifier state is always updated, even on passed - ;;characters. -- KR + (setq *win-result* (win:defwindowproc window msg wparam lparam)) + ;;added this so that port modifier state is always updated, + ;; even on passed characters. -- KR (setf (port-modifier-state *acl-port*) (modstate->modifier *modstate*)) *win-result*) (progn - (when (and (or (<= #x30 vk #x5a)(<= #xba vk #xc0)(<= #xdb vk #xdf)) + (when (and (or (<= #x30 vk #x5a) + (<= #xba vk #xc0) + (<= #xdb vk #xdf)) (modstate-shift *modstate*)) (setf code (logior #x100 code))) ;; NUM LOCK @@ -601,51 +606,93 @@ (setf keysym (char->keysym keysym))) (let ((frame (pane-frame sheet)) (command nil)) - (if (and (eql msg win::wm_keydown) - (setq command (lookup-accelerator frame keysym modstate))) - (let ((command-table (frame-command-table frame))) - (queue-put event-queue - (allocate-event 'presentation-event - :frame frame - :sheet (frame-top-level-sheet frame) - :presentation-type - `(command :command-table ,command-table) - :value command) - )) - - (queue-put event-queue - (allocate-event - (cond ((or (eql msg win:wm_keydown) - (eql msg win:wm_syskeydown)) - 'key-press-event) - ((or (eql msg win:wm_keyup) - (eql msg win:wm_syskeyup)) - 'key-release-event)) - :key-name keysym - :character char - :modifier-state (setf (port-modifier-state *acl-port*) - modstate) - :sheet sheet))) - - ;;added this so that port modifier state is always updated, even on passed - ;;characters. -- KR - (setf (port-modifier-state *acl-port*) - (modstate->modifier *modstate*)) - - ) - )) + (cond ((and (eql msg win:wm_keydown) + (setq command + (lookup-accelerator frame keysym modstate))) + #+old + (queue-put + event-queue + (allocate-event 'presentation-event + :frame frame + :sheet (frame-top-level-sheet frame) + :presentation-type + `(command :command-table ,command-table) + :value command)) + (execute-command-in-frame + frame command)) + ((and (eql msg win:wm_keydown) + (eql keysym :newline) + (find-default-gadget frame)) + (activate-default-gadget frame)) + (t + (queue-put event-queue + (allocate-event + (cond ((or (eql msg win:wm_keydown) + (eql msg win:wm_syskeydown)) + 'key-press-event) + ((or (eql msg win:wm_keyup) + (eql msg win:wm_syskeyup)) + 'key-release-event)) + :key-name keysym + :character char + :modifier-state + (setf (port-modifier-state *acl-port*) + modstate) + :sheet sheet)) + ;;added this so that port modifier state is always + ;; updated, even on passed characters. -- KR + (setf (port-modifier-state *acl-port*) + (modstate->modifier *modstate*)) + ))))) ;; set return value to 0 (clear-winproc-result *win-result*) - *win-result*)))) + *win-result*)))) + +(defun find-default-gadget (frame) + ;; Look for a button that is "show-as-default" + (let* ((gadget nil) + (input-context *input-context*) + (this-context (first input-context)) + (context-type (when this-context (input-context-type this-context)))) + ;; If we are not accepting a command, then forget about + ;; activating the default gadget. JPM 6/30/98. + (when (and (consp context-type) + (eq (first context-type) 'command-name)) + (flet ((look (s) + (when (and (typep s 'push-button) + (push-button-show-as-default s)) + (setq gadget s)))) + (declare (dynamic-extent #'look)) + (map-over-sheets #'look + (frame-top-level-sheet frame)) + gadget)))) + +(defun activate-default-gadget (frame) + ;; Look for a button that is "show-as-default" + ;; and activate it. + (let ((gadget (find-default-gadget frame))) + (if gadget + (with-slots (event-queue) *acl-port* + (queue-put event-queue + (allocate-event + 'silica::window-change-event + :native-x 0 + :native-y 0 + :button +pointer-left-button+ + :modifier-state 0 + :pointer (port-pointer *acl-port*) + :sheet gadget + :mswin-control gadget))) + (clim:beep)))) ;; Process WM_BUTTONDOWN -(defun message-buttondown (window msg wparam lparam) +(defun onbuttondown (window msg wparam lparam) ;; added the following so that clicking on a blank area will ;; move the focus away from any text-fields and cause their ;; value to be correctly updated - this was copied from the ;; handle-event on key-press-event for mswin-text-edit in ;; acl-widg (cim 9/17/96) - (win::setfocus (win::getactivewindow) #-acl86win32 :static) + (win:setfocus (win:getactivewindow) #-acl86win32 :static) (let ((modifier-state (windows-mask->modifier-state wparam)) @@ -685,7 +732,7 @@ *win-result*) ;; Process WM_ACTIVATE -(defun message-activate (window msg wparam lparam) +(defun onactivate (window msg wparam lparam) (declare (ignore msg lparam)) (let ((sheet (mirror->sheet *acl-port* window)) (flag (loword wparam))) @@ -696,7 +743,7 @@ *win-result*)) ;; Process WM_KILLFOCUS -(defun message-killfocus (window msg wparam lparam) +(defun onkillfocus (window msg wparam lparam) (declare (ignore lparam wparam)) (let* ((sheet (mirror->sheet *acl-port* window)) (frame (when sheet (pane-frame sheet))) @@ -715,13 +762,13 @@ *win-result*)) ;; Process WM_INITMENUPOPUP -(defun message-initmenupopup (window msg wparam lparam) +(defun oninitmenupopup (window msg wparam lparam) (declare (ignore msg window lparam)) (update-menu-item-sensitivities wparam) *win-result*) ;; Process WM_NCHITTEST -(defun message-nchittest (window msg wparam lparam) +(defun onnchittest (window msg wparam lparam) (setq *win-result* (win:defwindowproc window msg wparam lparam))) ;; Allow Windows to provide default message processing. @@ -743,80 +790,86 @@ ;; a 32-bit "LRESULT" value to the caller. The nature of the ;; return value depends on the message. (ff:defun-c-callable clim-wind-proc (window msg wparam lparam) - (declare (:convention :stdcall) (:unwind 0)) - (progn ;;mp:without-scheduling + (declare (:convention :stdcall) (:unwind 0) + (optimize (safety 0) (speed 3))) + (let ((result 0) + (*level* (1+ (the fixnum *level*)))) (setf *hwnd* window) - (mformat excl:*initial-terminal-io* - "In clim-wind-proc msg=~a sheet=~s lparam=~a~%" - (msg-name msg) - (mirror->sheet *acl-port* window) - lparam) - (let ((result 0) - (*level* (1+ *level*))) - (when (> *level* 40) - (break "too deep!")) - (case msg - (#.win:wm_mousemove - (message-mousemove window msg wparam lparam)) - (#.win:wm_setcursor - (message-setcursor window msg wparam lparam)) - (#.win:wm_paint - (message-paint window msg wparam lparam)) - (#.win:wm_drawitem - (message-drawitem window msg wparam lparam)) - ((#.win:wm_ctlcoloredit - #.win:wm_ctlcolorlistbox - #.win:wm_ctlcolorbtn - ;; couldn't get the colors to change for the following - ;; wm_ctlcolorxx messages - so we're not using them for the - ;; moment (cim 10/11/96) - ;; #.win:wm_ctlcolormsgbox - ;; #.win:wm_ctlcolordlg - ;; #.win:wm_ctlcolorscrollbar - ;; #.win:wm_ctlcolorstatic - ) - (message-ctlcoloredit window msg wparam lparam)) - (#.win:wm_command - (message-command window msg wparam lparam)) - ((#.win:wm_hscroll #.win:wm_vscroll) - (message-vscroll window msg wparam lparam)) - ((#.win:wm_move #.win:wm_size) - (message-move window msg wparam lparam)) - (#.win:wm_getminmaxinfo - (message-getminmaxinfo window msg wparam lparam)) - (#.win:en_update - (message-en-update window msg wparam lparam)) - ;; character typed - ((#.win:wm_keydown - #.win:wm_syskeydown - #.win:wm_keyup - #.win:wm_syskeyup) - (message-keydown window msg wparam lparam)) - ((#.win:wm_lbuttondown - #.win:wm_rbuttondown - #.win:wm_mbuttondown - #.win:wm_lbuttonup - #.win:wm_rbuttonup - #.win:wm_mbuttonup) - (message-buttondown window msg wparam lparam)) - (#.win:wm_activate - (message-activate window msg wparam lparam)) - ((#.win:wm_killfocus - #.win:wm_close) - (message-killfocus window msg wparam lparam)) - (#.win:wm_initmenupopup - (message-initmenupopup window msg wparam lparam)) - (#.win:wm_nchittest - (message-nchittest window msg wparam lparam)) - (otherwise - (message-default window msg wparam lparam))) - (setf result *win-result*) + ;; FYI: Spy++ does a better job of tracing messages, + ;; though it doesn't report everything. + (when *maybe-format* (mformat excl:*initial-terminal-io* - "Out clim-wind-proc msg=~a sheet=~s result=~s~%" + "~A In clim-wind-proc msg=~a sheet=~s lparam=~a~%" + *level* (msg-name msg) - (mirror->sheet *acl-port* window) - result) - result))) + window + lparam)) + (when (> *level* 40) + (break "too deep!")) + (case msg + (#.win:wm_mousemove + (onmousemove window msg wparam lparam)) + (#.win:wm_setcursor + (onsetcursor window msg wparam lparam)) + (#.win:wm_paint + (onpaint window msg wparam lparam)) + (#.win:wm_drawitem + (ondrawitem window msg wparam lparam)) + ((#.win:wm_ctlcoloredit + #.win:wm_ctlcolorlistbox + #.win:wm_ctlcolorbtn + ;; couldn't get the colors to change for the following + ;; wm_ctlcolorxx messages - so we're not using them for the + ;; moment (cim 10/11/96) + ;; #.win:wm_ctlcolormsgbox + ;; #.win:wm_ctlcolordlg + ;; #.win:wm_ctlcolorscrollbar + ;; #.win:wm_ctlcolorstatic + ) + (onctlcoloredit window msg wparam lparam)) + (#.win:wm_command + (oncommand window msg wparam lparam)) + ((#.win:wm_hscroll #.win:wm_vscroll) + (onvscroll window msg wparam lparam)) + ((#.win:wm_move #.win:wm_size) + (onmove window msg wparam lparam)) + (#.win:wm_getminmaxinfo + (ongetminmaxinfo window msg wparam lparam)) + (#.win:en_update + (onupdate window msg wparam lparam)) + ;; character typed + ((#.win:wm_keydown + #.win:wm_syskeydown + #.win:wm_keyup + #.win:wm_syskeyup) + (onkeydown window msg wparam lparam)) + ((#.win:wm_lbuttondown + #.win:wm_rbuttondown + #.win:wm_mbuttondown + #.win:wm_lbuttonup + #.win:wm_rbuttonup + #.win:wm_mbuttonup) + (onbuttondown window msg wparam lparam)) + (#.win:wm_activate + (onactivate window msg wparam lparam)) + ((#.win:wm_killfocus + #.win:wm_close) + (onkillfocus window msg wparam lparam)) + (#.win:wm_initmenupopup + (oninitmenupopup window msg wparam lparam)) + (#.win:wm_nchittest + (onnchittest window msg wparam lparam)) + (otherwise + (message-default window msg wparam lparam))) + (setf result *win-result*) + (when *maybe-format* + (mformat excl:*initial-terminal-io* + "~A Out clim-wind-proc msg=~a sheet=~s result=~s~%" + *level* + (msg-name msg) + window + result)) + result)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Implements the window proc for the subclassed controls (presently @@ -848,11 +901,11 @@ (eql code win:vk_control) (eql code win:vk_menu)) (setq pass t)) - (let* ((capstate (win::getKeyState win:vk_capital)) - (numstate (win::getKeyState win:vk_numlock)) - (shiftstate (win::getKeyState win:vk_shift)) - (controlstate (win::getKeyState win:vk_control)) - (metastate (win::getKeyState win:vk_menu))) + (let* ((capstate (win:getKeyState win:vk_capital)) + (numstate (win:getKeyState win:vk_numlock)) + (shiftstate (win:getKeyState win:vk_shift)) + (controlstate (win:getKeyState win:vk_control)) + (metastate (win:getKeyState win:vk_menu))) (setf (modstate-control *ctlmodstate*) (or (minusp controlstate) (not (zerop (ash controlstate -15))))) (setf (modstate-meta *ctlmodstate*) @@ -900,7 +953,7 @@ (setq *win-result* (win:callwindowproc std-ctrl-proc-address window msg wparam lparam)) #+aclpc - (ct::%set-long *win-result* 4 0 + (ct:%set-long *win-result* 4 0 (win:callwindowproc std-ctrl-proc-address window msg wparam lparam)) *win-result*) @@ -935,40 +988,25 @@ result))) (defvar *clim-class* "ClimClass") - -#+aclpc -(defvar *win-name* (ct::ccallocate win:lpstr :size 5)) -#+aclpc -(ct:cset (:char *) *win-name* nil "CLIM" (string 4)) -#+aclpc -(defvar *menu-name* (ct::ccallocate win:lpstr :initial-value 0)) ; "ClimMenu" - -#+acl86win32 (defvar *win-name* "CLIM") -#+acl86win32 (defvar *menu-name* "ClimMenu") - -(defvar *win-arg* (ct::ccallocate win::lpvoid)) (defvar *win-x* "x") - (defvar *wndclass-registered* nil) - (defvar clim-window-proc-address nil) (defvar clim-ctrl-proc-address nil) (defvar std-ctrl-proc-address nil) - -(defun initialize-clim (&optional (mp t)) - (declare (ignore mp)) - (warn "~s deprecated - CLIM is automatically initialized" - 'initialize-clim)) - (defvar *clim-initialized* nil) - (defvar lpcmdline "") (defvar *hinst* 0) (defvar *hprevinst* 0) (defvar *screen-device* nil) + +(defun initialize-clim (&optional (mp t)) + (declare (ignore mp)) + (warn "~s deprecated - CLIM is automatically initialized" + 'initialize-clim)) + ;; CLIM makes one of these, gets the slot value, and then ;; throws the rest of it away. (defclass windows-screen-device () @@ -979,7 +1017,7 @@ (defun initialize-cg () (let* ((dataobj (make-array 3 :element-type '(signed-byte 32)))) - (win::GetWinMainArgs dataobj) + (win:GetWinMainArgs dataobj) (setq *hinst* (aref dataobj 0) *hprevinst* (aref dataobj 1) lpcmdline (aref dataobj 2))) @@ -1018,27 +1056,30 @@ ;; It creates a (single) Windows window class for all clim windows. (unless *wndclass-registered* (init-clim-win-proc clim-window-proc-address #.(make-cstructure 0 16)) - (let ((class (ct:ccallocate win::wndclassex)) + (let ((class (ct:ccallocate win:wndclassex)) (icon (win:LoadIcon 0 win:IDI_APPLICATION)) ; (get-clim-icon) (reg nil)) - (ct::csets win::wndclassex class - win::cbSize (ct:sizeof win::wndclassex) + (ct:csets win:wndclassex class + win::cbSize (ct:sizeof win:wndclassex) win::style (logior win:CS_DBLCLKS win:CS_BYTEALIGNCLIENT - win:CS_BYTEALIGNWINDOW) + win:CS_BYTEALIGNWINDOW + ;; win:CS_SAVEBITS ; Can we afford this? + ;; win:CS_OWNDC + ) win::lpfnwndproc clim-window-proc-address win::cbClsExtra 0 win::cbWndExtra 0 win::hinstance *hinst* win::hicon icon win::hcursor hcursor - win::hbrbackground (1+ win:color_window) - win::lpszmenuname ct::hnull ;*menu-name* + win::hbrbackground (1+ win:color_btnface) + win::lpszmenuname ct:hnull ;*menu-name* win::lpszclassname (ff:string-to-char* *clim-class*) win::hIconSm icon) - (setq reg (win::registerclassex class)) + (setq reg (win:registerclassex class)) (when (zerop reg) - (error "RegisterClassEx: system error ~S" (win:getlasterror))) + (check-last-error "RegisterClassEx")) (setq *wndclass-registered* t)) )) @@ -1048,14 +1089,13 @@ ;;;( lpctstr lpctstr dword int int int int hwnd hmenu handle lpstr) hwnd 351 %oscall) (defun create-overlapped-window (parent pretty scroll - left top width height native + left top width height menubar &optional modal) ;; Most frames come in here. (let ((winstyle (logior win:ws_clipsiblings - win:ws_border - win:ws_dlgframe + win:ws_caption win:ws_sysmenu win:ws_overlapped (if (or (eql scroll :both) (eql scroll :vertical)) @@ -1069,12 +1109,12 @@ win:ws_ex_left win:ws_ex_ltrreading win:ws_ex_rightscrollbar - win:ws_ex_windowedge)) + win:ws_ex_windowedge + win:ws_ex_controlparent ; tab btwn controls + )) (*win-name* *win-name*) (menu - (if native - (win:CreateMenu) - (ct::null-handle win::hmenu))) + (if menubar (win:CreateMenu) (ct:null-handle win:hmenu))) (window nil)) (when pretty (setq *win-name* pretty)) @@ -1082,7 +1122,7 @@ (setq winstyle (logior winstyle win:ws_popup - win:ds_modalframe + (if parent win:ds_modalframe 0) win:ds_3dlook win:ws_clipchildren)) (setq exstyle @@ -1102,12 +1142,13 @@ *win-name* winstyle left top width height - parent + (or parent 0) menu *hinst* *win-x* )) (when (zerop window) - (error "CreateWindowEx: system error ~s" (win:getlasterror))) + (or (check-last-error "CreateWindowEx") + (error "CreateWindowEx: unknown error"))) window)) (defun create-pop-up-window (parent pretty scroll left top width height @@ -1115,39 +1156,38 @@ (declare (ignore modal)) ;; MENU-FRAME comes in here. (let* ((overlap (if ovl - (logior win::ws_caption win::ws_sysmenu) ; not a menu + (logior win:ws_caption win:ws_sysmenu) ; not a menu (logior win:ws_thickframe win:ws_dlgframe) ; its a menu )) (winstyle (logior overlap - win::ws_popup + win:ws_popup (if (or (eql scroll :both)(eql scroll :vertical)) - win::ws_vscroll 0) + win:ws_vscroll 0) (if (or (eql scroll :both)(eql scroll :horizontal)) - win::ws_hscroll 0) - win::ws_clipchildren + win:ws_hscroll 0) + win:ws_clipchildren )) (*win-name* *win-name*)) (when pretty (setq *win-name* pretty)) - (let ((window (win::createWindowEx + (let ((window (win:createWindowEx (if ovl 0 win:ws_ex_toolwindow) *clim-class* *win-name* winstyle left top width height parent - (ct::null-handle win::hmenu) + (ct:null-handle win:hmenu) *hinst* *win-x*))) (when (zerop window) - (error "CreateWindowEx: system error ~s" (win:getlasterror))) + (check-last-error "CreateWindowEx")) window))) (defun create-child-window (parent pretty scroll left top width height) ;; Application pane comes in here. (let ((winstyle (logior win:ws_clipchildren win:ws_child - ;;win:ws_border (if (member scroll '(t :both :dynamic :vertical)) win:ws_vscroll 0) (if (member scroll '(t :both :dynamic :horizontal)) @@ -1156,53 +1196,62 @@ (exstyle (logior win:ws_ex_left win:ws_ex_ltrreading win:ws_ex_rightscrollbar - win:ws_ex_clientedge)) + win:ws_ex_controlparent ; tab btwn controls + ;; You get an "edge" if you use (outlining () ...) + ;; OR if you have scroll bars. This one is purely + ;; aesthetic but I think it's almost always appropriate. + ;; JPM 6/98. + (if scroll win:ws_ex_clientedge 0) + )) + ;; You can ask for a menu bar on a child window, + ;; but Windows will not give you one. + (menu (ct:null-handle win:hmenu)) (*win-name* *win-name*) (window nil)) (when pretty (setq *win-name* pretty)) (setq window - (win::createWindowEx exstyle + (win:createWindowEx exstyle *clim-class* *win-name* winstyle left top width height parent - (ct::null-handle win::hmenu) + menu *hinst* *win-x*)) (when (zerop window) - (error "CreateWindowEx: system error ~s" (win:getlasterror))) + (check-last-error "CreateWindowEx")) (if (or (eql scroll :both)(eql scroll :vertical)) (win:setScrollRange window win:SB_VERT 0 *win-scroll-grain* 1)) (if (or (eql scroll :both)(eql scroll :horizontal)) (win:setScrollRange window win:SB_HORZ 0 *win-scroll-grain* 1)) window)) -(defvar wres (ct::callocate :long)) -(defvar wmsg (ct::ccallocate win::msg)) +(defvar wres (ct:callocate :long)) +(defvar wmsg (ct:ccallocate win:msg)) (defun wait-for-event () (when (prog1 - (win:peekMessage wmsg (ct::null-handle win::hwnd) 0 0 + (win:peekMessage wmsg (ct:null-handle win:hwnd) 0 0 (logior win:PM_NOYIELD win:PM_NOREMOVE) #+acl86win32x wres) (not (and (zerop (hiword wres)) (zerop (loword wres))))) t)) -(defvar msg (ct::ccallocate win::msg)) -(defvar res (ct::callocate :long)) +(defvar msg (ct:ccallocate win:msg)) +(defvar res (ct:callocate :long)) ;;--- this never gets called on NT because we do a ;;--- sys::process-pending-events instead. (defun await-response (waitp) (if waitp (progn - (win:getMessage msg (ct::null-handle win::hwnd) 0 0) + (win:getMessage msg (ct:null-handle win:hwnd) 0 0) (win:TranslateMessage msg) (win:dispatchMessage msg) msg) - (let* ((ret (win:peekMessage msg (ct::null-handle win::hwnd) + (let* ((ret (win:peekMessage msg (ct:null-handle win:hwnd) 0 0 win:PM_REMOVE)) (do-it ret)) (when do-it diff --git a/aclpc/acl-dc.lisp b/aclpc/acl-dc.lisp index e6f2103969791adbe0ee14f6a295657d1278e478..a14f76fe983ce3f00f43b2d7c327c4ce01b27013 100644 --- a/aclpc/acl-dc.lisp +++ b/aclpc/acl-dc.lisp @@ -1,5 +1,22 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- - +;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-dc.lisp,v 1.6 1998/08/06 23:15:41 layer Exp $ #|**************************************************************************** * * @@ -33,7 +50,10 @@ (defvar *blank-image*) (defvar *ltgray-image*) -(defconstant +ltgray+ (make-instance 'design)) +;; This is not just any 75% gray. There are +;; methods to treat this object specially and +;; use COLOR_BTNFACE as the realization of this ink. +(defconstant +ltgray+ (make-gray-color .75)) (defmethod make-load-form ((design (eql (symbol-value '+ltgray+))) &optional environment) (declare (ignore environment)) @@ -52,57 +72,66 @@ (defvar *created-font* nil) (defvar *created-region* nil) - (defstruct (dc-image (:predicate nil)) (bitmap nil) solid-1-pen ;; Hash table doesn't appear to be needed anymore. JPM Jan 98. (pen-table nil #+obsolete (make-hash-table)) brush - (rop2 win::r2_copypen) + (rop2 win:r2_copypen) text-color background-color) (defun initialize-dc () - - (unless (win::iswindow *current-window*) + (unless (win:iswindow *current-window*) (error "No Window: ~S" *current-window*)) ;; Stock objects - (setf *null-pen* (win::getStockObject win::null_pen)) - (setf *black-pen* (win::getStockObject win::black_pen)) - (setf *white-pen* (win::getStockObject win::white_pen)) + (setf *null-pen* (win:getStockObject win:null_pen)) + (setf *black-pen* (win:getStockObject win:black_pen)) + (setf *white-pen* (win:getStockObject win:white_pen)) (setf *ltgray-pen* - (win::createPen win::ps_solid 1 (win::getSysColor win::COLOR_BTNFACE))) - - (setf *null-brush* (win::getStockObject win::null_brush)) - (setf *black-brush* (win::getStockObject win::black_brush)) - (setf *white-brush* (win::getStockObject win::white_brush)) + (createPen win:ps_solid 1 (win:getSysColor win:COLOR_BTNFACE))) + ;; + (setf *null-brush* (win:getStockObject win:null_brush)) + (setf *black-brush* (win:getStockObject win:black_brush)) + (setf *white-brush* (win:getStockObject win:white_brush)) (setf *ltgray-brush* - (win::createSolidBrush (win::getSysColor win::COLOR_BTNFACE))) - + (win:createSolidBrush (win:getSysColor win:COLOR_BTNFACE))) + ;; + #+obsolete (setf *black-image* - (make-dc-image :solid-1-pen *black-pen* :brush *black-brush* - :text-color #x000000 :background-color nil)) + (make-dc-image :solid-1-pen *black-pen* + :brush *black-brush* + :text-color #x000000 + :background-color nil + :rop2 win:r2_copypen)) + #+obsolete (setf *white-image* - (make-dc-image :solid-1-pen *white-pen* :brush *white-brush* - :text-color #xffffff :background-color nil)) + (make-dc-image :solid-1-pen *white-pen* + :brush *white-brush* + :text-color #xffffff + :background-color nil + :rop2 win:r2_copypen)) (setf *blank-image* #+possibly - (make-dc-image :solid-1-pen *black-pen* :brush *black-brush* + (make-dc-image :solid-1-pen *black-pen* + :brush *black-brush* :text-color #xffffffff ; see CLR_NONE :background-color nil - :rop2 win::r2_mergepen ) - (make-dc-image :solid-1-pen *black-pen* :brush *black-brush* + :rop2 win:r2_mergepen ) + (make-dc-image :solid-1-pen *black-pen* + :brush *black-brush* :text-color #x000000 :background-color nil - :rop2 win::r2_nop )) - + :rop2 win:r2_nop )) + ;; (setf *ltgray-image* (make-dc-image :solid-1-pen *ltgray-pen* :brush *ltgray-brush* - :text-color (win::getSysColor win::COLOR_BTNFACE) - :background-color nil)) - + :text-color (win:getSysColor win:COLOR_BTNFACE) + :background-color nil + :rop2 win:r2_copypen)) + ;; (setq *dc-initialized* t) ) @@ -113,158 +142,127 @@ (defun release-objects (window dc) (when *created-pen* - (win::selectObject dc *black-pen*) - (win::deleteObject *created-pen*) + (selectobject dc *black-pen*) + (win:deleteObject *created-pen*) (setq *created-pen* nil)) (when *created-brush* - (win::selectObject dc *white-brush*) - (win::deleteObject *created-brush*) + (selectobject dc *white-brush*) + (win:deleteObject *created-brush*) (setq *created-brush* nil)) (when *created-tile* - (win::deleteObject *created-tile*) + (win:deleteObject *created-tile*) (setq *created-tile* nil)) (when *created-region* - (win::selectObject dc (ct::null-handle win::hrgn)) - (win::deleteObject *created-region*) + (selectobject dc (ct::null-handle win:hrgn)) + (win:deleteObject *created-region*) (setq *created-region* nil)) (when (and *created-font* *original-font*) - (win::selectObject dc *original-font*) - (win::deleteObject *created-font*) + (selectobject dc *original-font*) + (win:deleteObject *created-font*) (setq *created-font* nil)) (when (and *created-bitmap* *original-bitmap*) - (win::selectObject dc *original-bitmap*) - (note-destroyed *created-bitmap*) - (win::deleteObject *created-bitmap*) + (selectobject dc *original-bitmap*) + (win:deleteObject *created-bitmap*) (setq *created-bitmap* nil)) (dolist (xtra *extra-objects*) - (note-destroyed xtra) - (win::deleteObject xtra)) + (win:deleteObject xtra)) (setq *extra-objects* nil) - (win::releaseDc window dc)) - -(defvar *note-created* ()) - -(defun note-created (kind obj) - (declare (ignore kind)) - #+ignore (push (cons obj kind) *note-created*) - obj) - -(defun note-destroyed (obj) - #+ignore (setf *note-created* (delete obj *note-created* :key #'car)) - obj) - + (win:releaseDc window dc)) (defclass acl-pixmap (pixmap) - ((bitmap :initarg :bitmap) - (for-medium :initarg :for-medium) - (cdc :initarg :cdc :reader pixmap-cdc) - (width :initarg :width :reader pixmap-width) - (height :initarg :height :reader pixmap-height) - (original-bitmap :initarg :original-bitmap) -)) - -#+ignore ; old version, new below supports with output to pixmap + ((bitmap :initarg :bitmap) + (for-medium :initarg :for-medium) + (cdc :initarg :cdc :reader pixmap-cdc) + (width :initarg :width :reader pixmap-width) + (height :initarg :height :reader pixmap-height) + (original-bitmap :initarg :original-bitmap))) + +;; The call to GetDC will cons a bignum (16 bytes). +;; We should probably try to optimize this some how +;; since it is called constantly during simple +;; things like repaint. (defmacro with-dc ((window dc) &rest body) - `(let ((,dc nil)) - (unwind-protect - (progn - (setf ,dc (win::getDc ,window)) - ,@body) - (release-objects ,window ,dc)))) - -#+++ignore -(defmacro with-dc ((window dc) &rest body) - `(let ((,dc nil)) - (if (typep ,window 'acl-pixmap) - (with-slots (cdc for-medium) ,window - (let ((,dc cdc) - (medium for-medium)) + `(if (typep ,window 'acl-pixmap-medium) + (let ((,dc (pixmap-cdc (medium-drawable ,window)))) + ,@body) + ;; It was my intention to rewrite this to + ;; cache the DC, in combination with setting + ;; CS_OWNDC. + (let ((,dc 0)) + (unwind-protect (progn + (setq ,dc (getDc ,window)) ,@body) - )) - (unwind-protect - (progn - (setf ,dc (win::getDc ,window)) - ,@body) - (release-objects ,window ,dc)) - ))) - -(defmacro with-dc ((window dc) &rest body) - `(let ((,dc nil)) - (if (typep ,window 'acl-pixmap) - (with-slots (cdc for-medium) ,window - (let ((,dc cdc) - (medium for-medium) - ) - medium - ,@body)) + (release-objects ,window ,dc))))) + +(defmacro with-medium-dc ((medium dc) &rest body) + `(if (typep ,medium 'acl-pixmap-medium) + (let ((,dc (pixmap-cdc (medium-drawable ,medium)))) + ,@body) + ;; It was my intention to rewrite this to + ;; cache the DC, in combination with setting + ;; CS_OWNDC. + (let ((,dc 0)) (unwind-protect (progn - (setf ,dc (win::getDc ,window)) + (setq ,dc (getDc (medium-drawable ,medium))) ,@body) - (release-objects ,window ,dc)) - ))) - + (release-objects (medium-drawable ,medium) ,dc))))) (defmacro with-compatible-dc ((dc cdc) &rest body) `(let ((,cdc nil)) - (unwind-protect - (progn - (setf ,cdc (win::createCompatibleDC ,dc)) - ,@body) - (win::selectObject ,cdc *original-bitmap*) - (when (and *created-bitmap* - (not (ct::null-handle-p win::hbitmap *created-bitmap*))) - (win::deleteObject *created-bitmap*) - ) - (setf *created-bitmap* nil) - (win::deleteDc ,cdc)))) - -;;; - -#+ignore -(defconstant CLR_NONE #xffffffff) ;; jpm Aug97 + (unwind-protect + (progn + (setf ,cdc (win:createCompatibleDC ,dc)) + ,@body) + (selectobject ,cdc *original-bitmap*) + (when (and *created-bitmap* + (not (ct::null-handle-p win:hbitmap *created-bitmap*))) + (win:deleteObject *created-bitmap*)) + (setf *created-bitmap* nil) + (win:deleteDc ,cdc)))) (defun set-dc-for-drawing (dc image line-style) (let* ((dashes (line-style-dashes line-style)) - (thickness (max 1 (round (line-style-thickness line-style)))) + (thickness (max 1 (round (line-style-thickness line-style)))) (code (if dashes (- thickness) thickness)) - (pen (when (= code 1) (dc-image-solid-1-pen image)))) + (brush *null-brush*) + (pen (when (= code 1) (dc-image-solid-1-pen image))) + (rop2 (dc-image-rop2 image))) (declare (fixnum thickness code)) (unless pen - (when *created-pen* - (push *created-pen* *extra-objects*)) + (when *created-pen* + (push *created-pen* *extra-objects*)) (setq pen - (setq *created-pen* - (note-created 'pen (win::createPen (if dashes win::ps_dash win::ps_solid) - thickness - (dc-image-text-color image)))))) - (win::selectObject dc pen) - #+ignore (when dashes (win::setBkColor dc CLR_NONE)) ;; jpm Aug97 - (when dashes (win::setBkMode dc win:TRANSPARENT))) ;; tjm Aug97 - (win::selectObject dc *null-brush*) - (win::setRop2 dc (dc-image-rop2 image)) - image) + (setq *created-pen* + (createPen (if dashes win:ps_dash win:ps_solid) + thickness + (dc-image-text-color image))))) + (selectobject dc pen) + (if dashes + (win:setBkMode dc win:TRANSPARENT) + (win:setBkMode dc win:OPAQUE)) + (selectobject dc brush) + (when rop2 (win:setRop2 dc rop2)) + t)) (defun set-dc-for-filling (dc image) (let ((background-color (dc-image-background-color image)) - (text-color (dc-image-text-color image))) - (win::selectObject dc *null-pen*) + (text-color (dc-image-text-color image)) + (brush (dc-image-brush image)) + (pen *null-pen*) + (rop2 (dc-image-rop2 image))) + (selectobject dc pen) (when background-color - (win::setBkColor dc background-color)) - (when text-color - (win::setTextColor dc text-color)) - (win::selectObject dc (dc-image-brush image)) - (win::setRop2 dc (dc-image-rop2 image)))) - -#+old -(defun set-dc-for-filling (dc image) - (win::selectObject dc *null-pen*) - (win::selectObject dc (dc-image-brush image)) - (let ((background-color (dc-image-background-color image))) - (when background-color - (win::setBkColor dc background-color))) - (win::setRop2 dc (dc-image-rop2 image))) + (cond ((minusp background-color) + (win:setBkMode dc win:TRANSPARENT)) + (t + (win:setBkMode dc win:OPAQUE) + (win:setBkColor dc background-color)))) + (when text-color (win:setTextColor dc text-color)) + (when brush (selectobject dc brush)) + (when rop2 (win:setRop2 dc rop2)) + t)) (defun set-dc-for-ink (dc medium ink line-style) (let ((image (dc-image-for-ink medium ink))) @@ -275,43 +273,55 @@ (defun set-cdc-for-pattern (dc medium ink line-style) (declare (ignore line-style)) (let ((image (dc-image-for-ink medium ink)) + #+ign size) (when (typep ink 'pattern) + #+ign (multiple-value-bind (array designs) (decode-pattern ink) (declare (ignore array)) (setf size (length designs))) (setf *created-bitmap* (dc-image-bitmap image)) (cond ((or (not *created-bitmap*) - (ct::null-handle-p win::hbitmap *created-bitmap*)) + (ct::null-handle-p win:hbitmap *created-bitmap*)) (format *terminal-io* "No bitmap (~s) ~%" *created-bitmap*)) - - ((ct::null-handle-p win::hdc dc) + ((ct::null-handle-p win:hdc dc) (format *terminal-io* "No DC (~s) ~%" dc)) (t - (setf *original-bitmap* (win::selectObject dc *created-bitmap*)))) + (setf *original-bitmap* (selectobject dc *created-bitmap*)))) + #+ign (unless (> size 2) (let ((background-color (dc-image-background-color image)) (text-color (dc-image-text-color image))) - (when background-color - (win::setBkColor dc background-color)) + (cond ((not background-color)) + ((minusp background-color) + (win:setbkmode dc win:TRANSPARENT)) + (t + (win:setbkmode dc win:OPAQUE) + (win:setBkColor dc background-color))) (when text-color - (win::setTextColor dc text-color))) - (win::setRop2 dc (dc-image-rop2 image)))) - #+ignore - (format *terminal-io* "~%Size: ~S ~S" size designs) - (if (> size 2) win::srccopy win::notsrccopy))) + (win:setTextColor dc text-color))) + (win:setRop2 dc (dc-image-rop2 image)))) + win:srccopy)) (defun set-dc-for-text (dc medium ink font) (let* ((image (dc-image-for-ink medium ink)) + (text-color (dc-image-text-color image)) (background-color (dc-image-background-color image)) - (oldfont (win::selectObject dc font))) - (win::setBkMode dc win::transparent) - (win::setTextColor dc (dc-image-text-color image)) - (when background-color - (win::setBkColor dc background-color)) - (unless *original-font* (setf *original-font* oldfont)) - (win::setRop2 dc (dc-image-rop2 image)) - )) + (brush (dc-image-brush image)) + (pen (dc-image-solid-1-pen image)) + (rop2 (dc-image-rop2 image))) + (when font (selectobject dc font)) + (cond ((not background-color) + (win:setBkMode dc win:transparent)) + ((minusp background-color) + (win:setBkMode dc win:transparent)) + (t + (win:setbkmode dc win:OPAQUE) + (win:setBkColor dc background-color))) + (when text-color (win:setTextColor dc text-color)) + (when brush (win:selectobject dc brush)) + (when pen (win:selectobject dc pen)) + (when rop2 (win:setRop2 dc rop2)))) (defgeneric dc-image-for-ink (medium ink)) diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp index 2ea0ad46685328331accfb7ec3dc6808db41363d..8aa16e10a91decefad6e39ed2c76a8fa954cd3c4 100644 --- a/aclpc/acl-frames.lisp +++ b/aclpc/acl-frames.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-frames.lisp,v 1.7 1998/08/06 23:15:43 layer Exp $ #|**************************************************************************** * * @@ -33,40 +51,39 @@ (native *use-native-menubar* #+ignore (slot-value frame 'msmenubart)) (pointer-doc-pane nil) (pointer-options - (clim-internals::frame-pointer-documentation-p frame))) - (when ;mm: was: (eq menu-bar 't) + (clim-internals::frame-pointer-documentation-p frame))) + (when ;mm: was: (eq menu-bar 't) (silica::default-command-table-p menu-bar) (setq menu-bar (frame-command-table frame))) (when native (setf (getf (frame-properties frame) :native-menu) t)) (when pointer-options (setq pointer-doc-pane - (with-look-and-feel-realization (framem frame) - (apply #'make-pane - 'clim-internals::pointer-documentation-pane - :name :pointer-documentation - (append (and (listp pointer-options) pointer-options) - `(:max-width ,+fill+ - ;; commented out hard-wired - ;; white background (cim 10/9/96) - #| :background ,+white+ |# - :min-height (1 :line) - :max-height (1 :line) - :height (1 :line))))))) + (with-look-and-feel-realization (framem frame) + (apply #'make-pane + 'clim-internals::pointer-documentation-pane + :name :pointer-documentation + (append (and (listp pointer-options) pointer-options) + `(:max-width ,+fill+ + ;; commented out hard-wired + ;; white background (cim 10/9/96) + #| :background ,+white+ |# + :min-height (1 :line) + :max-height (1 :line) + :height (1 :line))))))) #+ignore ;; rl: wanted to do the menu bar here, but can't (when (and native menu-bar) (compute-msmenu-bar-pane frame menu-bar)) (with-look-and-feel-realization (framem frame) - (outlining () - (cond ((and (not native) menu-bar pointer-doc-pane) - (vertically () - (compute-menu-bar-pane frame menu-bar) - pane - pointer-doc-pane)) - ((and (not native) menu-bar) - (vertically () (compute-menu-bar-pane frame menu-bar) pane)) - (pointer-doc-pane - (vertically () pane pointer-doc-pane)) - (t pane)))))) + (cond ((and (not native) menu-bar pointer-doc-pane) + (vertically () + (compute-menu-bar-pane frame menu-bar) + pane + pointer-doc-pane)) + ((and (not native) menu-bar) + (vertically () (compute-menu-bar-pane frame menu-bar) pane)) + (pointer-doc-pane + (vertically () pane pointer-doc-pane)) + (t pane))))) (defclass acl-top-level-sheet (top-level-sheet) ((min-width :accessor acl-top-min-width :initform nil) @@ -132,13 +149,12 @@ ;; a global id counter and the association list should be kept on a ;; per application-frame basis. -(defun get-command-menu-item-id (command frame) +(defun assign-command-menu-item-id (command frame) + ;; We should probably allow COMMAND to be NIL. + ;; It is allowed for the UNIX port, apparently. + (when (atom command) (setq command (list command))) (prog1 (fill-pointer *menu-id->command-table*) - #+ignore - (when (= (fill-pointer *menu-id->command-table*) - (array-total-size *menu-id->command-table*)) - (cerror "Continue" "Too many menu items")) (vector-push-extend (cons frame command) *menu-id->command-table* 256))) @@ -146,9 +162,8 @@ (position-if #'(lambda (x) (when x - (destructuring-bind (f c &rest args) - x - (declare (ignore args)) + (let ((f (first x)) + (c (second x))) (and (eq f frame) (eq c command))))) *menu-id->command-table*)) @@ -158,8 +173,7 @@ (dotimes (id (fill-pointer *menu-id->command-table*)) (let ((x (aref *menu-id->command-table* id))) (when x - (destructuring-bind (f c &rest xargs) x - (declare (ignore xargs c)) + (let ((f (first x))) (if (eq f frame) (apply func id args))))))) ;;; Disable all menu items. @@ -224,29 +238,21 @@ (make-array 2048 :fill-pointer t :element-type 'character))) (defun nstringify (x) + ;; This function is now a misnomer. It is not destructive. (typecase x (simple-string x) - (string - (let ((new-length - (min (length x) (length nstringify-buffer)))) - (ncopy-vector nstringify-buffer x 0 0 new-length) - (set-strlen nstringify-buffer new-length) - nstringify-buffer)) + (string (coerce x 'simple-string)) (null "") - (t (nprin1-to-string x)))) + (t (prin1-to-string x)))) (defun nstringify-for-control (x) + ;; This function is now a misnomer. It is not destructive. (typecase x ((not symbol) (nstringify x)) (null "") (t - (let* ((symbol-name (symbol-name x)) - (new-length - (min (length symbol-name) #.(length nstringify-buffer)))) - (ncopy-vector nstringify-buffer symbol-name 0 0 new-length) - (set-strlen nstringify-buffer new-length) - (nstring-capitalize nstringify-buffer :end new-length))))) + (string-upcase (nstringify x))))) (defun schar-byte (string index) (if (< index (length string)) @@ -322,87 +328,82 @@ newtext)))) (defun compute-msmenu-bar-pane (frame top command-table) - (let* (#+ignore - (text-style - (and (listp command-table) - (getf (cdr command-table) :text-style) - `(:text-style ,(getf (cdr command-table) :text-style)))) - (mirror (sheet-mirror top)) + (let* ((mirror (sheet-mirror top)) (menu-handle (win:GetMenu mirror)) (command-table - (if (listp command-table) (car command-table) command-table))) - (when - ;; command-table arg comes from menu-bar slot of frame - ;; and may be NIL T=menu-hbox-pane command-table-arg - (silica::default-command-table-p command-table) + (if (listp command-table) (car command-table) command-table))) + (when (silica::default-command-table-p command-table) + ;; command-table arg comes from menu-bar slot of frame + ;; and may be NIL T=menu-hbox-pane command-table-arg (setq command-table (frame-command-table frame))) (with-look-and-feel-realization ((frame-manager frame) frame) (labels - ((make-command-table-buttons (command-table menuhand top-level) - (let ((menu-item-ids nil)) - (map-over-command-table-menu-items - #'(lambda (menu keystroke item) - (let* ((type (command-menu-item-type item)) - (value (command-menu-item-value item)) - (menu-item-available-p - (or (not (eq type :command)) - (command-enabled (car value) frame))) - (menu-item-selected-p nil) - (acckey (and (not top-level) keystroke)) - (flags (logior - win:MF_STRING - (if menu-item-available-p - win:MF_ENABLED win:MF_GRAYED) - (if menu-item-selected-p - win:MF_CHECKED win:MF_UNCHECKED))) - (smflags (logior flags win:MF_POPUP))) - (case type - (:command - (when acckey - (record-accelerator top acckey value)) - (let ((menu-item-id (get-command-menu-item-id value frame))) - (win:AppendMenu - menuhand - flags - menu-item-id - (make-menu-text menu acckey item)) - (push menu-item-id menu-item-ids))) - (:function - ;; do something here - ) - (:menu - (let* ((popmenu (win::CreatePopupMenu)) - (hmenu (ct:handle-value 'win::hmenu popmenu)) - (menutext (make-menu-text menu acckey item))) - (win::AppendMenu menuhand - smflags - hmenu - menutext) - (setf (gethash hmenu *popup-menu->menu-item-ids*) - (make-command-table-buttons value popmenu nil)))) - (:divider - (unless top-level - (win::AppendMenu menuhand - win:MF_SEPARATOR - 0 - "x") - ))))) - command-table) - menu-item-ids))) + ((make-command-table-buttons (command-table menuhand top-level) + (let ((menu-item-ids nil)) + (map-over-command-table-menu-items + #'(lambda (menu keystroke item) + (let* ((type (command-menu-item-type item)) + (value (command-menu-item-value item)) + (menu-item-available-p + (or (not (eq type :command)) + (command-enabled (car value) frame))) + (menu-item-selected-p nil) + (acckey (and (not top-level) keystroke)) + (flags (logior + win:MF_STRING + (if menu-item-available-p + win:MF_ENABLED win:MF_GRAYED) + (if menu-item-selected-p + win:MF_CHECKED win:MF_UNCHECKED))) + (smflags (logior flags win:MF_POPUP))) + (case type + (:command + (when acckey + (record-accelerator top acckey value)) + (let ((menu-item-id + (assign-command-menu-item-id value frame))) + (win:AppendMenu + menuhand + flags + menu-item-id + (make-menu-text menu acckey item)) + (push menu-item-id menu-item-ids))) + (:function + (warn ":function not yet implemented in menu bars") + ) + (:menu + (let* ((popmenu (win::CreatePopupMenu)) + (hmenu (ct:handle-value 'win::hmenu popmenu)) + (menutext (make-menu-text menu acckey item))) + (win::AppendMenu menuhand + smflags + hmenu + menutext) + (setf (gethash hmenu *popup-menu->menu-item-ids*) + (make-command-table-buttons value popmenu nil)))) + (:divider + (unless top-level + (win::AppendMenu menuhand + win:MF_SEPARATOR + 0 + "x") + ))))) + command-table) + menu-item-ids))) (make-command-table-buttons command-table menu-handle t))))) (defun update-menu-item-sensitivities (hmenu) (dolist (menu-item-id (gethash hmenu *popup-menu->menu-item-ids*)) - (destructuring-bind (frame command &rest args) - (aref *menu-id->command-table* menu-item-id) - (declare (ignore args)) - (let* ((top (frame-top-level-sheet frame)) - (mirror (sheet-mirror top)) - (menu-handle (win::GetMenu mirror))) - (win::EnableMenuItem menu-handle menu-item-id - (if (command-enabled command frame) - win:MF_ENABLED - win:MF_GRAYED)))))) + (let* ((item (aref *menu-id->command-table* menu-item-id)) + (frame (first item)) + (command (second item)) + (top (frame-top-level-sheet frame)) + (mirror (sheet-mirror top)) + (menu-handle (win::GetMenu mirror))) + (win::EnableMenuItem menu-handle menu-item-id + (if (command-enabled command frame) + win:MF_ENABLED + win:MF_GRAYED))))) (defmethod redisplay-frame-panes :around ((frame standard-application-frame) &key force-p) @@ -450,14 +451,13 @@ to be run from another." (when menu-handle (win::EnableMenuItem menu-handle command-id flag)))) -;; moved the SetForegroundWindow call from an around method on -;; realize-mirror to the following method to stop the focus moving -;; when the window wasn't yet visible (cim 10/3/96) - (defmethod note-frame-enabled :around ((framem acl-frame-manager) frame) (call-next-method) (let ((*in-layout-avp* *in-layout-avp*) (sheet (frame-top-level-sheet frame)) + #+nevermind + (parent (and *application-frame* + (frame-top-level-sheet *application-frame*))) (avp nil)) (when sheet (map-over-sheets #'(lambda (sheet) @@ -465,17 +465,31 @@ to be run from another." (setf avp t))) sheet) (setf *in-layout-avp* avp) - (setf (sheet-enabled-p (frame-top-level-sheet frame)) t) - ;; On Windows95, this call often fails when enabling a menu-frame. - ;; But the menu shows up after a few seconds anyway. So that is - ;; why it would be bad to check the return status of this guy. - (win:SetForegroundWindow (sheet-mirror sheet))))) + (setf (sheet-enabled-p sheet) t) + ;; Put the window somewhere other than the bottom of the Z order. + ;; Avoid putting the window on top of all windows, if possible, + ;; to avoid de-selecting another activity that the user + ;; is trying to keep selected. This window probably ought to + ;; be the topmost clim window but not necessarily the topmost + ;; of all windows. + #+nevermind + (win:setWindowPos (sheet-mirror sheet) + (cond ((not parent) win:HWND_TOP) + ((typep frame 'clim-internals::menu-frame) + win:HWND_TOPMOST) + (t (sheet-mirror parent))) + 0 0 0 0 ; x y width height + (logior win:swp_nomove ; ignore x y + win:swp_nosize ; ignore width height + )) + (raise-sheet sheet)))) (defmethod note-frame-layout-changed :after ((framem acl-frame-manager) frame) ;; added this to workaround some bugs with new layouts not being ;; correctly redisplayed - in particular problems with label-panes ;; - this should be viewed as a temporary fix (cim 10/14/96) (repaint-sheet (frame-top-level-sheet frame) +everywhere+) + ;; spr16580. ;; Added this next one to fix problem with distribute-event ;; after changing the layout of the frame. Need to clear ;; port-trace-thing, otherwise buttons may "go dead" due to a failure @@ -485,8 +499,8 @@ to be run from another." ) (defmethod frame-manager-note-pretty-name-changed - ((framem acl-frame-manager) - (frame standard-application-frame)) + ((framem acl-frame-manager) + (frame standard-application-frame)) (let ((name (frame-pretty-name frame)) (sheet (frame-top-level-sheet frame))) (when name @@ -497,8 +511,8 @@ to be run from another." (ct::cset (:char 256) cstr ((fixnum i)) (char-int (char name i)))) (ct::cset (:char 256) cstr ((fixnum subsize)) #-aclpc (char-int #\NULL) #+aclpc 0) - (or (win:SetWindowText win cstr) - (error "SetWindowText: system error ~s" (win:getlasterror))))))) + (or (win:SetWindowText win cstr) + (check-last-error "SetWindowText")))))) (defun select-messagebox-icon (style) ;; Decides which Windows icon matches this (standardized) style. @@ -653,36 +667,38 @@ to be run from another." (write-string message-string stream))))))) (defun do-one-menu-item (popmenu item printer tick alist submenus) - (flet ((print-item (item) - (with-output-to-string (stream) - (funcall (or printer #'print-menu-item) item stream)))) - (declare (dynamic-extent #'print-item)) - (incf tick) - (ecase (clim-internals::menu-item-type item) - (:divider - (win:appendmenu popmenu win:MF_SEPARATOR tick 0)) - (:label - (win:appendmenu popmenu win:MF_DISABLED tick - (print-item item))) - (:item - (if (clim-internals::menu-item-items item) - (let ((submenu (win:createpopupmenu))) - (push submenu submenus) - ;; submenu - (win:appendmenu popmenu win:MF_POPUP submenu - (print-item item)) - (map nil - #'(lambda (it) - (multiple-value-setq (tick alist submenus) - (do-one-menu-item submenu it printer - tick alist submenus))) - (clim-internals::menu-item-items item))) - (progn - (push (list tick (menu-item-value item)) - alist) - (win:appendmenu popmenu win:MF_ENABLED tick - (print-item item)))))) - (values tick alist submenus))) + (let ((*print-circle* nil)) + (flet ((print-item (item) + (silica::xlat-newline-return + (with-output-to-string (stream) + (funcall (or printer #'print-menu-item) item stream))))) + (declare (dynamic-extent #'print-item)) + (incf tick) + (ecase (clim-internals::menu-item-type item) + (:divider + (win:appendmenu popmenu win:MF_SEPARATOR tick 0)) + (:label + (win:appendmenu popmenu win:MF_DISABLED tick + (print-item item))) + (:item + (if (clim-internals::menu-item-items item) + (let ((submenu (win:createpopupmenu))) + (push submenu submenus) + ;; submenu + (win:appendmenu popmenu win:MF_POPUP submenu + (print-item item)) + (map nil + #'(lambda (it) + (multiple-value-setq (tick alist submenus) + (do-one-menu-item submenu it printer + tick alist submenus))) + (clim-internals::menu-item-items item))) + (progn + (push (list tick (menu-item-value item)) + alist) + (win:appendmenu popmenu win:MF_ENABLED tick + (print-item item)))))) + (values tick alist submenus)))) ;; Gets rid of scroll bars if possible. (defmethod frame-manager-menu-choose @@ -704,30 +720,36 @@ to be run from another." x-position y-position scroll-bars) - (declare (ignore text-style - gesture cache-test cache-value - id-test unique-id label)) - ;; What we oughta do here is implement a real Win32 menu. - ;; Think about calling CreatePopupMenu - (if (or presentation-type foreground background cache row-wise - n-columns n-rows scroll-bars) + ;; The basic theory of ignoring is that we ignore arguments + ;; that don't contribute functionality and just bring up + ;; the native menu without any fluff. + (declare (ignore text-style cache + cache-test cache-value + id-test unique-id label + foreground background)) + (if (or presentation-type ;; foreground background + row-wise n-columns n-rows scroll-bars) (call-next-method) #+simple-but-sure (apply #'call-next-method framem items :scroll-bars nil keys) - (let ((popmenu (win::CreatePopupMenu)) + (let ((popmenu (win:CreatePopupMenu)) (submenus nil) - (flags (logior win:tpm_returncmd win:tpm_nonotify - win:tpm_leftbutton win:tpm_rightbutton)) + (flags (logior win:tpm_returncmd ; return the selection + win:tpm_nonotify ; don't notify clim + (if (eq gesture :menu) + win:tpm_rightbutton + win:tpm_leftbutton))) + (rect 0) (tick 0) (alist nil) (code 0)) (when (zerop popmenu) - (error "CreatePopupMenu -- system error ~A" (win:getlasterror))) + (check-last-error "CreatePopupMenu")) (unless (and x-position y-position) ;; Get screen coordinates of pointer. (let ((point (ct:ccallocate win:point))) (or (win:getCursorPos point) - (error "GetCursorPos: system error ~s" (win:getlasterror))) + (check-last-error "GetCursorPos")) (setq x-position (ct:cref win:point point x)) (setq y-position (ct:cref win:point point y)))) (setq x-position (truncate x-position)) @@ -737,18 +759,26 @@ to be run from another." (do-one-menu-item popmenu item printer tick alist submenus))) items) + ;; Bug here, exhibited by CAD Demo Create, that menu + ;; is sometimes never exposed. TrackPopupMenu returns 0. + ;; But most of the time this seems to work... 5/98 JPM. (setq code (win:trackpopupmenu - popmenu flags x-position y-position 0 - (sheet-mirror associated-window) 0)) + popmenu flags x-position y-position + 0 ; reserved, must be zero + (sheet-mirror associated-window) rect)) (win:destroymenu popmenu) (dolist (submenu submenus) (win:destroymenu submenu)) - (second (assoc code alist))))) + (cond ((zerop code) ; no item is selected + nil) + (t + (second (assoc code alist))))))) (defun make-filter-string (dotted-pair) - (format nil "~a (~a)~a~a~a" - (car dotted-pair) (cdr dotted-pair) (cltl1:int-char 0) - (cdr dotted-pair) (cltl1:int-char 0))) + (let ((*print-circle* nil)) + (format nil "~a (~a)~a~a~a" + (car dotted-pair) (cdr dotted-pair) (code-char 0) + (cdr dotted-pair) (code-char 0)))) (eval-when (compile load eval) (defconstant *scratch-string-length* 256) @@ -932,21 +962,6 @@ to be run from another." common-dialog-errors)) error-code)))))))))) -(ff:def-foreign-type browseinfo - (:struct (hwndOwner win:hwnd) - (pidlRoot win:long #+ig win:lpcitemidlist) - (pszDisplayName win:lpstr) - (lpszTitle win:lpcstr) - (ulflags win:uint) - (lpfn (* :void) #+ig win:bffcallback) - (lparam win:lparam) - (iImage :int))) - -(ff:def-foreign-call (SHBrowseForFolder "SHBrowseForFolder") - ((info browseinfo)) - :returning :int - :release-heap :when-ok) - (defun get-directory (sheet title) (let* ((info (ct:ccallocate browseinfo))) (ct:csets browseinfo info @@ -990,8 +1005,6 @@ to be run from another." file-search-proc documentation)) (unless pattern (setq pattern "")) - (unless directory - (setq directory (namestring (excl:current-directory)))) (when default-p (let ((name (pathname-name default)) (type (pathname-type default)) @@ -1008,6 +1021,14 @@ to be run from another." (namestring (make-pathname :name nil :directory dir :device device)))))) + ;; Massage the directory to make sure, in particular, + ;; that it has a device. Expensive, but worth it to + ;; avoid a segmentation violation. JPM. + (if directory + (setq directory + (namestring (merge-pathnames (pathname directory) + (excl:current-directory)))) + (setq directory (namestring (excl:current-directory)))) (let* ((stream associated-window) (save-p nil) (directory-p nil)) @@ -1026,6 +1047,162 @@ to be run from another." multiple-select warn-if-exists-p)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Progress notification code. + +(define-application-frame nt-working-dialog () + ((note :initform "" :accessor work-note :initarg :note) + (fraction :initform 0.0 :accessor fraction + :initarg :fraction) + (cancellable :initform t :accessor cancellable + :initarg :cancellable) + (cancel-button :accessor cancel-button) + (thermopane :initform nil :accessor thermopane) + (notepane :initform nil :accessor notepane) + (process :accessor work-process)) + (:panes + (display + (setf (notepane *application-frame*) + (make-pane 'application-pane + :text-style '(:sans-serif :roman :small) + :display-function 'display-note + :initial-cursor-visibility nil + ))) + (thermometer + (setf (thermopane *application-frame*) + (make-pane 'application-pane + :min-width 250 :width 250 + :display-function 'display-thermometer + :initial-cursor-visibility nil + :record-p nil ;performance hack + :foreground +blue+ + ))) + (cancel + (setf (cancel-button *application-frame*) + (make-pane 'push-button + :label "Cancel" + :align-x :center + :align-y :center + :show-as-default (cancellable *application-frame*) + :active (cancellable *application-frame*) + :activate-callback + #'(lambda (button) + (let ((frame (pane-frame button)) + (process nil)) + (when (and frame (cancellable frame)) + (setq process (work-process frame)) + (if process + (mp:process-interrupt process 'abort) + (beep))))))))) + (:menu-bar nil) + (:layouts (main + (spacing (:thickness 10) + (vertically () + display + (25 (horizontally () + (vertically () + (15 (outlining () thermometer)) + :fill) + :fill + cancel))))))) + +(defmethod modal-frame-p ((frame nt-working-dialog)) t) + +(defmethod display-note ((frame nt-working-dialog) stream) + "The pane display function for the DISPLAY pane." + (window-clear stream) + (stream-set-cursor-position stream 0 40) + (write-string (work-note frame) stream) + (force-output stream)) + +(defmethod display-thermometer ((frame nt-working-dialog) stream) + (let ((fraction (fraction frame))) + (with-bounding-rectangle* (left top right bottom) (sheet-region stream) + (medium-draw-rectangle* stream left top + (+ left (* (- right left) fraction)) bottom + t)))) + +(defvar *working-dialog* nil) + +(defmethod clim-internals::frame-manager-invoke-with-noting-progress + ((framem acl-frame-manager) + note + continuation) + (if *working-dialog* + (let ((old-string (work-note *working-dialog*)) + (old-value (fraction *working-dialog*))) + (unwind-protect + (progn + (clim-internals::frame-manager-display-progress-note + framem note) + (funcall continuation note)) + (setf (work-note *working-dialog*) old-string) + (setf (fraction *working-dialog*) old-value) + (redisplay-frame-panes *working-dialog*))) + (let ((frame nil) + (parent-frame *application-frame*) + (*working-dialog* nil) + (worker (current-process)) + (waiter nil)) + (unwind-protect + (progn + (setq waiter + (mp:process-run-function + "Progress Note" + #'(lambda () + (let ((*application-frame* parent-frame)) ; for application-modal + (setq frame (make-application-frame + 'nt-working-dialog + :cancellable t + :note (string (progress-note-name note)) + :pretty-name "" + :left 200 :top 200 + :width 400 + :height 125)) + (setf (work-process frame) worker) + (run-frame-top-level frame))))) + (mp:process-wait + "Synchronize" + #'(lambda () + (and frame + (eq (frame-state frame) :enabled)))) + (setq *working-dialog* frame) + (clim-internals::frame-manager-invoke-with-noting-progress + framem note continuation)) + (when waiter + (mp:process-kill waiter) + (setq *working-dialog* nil)))))) + +(defmethod clim-internals::frame-manager-display-progress-note + ((framem acl-frame-manager) note) + (when *working-dialog* + (let ((old (fraction *working-dialog*)) + (new (/ (float (slot-value note 'clim-internals::numerator)) + (float (slot-value note 'clim-internals::denominator))))) + (unless (= old new) + (setf (fraction *working-dialog*) new) + (display-thermometer *working-dialog* (thermopane *working-dialog*)))) + (let ((old (work-note *working-dialog*)) + (new (string (progress-note-name note)))) + (unless (string= old new) + (setf (work-note *working-dialog*) new) + (display-note *working-dialog* (notepane *working-dialog*)))))) + +(defun wait-demo (&key (time 10.0) (N 100)) + (let ((*application-frame* (car (frame-manager-frames + (find-frame-manager)))) + (note (format nil "Men at work. ~%Please wait.")) + (wtime (/ time N))) + (with-simple-restart (abort "Abort Wait Demo") + (clim-internals::frame-manager-invoke-with-noting-progress + (find-frame-manager) + (clim-internals::add-progress-note note t) + #'(lambda (note) + (let ((*current-progress-note* note)) + (dotimes (i N) + (sleep wtime) + (note-progress i N)))))))) + ;;; ms-windows style command menu support (define-command-table mswin-file-commands @@ -1067,55 +1244,36 @@ to be run from another." (with-slots (mirrored-sheet) event (dispatch-event mirrored-sheet event))) +(defparameter *mswin-pane-classes* + '((scroll-bar mswin-scroll-bar) + (scroller-pane silica::mswin-scroller-pane) + (viewport viewport) + (menu-bar mswin-menu-bar-pane) + (menu-bar-button-logic mswin-menu-bar-button) + (pull-down-button-logic mswin-pull-down-menu-button) + (push-button hpbutton-pane) + (toggle-button hbutton-pane) + (radio-box radio-box-pane) + (check-box check-box-pane) + (slider slider-pane) + (top-level-sheet acl-clim::acl-top-level-sheet) + (frame-pane frame-pane) + (label-pane generic-label-pane) + (text-field mswin-text-field) + ;;mm: interpose a pane class to manipulate initargs + (text-editor acl-clim::acl-text-editor-pane) + (list-pane hlist-pane) + (option-pane mswin-combo-box-pane) + (outlined-pane acl-clim::mswin-outlined-pane) + ;;--- Need to do these + (horizontal-divider-pane) + (vertical-divider-pane) + )) + (defmethod make-pane-class ((framem acl-clim::acl-frame-manager) class &rest options) (declare (ignore options)) - (if acl-clim::*generic-gadgets* - (second (assoc class '((scroll-bar scroll-bar-pane) - (scroller-pane generic-scroller-pane) - (viewport viewport) - (menu-bar menu-bar-pane) - (menu-bar-button-logic menu-bar-button) - (pull-down-button-logic pull-down-menu-button) - (push-button push-button-pane) - (toggle-button toggle-button-pane) - (radio-box radio-box-pane) - (check-box check-box-pane) - (slider slider-pane) - (top-level-sheet top-level-sheet) - (frame-pane frame-pane) - (label-pane generic-label-pane) - (text-field text-field-pane) - (text-editor text-editor-pane) - (list-pane generic-list-pane) - (option-pane generic-option-pane) - ;;--- Need to do these - (horizontal-divider-pane) - (vertical-divider-pane) - ))) - (second (assoc class '((scroll-bar mswin-scroll-bar) - (scroller-pane silica::mswin-scroller-pane) - (viewport viewport) - (menu-bar mswin-menu-bar-pane) - (menu-bar-button-logic mswin-menu-bar-button) - (pull-down-button-logic mswin-pull-down-menu-button) - (push-button hpbutton-pane) - (toggle-button hbutton-pane) - (radio-box radio-box-pane) - (check-box check-box-pane) - (slider slider-pane) - (top-level-sheet acl-clim::acl-top-level-sheet) - (frame-pane frame-pane) - (label-pane generic-label-pane) - (text-field mswin-text-field) - ;;mm: interpose a pane class to manipulate initargs - (text-editor acl-clim::acl-text-editor-pane) - (list-pane hlist-pane) - (option-pane mswin-combo-box-pane) - ;;--- Need to do these - (horizontal-divider-pane) - (vertical-divider-pane) - ))))) + (second (assoc class *mswin-pane-classes*))) ;; modulor the frame-background/foreground hacks this is identical to ;; the default method for standard-frame-manager in silica/framem - @@ -1153,7 +1311,7 @@ to be run from another." (logior win:swp_noactivate win:swp_nozorder win:swp_nosize)) - (error "SetWindowPos: system error ~s" (win:getlasterror))))) + (acl-clim::check-last-error "SetWindowPos")))) (in-package :clim-internals) @@ -1219,12 +1377,11 @@ in a second Lisp process. This frame cannot be reused." ;;; when the user resizes the frame window #+ignore (win::showWindow handle win::sw_show) (or (win:getClientRect handle wrect) - (error "GetClientRect: system error ~s" (win:getlasterror))) + (acl-clim::check-last-error "GetClientRect")) (or (win:InvalidateRect handle wrect 1) - (error "InvalidateRect: system error ~s" (win:getlasterror))) + (acl-clim::check-last-error "InvalidateRect")) (or (win:UpdateWindow handle) - (error "UpdateWindow: system error ~s" (win:getlasterror))) - )))) + (acl-clim::check-last-error "UpdateWindow")))))) (defun clean-frame (frame) (declare (ignore frame)) @@ -1248,4 +1405,5 @@ in a second Lisp process. This frame cannot be reused." x y 0 0 (logior win:swp_noactivate win:swp_nozorder - win:swp_nosize))) \ No newline at end of file + win:swp_nosize))) + diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp index 267c3c11ba42aef86fee863c3924249065c4fd6e..449b3c5eb5ab7dede826c7969ff78830571771c2 100644 --- a/aclpc/acl-medium.lisp +++ b/aclpc/acl-medium.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-medium.lisp,v 1.8 1998/08/06 23:15:44 layer Exp $ #|**************************************************************************** * * @@ -16,46 +34,43 @@ (defclass acl-medium (basic-medium) ((background-dc-image) - (foreground-dc-image))) + (foreground-dc-image) + ;; DC is cached value of GetDC(). This is safe as long + ;; as we use CS_OWNDC. + (dc :initform nil :accessor medium-dc) + )) (defmethod engraft-medium :after ((medium acl-medium) port sheet) (declare (ignore port sheet)) ;; In another engraft-medium method, the medium background/foreground ;; is initialized from the pane background/foreground. (with-slots (background-dc-image foreground-dc-image) medium - (setf background-dc-image (dc-image-for-ink medium (medium-background medium))) - (setf foreground-dc-image (dc-image-for-ink medium (medium-foreground medium))))) - -(defmethod medium-background ((medium t)) - +white+) - -(defmethod medium-foreground ((medium t)) - +black+) + (let ((bink + (dc-image-for-ink medium (medium-background medium))) + (fink + (dc-image-for-ink medium (medium-foreground medium)))) + (setf background-dc-image bink) + (setf foreground-dc-image fink)))) (defmethod (setf medium-background) :after (new-background (medium acl-medium)) (with-slots (background-dc-image) medium - (setf background-dc-image (dc-image-for-ink medium new-background)))) + (let ((bink (dc-image-for-ink medium new-background))) + (setf background-dc-image bink)))) (defmethod (setf medium-foreground) :after (new-foreground (medium acl-medium)) (with-slots (foreground-dc-image) medium - (setf foreground-dc-image (dc-image-for-ink medium new-foreground)))) + (let ((fink (dc-image-for-ink medium new-foreground))) + (setf foreground-dc-image fink)))) (defclass acl-window-medium (acl-medium) ((window :initform nil :reader medium-drawable))) (defmethod make-medium ((port acl-port) sheet) - (make-instance 'acl-window-medium - :port port - :sheet sheet)) - -#| ;;; method for basic port is sufficient -(defmethod allocate-medium ((port acl-port) sheet) - (let ((medium (or (pop (silica::port-medium-cache port)) - (make-medium port sheet)))) - (with-slots (window) medium - (setf window (sheet-mirror sheet))) - medium)) -|# + (let ((m (make-instance 'acl-window-medium + :port port + :sheet sheet))) + (setf (medium-background m) silica:*default-pane-background*) + m)) (defmethod deallocate-medium ((port acl-port) medium) (setf (medium-sheet medium) nil) @@ -93,19 +108,17 @@ (with-bounding-rectangle* (mleft mtop mright mbottom) medium-region (multiple-value-setq (valid cleft ctop cright cbottom) (multiple-value-call #'ltrb-overlaps-ltrb-p - cleft ctop cright cbottom - (transform-rectangle* - (sheet-device-transformation sheet) - mleft mtop mright mbottom)))))) + cleft ctop cright cbottom + (transform-rectangle* + (sheet-device-transformation sheet) + mleft mtop mright mbottom)))))) (when valid (fix-coordinates cleft ctop cright cbottom) - (setq winrgn (win::createRectRgn cleft ctop cright cbottom)) - (win::selectObject dc winrgn) - (setf *created-region* winrgn)) - valid)) + (setq winrgn (createRectRgn cleft ctop cright cbottom)) + (setf *created-region* winrgn) + (selectobject dc winrgn)))) -(defmethod dc-image-for-ink (medium (ink (eql +ltgray+))) - (declare (ignore medium)) +(defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +ltgray+))) ;; This is not supposed to be just ANY light gray. ;; This one is supposed to match exactly the color ;; used by Windows for all the other gadgets, such as @@ -113,26 +126,28 @@ ;; gray in the current color scheme" *ltgray-image*) -(defmethod dc-image-for-ink (medium (ink (eql +foreground-ink+))) - (slot-value medium 'foreground-dc-image)) +(defmethod color-rgb ((color (eql +ltgray+))) + (color-rgb (wincolor->color (win:getSysColor win:COLOR_BTNFACE)))) -(defmethod dc-image-for-ink (medium (ink (eql +background-ink+))) - (slot-value medium 'background-dc-image)) +(defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +foreground-ink+))) + (dc-image-for-ink medium (medium-foreground medium))) -(defmethod dc-image-for-ink (medium (ink (eql +black+))) - (declare (ignore medium)) - *black-image*) - -(defmethod dc-image-for-ink (medium (ink (eql +white+))) - (declare (ignore medium)) - *white-image*) +(defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +background-ink+))) + (dc-image-for-ink medium (medium-background medium))) ;; changing the conversion as follows makes CLIM gray colors 1/4, 1/2 ;; and 3/4 gray colors map to the corresponding windows solid system ;; colors avoiding need for windows to stipple. (cim 10/11/96) -(defun color->wincolor (ink) +(defun color->wincolor (ink &optional medium) (declare (optimize (speed 3) (safety 0))) + (cond ((eq ink +background-ink+) + (setq ink (medium-background medium))) + ((eq ink +foreground-ink+) + (setq ink (medium-foreground medium))) + ((eq ink +transparent-ink+) + (return-from color->wincolor -1) + )) (flet ((convert (x) (declare (short-float x)) (setq x (float x)) ; needed? @@ -147,108 +162,101 @@ color)))) (defun wincolor->color (color) - (flet ((convert (x) - (if (eql x #xff) - 1.0 - (float (/ x 256))))) - (let ((red (ldb (byte 8 0) color)) - (green (ldb (byte 8 8) color)) - (blue (ldb (byte 8 16) color))) - (make-rgb-color (convert red) - (convert green) - (convert blue))))) - - - - -(defmethod dc-image-for-ink (medium (ink color)) - (declare (ignore medium)) - (let ((color (color->wincolor ink))) - (declare (fixnum color)) - (case color - ((#x000000) *black-image*) - ((#xffffff) *white-image*) - (otherwise - (let ((pen (note-created 'pen (win::createPen win::ps_solid 1 color))) - (brush (note-created 'brush (win::createSolidBrush color)))) - (when *created-pen* - ;(note-destroyed *created-pen*) - ;(win::selectObject dc *white-pen*) - ;(win::deleteObject dc *created-pen*) - (push *created-pen* *extra-objects*)) - (setf *created-pen* pen *created-brush* brush) - (make-dc-image :solid-1-pen pen - :brush brush - :text-color color :background-color nil)))))) + (if (= color -1) + +transparent-ink+ + (flet ((convert (x) + (if (eql x #xff) + 1.0 + (float (/ x 256))))) + (let ((red (ldb (byte 8 0) color)) + (green (ldb (byte 8 8) color)) + (blue (ldb (byte 8 16) color))) + (make-rgb-color (convert red) + (convert green) + (convert blue)))))) + +(defmethod dc-image-for-ink ((medium acl-medium) (ink color)) + (let ((cache (port-dc-cache (port medium)))) + (or (gethash ink cache) + (setf (gethash ink cache) + (let ((color (color->wincolor ink medium))) + (declare (fixnum color)) + (let ((pen (win:createPen win:ps_solid 1 color)) + (brush (win:createSolidBrush color))) + (make-dc-image :solid-1-pen pen + :brush brush + :text-color color + :background-color nil + :rop2 win:r2_copypen + ))))))) ;;; ink for opacities, regions, etc -(defmethod dc-image-for-ink (medium (ink (eql +transparent-ink+))) - (declare (ignore medium)) +;;; +transparent-ink+ is also known as +nowhere+. +(defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +transparent-ink+))) *blank-image*) -(defmethod dc-image-for-ink (medium (ink (eql +everywhere+))) +(defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +everywhere+))) (dc-image-for-ink medium +foreground-ink+)) -(defmethod dc-image-for-ink (medium (ink standard-opacity)) - #+ignore (declare (ignore medium)) +(defmethod dc-image-for-ink ((medium acl-medium) (ink standard-opacity)) #+ignore (cerror "Return Opacity 0" "Can't handle Opacities other than 0 and 1") (if (>= (opacity-value ink) 0.5) (dc-image-for-ink medium +foreground-ink+) *blank-image*)) -(defmethod dc-image-for-ink (medium (ink region)) - #+ignore (declare (ignore medium)) +(defmethod dc-image-for-ink ((medium acl-medium) (ink region)) (dc-image-for-ink medium +foreground-ink+)) - ;;; ink for patterns, tiles, etc (defconstant bmdim 32) - -(defvar *bitmap-array* nil) ;;; probably not needed - -;;; new just for now, later rationalize passing dc -(defvar *the-dc* nil) +(defvar *bitmap-array* nil) ; probably not needed +(defvar *the-dc* nil) ; new just for now, later + ; rationalize passing dc ;;; just for now, later rationalize passing dc (defun dc-image-for-multi-color-pattern (medium array designs) (let* ((dc-image (copy-dc-image - (slot-value medium 'foreground-dc-image))) - (nocolor (and (eq (aref designs 0) +background-ink+) - (eq (aref designs 1) +foreground-ink+))) - (tcolor (unless nocolor - (color->wincolor (aref designs 1)))) - (bcolor (unless nocolor - (color->wincolor (aref designs 0)))) + (slot-value medium 'foreground-dc-image))) + (tink (aref designs 1)) + (bink (aref designs 0)) + (tcolor (color->wincolor tink medium)) + (bcolor (color->wincolor bink medium)) (width (array-dimension array 1)) (height (array-dimension array 0)) - (into (make-pixel-map width height 256)) - color - ) - (dotimes (i (length designs)) - (setf color (aref (the vector designs) i)) - #+ignore (format *terminal-io* "~%~S" color) - (cond - ((eql color clim:+foreground-ink+) - (setf (aref (the vector designs) i) (medium-foreground medium))) - ((eql color clim:+background-ink+) - (setf (aref (the vector designs) i) (medium-background medium))))) + (into (make-pixel-map width height 256))) (dotimes (i height) (dotimes (j width) (setf (aref into i j) (aref array i j)))) (setf *bitmap-array* into) - (let ((bitmap (get-texture *the-dc* into designs))) + (let ((bitmap (get-texture *the-dc* into designs medium))) (setf (dc-image-bitmap dc-image) bitmap *created-bitmap* bitmap) - (setf (dc-image-background-color dc-image) - (if nocolor - (dc-image-text-color - (slot-value medium 'background-dc-image)) - bcolor)) - (if tcolor (setf (dc-image-text-color dc-image) tcolor)) - ) + (setf (dc-image-background-color dc-image) bcolor) + (setf (dc-image-text-color dc-image) tcolor)) + dc-image)) + +(defun dc-image-for-two-color-pattern (medium array designs) + (let* ((dc-image (copy-dc-image + (slot-value medium 'foreground-dc-image))) + (tink (aref designs 1)) + (bink (aref designs 0)) + (tcolor (color->wincolor tink medium)) + (bcolor (color->wincolor bink medium)) + (width (array-dimension array 1)) + (height (array-dimension array 0)) + (into (make-pixel-map width height 256))) + (dotimes (i height) + (dotimes (j width) + (setf (aref into i j) (aref array i j)))) + (setf *bitmap-array* into) + (let ((bitmap (get-texture *the-dc* into designs medium))) + (setf (dc-image-bitmap dc-image) bitmap + *created-bitmap* bitmap) + (setf (dc-image-background-color dc-image) bcolor) + (setf (dc-image-text-color dc-image) tcolor)) dc-image)) (defun byte-align-pixmap (a) @@ -282,120 +290,101 @@ (if (>= col y-dim) 0 (if (zerop (aref a row col)) 0 1))))) b)) -(defmethod dc-image-for-ink (medium (ink pattern)) +(defmethod dc-image-for-ink ((medium acl-medium) (ink pattern)) (multiple-value-bind (array designs) (decode-pattern ink) - ;; Not two colors. - (unless (= (length designs) 2) - (setq array (byte-align-pixmap array)) - (return-from dc-image-for-ink - (dc-image-for-multi-color-pattern - medium array designs))) - ;; Two colors. - ;; This seems to ignore the colors, using black and white. - ;; The byte alignment seems to be off as well. JPM 5/98. - (let* ((dc-image (copy-dc-image - (slot-value medium 'foreground-dc-image))) - (bink (aref designs 0)) - (tink (aref designs 1)) - (tcolor (color->wincolor tink)) - (bcolor (color->wincolor bink)) - (width (array-dimension array 1)) - (height (array-dimension array 0)) - (into (byte-align-bits array))) - (setf *bitmap-array* into) - (let ((bitmap - (note-created 'bitmap (win:createBitmap width height 1 1 into)))) - (setf (dc-image-bitmap dc-image) bitmap - *created-bitmap* bitmap) - (setf (dc-image-background-color dc-image) bcolor) - (setf (dc-image-text-color dc-image) tcolor)) - dc-image))) - -(defmethod dc-image-for-ink (medium (ink rectangular-tile)) + (cond ((= (length designs) 2) + (setq array (byte-align-pixmap array)) + (dc-image-for-two-color-pattern + medium array designs)) + ((find +transparent-ink+ designs) + (error + "Multicolor patterns must not use +transparent-ink+")) + (t + (setq array (byte-align-pixmap array)) + (dc-image-for-multi-color-pattern + medium array designs))))) + +(defmethod dc-image-for-ink ((medium acl-medium) (ink rectangular-tile)) ;; The only case we handle right now is stipples - (multiple-value-bind (array width height) - (decode-tile-as-stipple ink) - (unless array - (error "Rectangular tiles other than stipples are not supported yet.")) - ;; I don't know why width and height are wrong, but they are. JPM 8/25/97 - (setq width (array-dimension array 1)) - (setq height (array-dimension array 0)) - (let* ((into (make-array `(,bmdim ,bmdim) :element-type 'bit - :initial-element 0)) - (pattern (decode-rectangular-tile ink)) - (designs (pattern-designs pattern)) - dc-image background-dc foreground-dc) + (let ((pattern (decode-rectangular-tile ink))) + (multiple-value-bind (array designs) + (decode-pattern pattern) + (unless array + (error + "Rectangular tiles other than stipples are not supported yet.")) (unless (= (length designs) 2) - (error "Only 2-color stipples are currently supported.")) - (setq background-dc (dc-image-for-ink medium (svref designs 0))) - (setq foreground-dc (dc-image-for-ink medium (svref designs 1))) - (setq dc-image (copy-dc-image foreground-dc)) - (dotimes (i bmdim) - (dotimes (j bmdim) - (setf (aref into i j) - (logand 1 (lognot (aref array (mod i height) - (mod j width))))))) - (let* ((bitmap (note-created 'bitmap (win::createBitmap bmdim bmdim 1 1 - into))) - (brush (note-created 'brush (win::createPatternBrush bitmap)))) - (setf (dc-image-brush dc-image) brush) - (setf *created-brush* brush) - (setf *created-tile* bitmap) - ;; Setting ROP2 helps when +transparent-ink+ is the background ink. - (setf (dc-image-rop2 dc-image) (dc-image-rop2 background-dc)) - (setf (dc-image-background-color dc-image) - (dc-image-text-color background-dc)) - (setf (dc-image-text-color dc-image) - (dc-image-text-color foreground-dc)) - dc-image)))) - -(defmethod dc-image-for-ink (medium (ink flipping-ink)) - (multiple-value-bind (ink1 ink2) - (decode-flipping-ink ink) - (let* ((image1 (dc-image-for-ink medium ink1)) - (image2 (dc-image-for-ink medium ink2)) - (color (logxor (dc-image-text-color image1) - (dc-image-text-color image2)))) - (unless (and (eql (dc-image-rop2 image1) win::r2_copypen) - (eql (dc-image-rop2 image2) win::r2_copypen) - (null (dc-image-bitmap image1)) - (null (dc-image-bitmap image2))) - (nyi)) - (let ((pen (note-created 'pen (win::createPen win::ps_solid 1 color))) - (brush (note-created 'brush (win::createSolidBrush color)))) - (when *created-pen* - ;(note-destroyed *created-pen*) - ;(win::selectObject dc *white-pen*) - ;(win::deleteObject dc *created-pen*) - (push *created-pen* *extra-objects*)) - (setf *created-pen* pen *created-brush* brush) - (make-dc-image :solid-1-pen pen - :brush brush - :rop2 win::r2_xorpen - :text-color color :background-color nil))))) - -(defmethod dc-image-for-ink (medium (ink contrasting-ink)) + (error "Only 2-color stipples are currently supported.")) + (setq array (byte-align-pixmap array)) + #+old + (dc-image-for-ink medium (aref designs 1)) + (let ((dc-image + (dc-image-for-two-color-pattern medium array designs))) + (setf (dc-image-brush dc-image) + (win:createPatternBrush (dc-image-bitmap dc-image))) + dc-image)))) + +(defun nyi () + (error "This NT CLIM operation is NYI (Not Yet Implemented).")) + +(defmethod dc-image-for-ink ((medium acl-medium) (ink flipping-ink)) + (let ((cache (port-dc-cache (port medium)))) + (or (gethash ink cache) + (setf (gethash ink cache) + (multiple-value-bind (ink1 ink2) + (decode-flipping-ink ink) + (let* ((image1 (dc-image-for-ink medium ink1)) + (image2 (dc-image-for-ink medium ink2)) + (color (logxor (dc-image-text-color image1) + (dc-image-text-color image2)))) + (unless (and (eql (dc-image-rop2 image1) win:r2_copypen) + (eql (dc-image-rop2 image2) win:r2_copypen) + (null (dc-image-bitmap image1)) + (null (dc-image-bitmap image2))) + (nyi)) + (let ((pen (win:createPen win:ps_solid 1 color)) + (brush (win:createSolidBrush color))) + (make-dc-image :solid-1-pen pen + :brush brush + :rop2 win:r2_xorpen + ;; I don't know why but text drawn + ;; in this ink is invisible if you + ;; use COLOR as the text color. JPM 7/98. + :text-color 0 ;color + :background-color nil)))))))) + +(defmethod dc-image-for-ink ((medium acl-medium) (ink contrasting-ink)) (dc-image-for-ink medium (make-color-for-contrasting-ink ink))) +(defmethod dc-image-for-ink ((medium acl-medium) (ink composite-out)) + (error "Compositing is not supported.")) + +(defmethod dc-image-for-ink ((medium acl-medium) (ink composite-in)) + (error "Compositing is not supported.")) + (defmethod medium-draw-point* ((medium acl-medium) x y) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) (line-style (medium-line-style medium))) (convert-to-device-coordinates transform x y) (set-dc-for-ink dc medium ink line-style) - ;(win::rectangle dc x y (+ x 1) (+ y 1)) pity it doesn't work - (win::moveToEx dc x y null) - (win::lineTo dc (+ x 1) (+ y 1)) + ;;(win:rectangle dc x y (+ x 1) (+ y 1)) pity it doesn't work + (win:moveToEx dc x y null) + (win:lineTo dc (+ x 1) (+ y 1)) + (selectobject dc old) ))))) (defmethod medium-draw-points* ((medium acl-medium) position-seq) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) @@ -407,27 +396,33 @@ (let ((x (elt position-seq i)) (y (elt position-seq j))) (convert-to-device-coordinates transform x y) - ;(win::rectangle dc x y x y) - (win::moveToEx dc x y null) - (win::lineTo dc (+ x 1) (+ y 1))))))))) + ;(win:rectangle dc x y x y) + (win:moveToEx dc x y null) + (win:lineTo dc (+ x 1) (+ y 1)))) + (selectobject dc old)))))) (defmethod medium-draw-line* ((medium acl-medium) x1 y1 x2 y2) - (let ((window (medium-drawable medium))) + (let ((window (medium-drawable medium)) + (old nil)) (with-dc (window dc) - (when (select-acl-dc medium window dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) (line-style (medium-line-style medium))) (convert-to-device-coordinates transform x1 y1 x2 y2) (set-dc-for-ink dc medium ink line-style) - (win::moveToEx dc x1 y1 null) - (win::lineTo dc x2 y2)))))) + (win:moveToEx dc x1 y1 null) + (win:lineTo dc x2 y2) + (selectobject dc old)))))) (defmethod medium-draw-lines* ((medium acl-medium) position-seq) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) @@ -443,14 +438,17 @@ (x2 (elt position-seq k)) (y2 (elt position-seq l))) (convert-to-device-coordinates transform x1 y1 x2 y2) - (win::moveToEx dc x1 y1 null) - (win::lineTo dc x2 y2)))))))) + (win:moveToEx dc x1 y1 null) + (win:lineTo dc x2 y2))) + (selectobject dc old)))))) (defmethod medium-draw-rectangle* ((medium acl-medium) left top right bottom filled) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) @@ -459,31 +457,32 @@ left top right bottom) (when (< right left) (rotatef right left)) (when (< bottom top) (rotatef bottom top)) - (if (typep ink 'pattern) - (with-compatible-dc (dc cdc) - (let ((width (- right left)) - (height (- bottom top)) - (*the-dc* dc) - pat) - (set-dc-for-ink dc medium +foreground-ink+ nil) ; avoid pattern - (setf pat (set-cdc-for-pattern cdc medium ink nil)) - (win::bitblt dc left top width height - cdc 0 0 pat) ; cause 0 is foreground - )) - (progn - (let ((*the-dc* dc)) - (set-dc-for-ink dc medium ink line-style)) - #+ignore - (if (typep ink 'rectangular-tile) - (cerror "Go" "Stop ~S" ink)) - (if filled - (win::rectangle dc left top (1+ right) (1+ bottom)) - (win::rectangle dc left top right bottom))))))))) + (cond ((typep ink 'pattern) + ;; DRAW-PATTERN* ultimately does its drawing here. + ;; BUG: Transparent bits aren't transparent. + (with-compatible-dc (dc cdc) + (let ((width (- right left)) + (height (- bottom top)) + (*the-dc* dc)) + (set-cdc-for-pattern cdc medium ink nil) + (win:bitblt dc left top width height + cdc 0 0 win:srccopy)))) + (t + ;; dc=0 for acl-pixmap-medium...FIXME. + (let ((*the-dc* dc)) + (set-dc-for-ink dc medium ink + (if filled nil line-style))) + (if filled + (win:rectangle dc left top (1+ right) (1+ bottom)) + (win:rectangle dc left top right bottom)))) + (selectobject dc old)))))) (defmethod medium-draw-rectangles* ((medium acl-medium) position-seq filled) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) @@ -496,19 +495,22 @@ (top (elt position-seq (incf rect))) (right (elt position-seq (incf rect))) (bottom (elt position-seq (incf rect)))) - (convert-to-device-coordinates transform - left top right bottom) - (when (< right left) (rotatef right left)) - (when (< bottom top) (rotatef bottom top)) - (if filled - (win::rectangle dc left top (1+ right) (1+ bottom)) - (win::rectangle dc left top right bottom))))))))) + (convert-to-device-coordinates transform + left top right bottom) + (when (< right left) (rotatef right left)) + (when (< bottom top) (rotatef bottom top)) + (if filled + (win:rectangle dc left top (1+ right) (1+ bottom)) + (win:rectangle dc left top right bottom)))) + (selectobject dc old)))))) (defmethod medium-draw-polygon* ((medium acl-medium) position-seq closed filled) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) @@ -516,53 +518,44 @@ (length (length position-seq)) (numpoints (floor length 2)) (extra (and closed line-style)) - #-acl86win32 (point-vector (ct::ccallocate (win::point 256))) - #+acl86win32 (point-vector (ct::callocate (:long *) :size 512))) ; limit? + #-acl86win32 (point-vector (ct:ccallocate (win:point 256))) + #+acl86win32 (point-vector (ct:callocate (:long *) :size 512))) ; limit? ;; These really are fixnums, since we're fixing coordinates below - ; (declare (type fixnum minx miny)) + ;; (declare (type fixnum minx miny)) (with-stack-array (points (if extra (+ length 2) length)) (declare (type simple-vector points)) - (replace points position-seq) ;set up the initial contents + (replace points position-seq) ;set up the initial contents (do ((i 0 (+ i 2)) (j 0 (+ j 1))) ((>= i length)) (let ((x (svref points i)) - (y (svref points (1+ i))) - #-acl86win32 (pstruct (ct::callocate win::point))) + (y (svref points (1+ i)))) (convert-to-device-coordinates transform x y) - #-acl86win32 (ct::csets win::point pstruct win::x x win::y y) - #-acl86win32 (ct::cset (win::point 256) - point-vector ((fixnum j)) pstruct) - #+acl86win32 - (ct::cset (:long 512) point-vector ((fixnum (* j 2))) x) - #+acl86win32 - (ct::cset (:long 512) point-vector ((fixnum (+ 1 (* j 2)))) y) + (ct:cset (:long 512) point-vector ((fixnum (* j 2))) x) + (ct:cset (:long 512) point-vector ((fixnum (+ 1 (* j 2)))) y) (when (and (= j 0) extra) - #-acl86win32 (ct::cset (win::point 256) - point-vector ((fixnum numpoints)) pstruct) - #+acl86win32 - (ct::cset (:long 512) point-vector ((fixnum (* numpoints 2))) x) - #+acl86win32 - (ct::cset (:long 512) point-vector ((fixnum (+ 1 (* numpoints 2)))) y) - )))) + (ct:cset (:long 512) point-vector ((fixnum (* numpoints 2))) x) + (ct:cset (:long 512) point-vector ((fixnum (+ 1 (* numpoints 2)))) y) + )))) (if (or (typep ink 'pattern) (typep ink 'rectangular-tile)) - (if (null line-style) - (let ((*the-dc* dc) - (nink ink - #+ignore - (if (typep ink 'pattern) - (make-rectangular-tile ink 8 8) - ink))) - (set-dc-for-ink dc medium nink line-style)) - (set-dc-for-ink dc medium +foreground-ink+ line-style)) + (if (null line-style) + (let ((*the-dc* dc) + (nink ink + #+ignore + (if (typep ink 'pattern) + (make-rectangular-tile ink 8 8) + ink))) + (set-dc-for-ink dc medium nink line-style)) + (set-dc-for-ink dc medium +foreground-ink+ line-style)) (set-dc-for-ink dc medium ink line-style)) (if (null line-style) - (win::polygon dc point-vector numpoints) - (win::polyline dc + (win:polygon dc point-vector numpoints) + (win:polyline dc point-vector (if (and closed line-style) - (+ numpoints 1) - numpoints)))))))) + (+ numpoints 1) + numpoints))) + (selectobject dc old)))))) (defconstant *ft* 0.0001) (defun-inline fl-= (x y) (< (abs (- x y)) *ft*)) @@ -571,44 +564,46 @@ center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy start-angle end-angle filled) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old (let* ((sheet (medium-sheet medium)) (transform (sheet-device-transformation sheet)) (ink (medium-ink medium)) (line-style (and (not filled) (medium-line-style medium)))) (convert-to-device-coordinates transform center-x center-y) (convert-to-device-distances - transform radius-1-dx radius-1-dy radius-2-dx radius-2-dy) + transform radius-1-dx radius-1-dy radius-2-dx radius-2-dy) (when (null start-angle) (setq start-angle 0.0 end-angle 2pi)) (if (or (typep ink 'pattern) (typep ink 'rectangular-tile)) - (if (null line-style) - (let ((*the-dc* dc) - (nink ink - #+ignore - (if (typep ink 'pattern) - (make-rectangular-tile ink 8 8) - ink))) - (set-dc-for-ink dc medium nink line-style)) - (set-dc-for-ink dc medium +foreground-ink+ line-style)) + (if (null line-style) + (let ((*the-dc* dc) + (nink ink + #+ignore + (if (typep ink 'pattern) + (make-rectangular-tile ink 8 8) + ink))) + (set-dc-for-ink dc medium nink line-style)) + (set-dc-for-ink dc medium +foreground-ink+ line-style)) (set-dc-for-ink dc medium ink line-style)) (multiple-value-bind (x-radius y-radius) - (cond ((and (= radius-1-dx 0) (= radius-2-dy 0)) - (values (abs radius-2-dx) (abs radius-1-dy))) - ((and (= radius-2-dx 0) (= radius-1-dy 0)) - (values (abs radius-1-dx) (abs radius-2-dy))) - (t - (let ((s-1 (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy))) - (s-2 (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy)))) - (if (= s-1 s-2) - (let ((r (truncate (sqrt s-1)))) - (values r r)) - ;; Degrade to drawing a rectilinear ellipse - (values (truncate (sqrt s-1)) - (truncate (sqrt s-2))))))) + (cond ((and (= radius-1-dx 0) (= radius-2-dy 0)) + (values (abs radius-2-dx) (abs radius-1-dy))) + ((and (= radius-2-dx 0) (= radius-1-dy 0)) + (values (abs radius-1-dx) (abs radius-2-dy))) + (t + (let ((s-1 (+ (* radius-1-dx radius-1-dx) (* radius-1-dy radius-1-dy))) + (s-2 (+ (* radius-2-dx radius-2-dx) (* radius-2-dy radius-2-dy)))) + (if (= s-1 s-2) + (let ((r (truncate (sqrt s-1)))) + (values r r)) + ;; Degrade to drawing a rectilinear ellipse + (values (truncate (sqrt s-1)) + (truncate (sqrt s-2))))))) (let (left top right bottom) (setq left (- center-x x-radius) right (+ center-x x-radius) @@ -620,123 +615,121 @@ (and (= start-angle 0) (= end-angle 2pi)) ;; drawing a full ellipse - (win::ellipse dc left top right bottom)) + (win:ellipse dc left top right bottom)) ((null line-style) ;; drawing a pie slice - (win::pie - dc left top right bottom - (round (1- (+ center-x (* (cos start-angle) x-radius)))) - (round (1- (- center-y (* (sin start-angle) y-radius)))) - (round (1- (+ center-x (* (cos end-angle) x-radius)))) - (round (1- (- center-y (* (sin end-angle) y-radius)))))) + (win:pie + dc left top right bottom + (round (1- (+ center-x (* (cos start-angle) x-radius)))) + (round (1- (- center-y (* (sin start-angle) y-radius)))) + (round (1- (+ center-x (* (cos end-angle) x-radius)))) + (round (1- (- center-y (* (sin end-angle) y-radius)))))) (t - ;; drawing an arc - (win::arc - dc left top right bottom - (round (1- (+ center-x (* (cos start-angle) x-radius)))) - (round (1- (- center-y (* (sin start-angle) y-radius)))) - (round (1- (+ center-x (* (cos end-angle) x-radius)))) - (round (1- (- center-y (* (sin end-angle) y-radius))))))) - ))))))) + ;; drawing an arc + (win:arc + dc left top right bottom + (round (1- (+ center-x (* (cos start-angle) x-radius)))) + (round (1- (- center-y (* (sin start-angle) y-radius)))) + (round (1- (+ center-x (* (cos end-angle) x-radius)))) + (round (1- (- center-y (* (sin end-angle) y-radius))))))) + )) + (selectobject dc old)))))) (defmethod medium-draw-string* ((medium acl-medium) string x y start end align-x align-y towards-x towards-y transform-glyphs) + ;; This is not supposed to try to draw multiline text. + ;; For that, use WRITE-STRING. (declare (ignore transform-glyphs)) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) - (let* ((sheet (medium-sheet medium)) - (transform (sheet-device-transformation sheet)) - (ink (medium-ink medium)) - (text-style (medium-merged-text-style medium))) - (convert-to-device-coordinates transform x y) - (when towards-x - (convert-to-device-coordinates transform towards-x towards-y)) - (unless end - (setq end (length string))) - (with-temporary-substring (substring string start end) - (let* ((font (text-style-mapping (port medium) text-style)) - (height (acl-font-height font)) - (descent (acl-font-descent font)) - (ascent (acl-font-ascent font))) - (let ((x-adjust - (compute-text-x-adjustment align-x medium string text-style start end)) - (y-adjust - (compute-text-y-adjustment align-y descent ascent height))) - (incf x x-adjust) - (incf y y-adjust) - (when towards-x - (incf towards-x x-adjust) - (incf towards-y y-adjust))) - (decf y ascent) ;text is positioned by its top left on acl - (set-dc-for-text dc medium ink (acl-font-index font)) - (let ((cstr (ct::callocate (:char *) :size 256)) - (subsize (length substring))) - (dotimes (i subsize) - (ct::cset (:char 256) cstr ((fixnum i)) - (char-int (char substring i)))) - (win::textOut dc x y cstr (length substring)))))))))) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old + (let* ((sheet (medium-sheet medium)) + (transform (sheet-device-transformation sheet)) + (ink (medium-ink medium)) + (text-style (medium-merged-text-style medium))) + (convert-to-device-coordinates transform x y) + (when towards-x + (convert-to-device-coordinates transform towards-x towards-y)) + (unless end + (setq end (length string))) + (with-temporary-substring (substring string start end) + (let* ((font (text-style-mapping (port medium) text-style)) + (height (acl-font-height font)) + (descent (acl-font-descent font)) + (ascent (acl-font-ascent font))) + (let ((x-adjust + (compute-text-x-adjustment align-x medium + string text-style start end)) + (y-adjust + (compute-text-y-adjustment align-y descent + ascent height))) + (incf x x-adjust) + (incf y y-adjust) + (when towards-x + (incf towards-x x-adjust) + (incf towards-y y-adjust))) + (decf y ascent) ;;text is positioned by its top left + (set-dc-for-text dc medium ink (acl-font-index font)) + (multiple-value-bind (cstr len) + (silica::xlat-newline-return substring) + (or (win:textOut dc x y cstr len) + (check-last-error "TextOut" :action :warn)) + ))) + (selectobject dc old)))))) (defmethod medium-draw-character* ((medium acl-medium) char x y align-x align-y towards-x towards-y transform-glyphs) (declare (ignore transform-glyphs)) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) - (let* ((sheet (medium-sheet medium)) - (transform (sheet-device-transformation sheet)) - (ink (medium-ink medium)) - (text-style (medium-merged-text-style medium))) - (convert-to-device-coordinates transform x y) - (when towards-x - (convert-to-device-coordinates transform towards-x towards-y)) - (let* ((font (text-style-mapping (port medium) text-style)) - (height (acl-font-height font)) - (descent (acl-font-descent font)) - (ascent (acl-font-ascent font))) - (let ((x-adjust - (compute-text-x-adjustment align-x medium char text-style)) - (y-adjust - (compute-text-y-adjustment align-y descent ascent height))) - (incf x x-adjust) - (incf y y-adjust) + (let ((window (medium-drawable medium)) + (old nil)) + (with-medium-dc (medium dc) + (setq old (select-acl-dc medium window dc)) + (when old + (let* ((sheet (medium-sheet medium)) + (transform (sheet-device-transformation sheet)) + (ink (medium-ink medium)) + (text-style (medium-merged-text-style medium))) + (convert-to-device-coordinates transform x y) (when towards-x - (incf towards-x x-adjust) - (incf towards-y y-adjust))) - (decf y ascent) ;text is positioned by its top left on acl - (set-dc-for-text dc medium ink (acl-font-index font)) - (let ((cstr (ct::callocate (:char *) :size 2))) - (ct::cset (:char 2) cstr 0 (char-int char)) - (win::textOut dc x y cstr 1)))))))) + (convert-to-device-coordinates transform towards-x towards-y)) + (let* ((font (text-style-mapping (port medium) text-style)) + (height (acl-font-height font)) + (descent (acl-font-descent font)) + (ascent (acl-font-ascent font))) + (let ((x-adjust + (compute-text-x-adjustment align-x medium char text-style)) + (y-adjust + (compute-text-y-adjustment align-y descent ascent height))) + (incf x x-adjust) + (incf y y-adjust) + (when towards-x + (incf towards-x x-adjust) + (incf towards-y y-adjust))) + (decf y ascent) ;text is positioned by its top left on acl + (set-dc-for-text dc medium ink (acl-font-index font)) + (let ((cstr (ct:callocate (:char *) :size 2))) + (ct:cset (:char 2) cstr 0 (char-int char)) + (or (win:textOut dc x y cstr 1) + (check-last-error "TextOut" :action :warn))))) + (selectobject dc old))))) (defmethod medium-draw-text* ((medium acl-medium) string-or-char x y start end align-x align-y towards-x towards-y transform-glyphs) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - dc - (if (characterp string-or-char) - (medium-draw-character* medium string-or-char x y align-x align-y - towards-x towards-y transform-glyphs) - (medium-draw-string* medium string-or-char x y start end align-x align-y - towards-x towards-y transform-glyphs))))) + (if (characterp string-or-char) + (medium-draw-character* medium string-or-char x y align-x align-y + towards-x towards-y transform-glyphs) + (medium-draw-string* medium string-or-char x y start end align-x align-y + towards-x towards-y transform-glyphs))) (defmethod medium-clear-area ((medium acl-medium) left top right bottom) - (let ((window (medium-drawable medium))) - (with-dc (window dc) - (when (select-acl-dc medium window dc) - (with-slots (background-dc-image) medium - (let* ((sheet (medium-sheet medium)) - (transform (sheet-device-transformation sheet))) - (convert-to-device-coordinates transform - left top right bottom) - (when (< right left) (rotatef right left)) - (when (< bottom top) (rotatef bottom top)) - (set-dc-for-filling dc background-dc-image) - (win::rectangle dc left top (1+ right) (1+ bottom)))))))) + (with-drawing-options (medium :ink (medium-background medium)) + (medium-draw-rectangle* medium left top right bottom t))) (defmethod text-style-width (text-style (medium acl-medium)) (let ((font (text-style-mapping (port medium) text-style))) @@ -783,7 +776,7 @@ (acl-font-maximum-character-width font)))) (defmethod medium-beep ((medium acl-medium)) - (win::messageBeep win::MB_OK)) + (win:messageBeep win:MB_OK)) (defmethod medium-force-output ((medium acl-medium)) ) @@ -1179,7 +1172,7 @@ device-independent bitmap, an icon, nor a cursor.")) (dpb byte (byte 8 offset-in-pixel) (aref data i pixel-offset))))))))))) - (values data (list +black+ +white+))))) + (values data (list +background-ink+ +foreground-ink+))))) (defun read-xpm-file (fstream palette) (multiple-value-bind (width height depth left-pad format diff --git a/aclpc/acl-mirror.lisp b/aclpc/acl-mirror.lisp index 4a44e3f74ea747ff98a62def6902f52935f19615..7670d29b9f1e2a561cb68895a58f0112b7eab260 100644 --- a/aclpc/acl-mirror.lisp +++ b/aclpc/acl-mirror.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-mirror.lisp,v 1.6 1998/08/06 23:15:44 layer Exp $ #|**************************************************************************** * * @@ -52,25 +70,9 @@ (setf (sheet-direct-mirror graft) handle) (update-mirror-transformation port graft)))))) - -;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) -;;; ;;mm: 11Jan95 - this is defined later in ??? -;;; (unless (ignore-errors (find-class 'CLIM-SILICA::HBUTTON-PANE)) -;;; (defclass CLIM-SILICA::HBUTTON-PANE () ())) -;;; (unless (ignore-errors (find-class 'CLIM-SILICA::HPBUTTON-PANE)) -;;; (defclass CLIM-SILICA::HPBUTTON-PANE () ())) -;;; (unless (ignore-errors (find-class 'CLIM-SILICA::mswin-text-edit)) -;;; (defclass CLIM-SILICA::mswin-text-edit () ())) -;;; (unless (ignore-errors (find-class 'CLIM-SILICA::mswin-combo-box-pane)) -;;; (defclass CLIM-SILICA::mswin-combo-box-pane () ())) -;;; ) - (defmethod modal-frame-p ((frame t)) nil) -(defmethod modal-frame-p ((frame clim-internals::accept-values-own-window)) - t) -(defmethod modal-frame-p ((frame clim-internals::menu-frame)) - t) +(defmethod modal-frame-p ((frame clim-internals::accept-values-own-window)) t) +(defmethod modal-frame-p ((frame clim-internals::menu-frame)) t) (defmethod realize-mirror ((port acl-port) sheet) (multiple-value-bind (left top right bottom) @@ -78,7 +80,7 @@ (fix-coordinates left top right bottom) (let* ((parent (sheet-mirror sheet)) (parent2 (sheet-mirror (sheet-parent sheet))) - (nullparent (ct::null-handle win::hwnd)) + (nullparent (ct:null-handle win:hwnd)) (frame (pane-frame sheet)) (pretty-name (frame-pretty-name frame)) (save-under (and frame @@ -138,9 +140,9 @@ ;;mm: allocate gadget-id per parent (setq gadget-id (silica::allocate-gadget-id sheet)) (setf buttonstyle - (logior (if (push-button-show-as-default sheet) + (if (push-button-show-as-default sheet) win:BS_DEFPUSHBUTTON - win:BS_PUSHBUTTON)))) + win:BS_PUSHBUTTON))) ((typep sheet 'silica::mswin-text-edit) (setq control :hedit) ;;mm: allocate gadget-id per parent @@ -229,12 +231,14 @@ ((eq control :hcombo) (setq childwin t) (hcombo-open parent gadget-id - 0 0 0 0 ; resize left top width height - ; :label (slot-value sheet 'silica::label) - :items items - :value value - :name-key - (slot-value sheet 'silica::name-key))) + 0 0 0 0 ; left top width height + :items items + :value value + ;; Give vertical scroll bars in case + ;; its a long list. + :scroll-mode :vertical + :name-key + (slot-value sheet 'silica::name-key))) ((not (eql parent *screen*)) (setq childwin t) (create-child-window @@ -253,8 +257,8 @@ mirror) nullparent) pretty-name scroll - win::cw_usedefault - win::cw_usedefault + win:cw_usedefault + win:cw_usedefault width height (and (getf (frame-properties frame) :native-menu) (slot-value frame 'menu-bar)) @@ -306,9 +310,7 @@ (false 0)) (unless (gadget-active-p sheet) (win:enablewindow window false) - (let ((err (win:getlasterror))) - (when (plusp err) - (error "EnableWindow: system error ~S" err)))) + (check-last-error "EnableWindow" :action :warn)) window)) (defmethod destroy-mirror ((port acl-port) sheet) @@ -321,7 +323,7 @@ ;; among other times. (let ((mirror (sheet-direct-mirror sheet))) (when mirror - (win::destroyWindow mirror)))) + (win:destroyWindow mirror)))) (defmethod note-sheet-tree-grafted ((port acl-port) (sheet top-level-sheet)) ;; This method is invoked when the sheet and its descendents have @@ -339,46 +341,53 @@ (unless *in-layout-avp* (win:showWindow window win:sw_show) ; returns NIL if it was already visible. (or (win:updateWindow window) ; send a WM_PAINT message - (error "UpdateWindow: system error ~s" (win:getlasterror)))))) + (check-last-error "UpdateWindow"))))) (defmethod disable-mirror ((port acl-port) sheet) - (win::showWindow (sheet-mirror sheet) win::sw_hide)) + (win:showWindow (sheet-mirror sheet) win:sw_hide)) (defmethod raise-mirror ((port acl-port) (sheet mirrored-sheet-mixin)) - (win::setWindowPos (sheet-mirror sheet) (ct::null-handle win::hwnd) 0 0 0 0 - (logior win::swp_noactivate - win::swp_nomove - win::swp_nosize))) + ;; On Windows95, SetForegroundWindow often fails (returns NIL). + ;; But the menu shows up after a few seconds anyway. So that is + ;; why it would be bad to check the return status of this guy. + ;; + ;; We are supposed to avoid calling this function. "Let the + ;; user control which window is the foreground window." + (win:SetForegroundWindow (sheet-mirror sheet)) + t) (defmethod bury-mirror ((port acl-port) (sheet mirrored-sheet-mixin)) - (win::setWindowPos (sheet-mirror sheet) 1 0 0 0 0 - (logior win::swp_noactivate - win::swp_nomove - win::swp_nosize))) + (win:setWindowPos (sheet-mirror sheet) + win:HWND_BOTTOM + 0 0 0 0 ; x y width height + (logior win:swp_noactivate + win:swp_nomove ; ignore x y + win:swp_nosize ; ignore width height + ))) (defmethod mirror-visible-p ((port acl-port) sheet) - (win::isWindowVisible (sheet-mirror sheet))) + (win:isWindowVisible (sheet-mirror sheet))) ;; specialized Returns left,top,right,bottom (defmethod mirror-region* ((port acl-port) (sheet silica::top-level-sheet)) - (let ((wrect (ct::ccallocate win::rect)) - (topleft (ct::ccallocate win::point)) - (botright (ct::ccallocate win::point)) + (let ((wrect (ct:ccallocate win:rect)) + (topleft (ct:ccallocate win:point)) + (botright (ct:ccallocate win:point)) (handle (sheet-direct-mirror sheet)) ) ;;mm: Use the CLient values and map to screen coordinates - (win::getClientRect handle wrect) - (setf (ct::cref win::point topleft win::x) (ct::cref win::rect wrect win::left)) - (setf (ct::cref win::point topleft win::y) (ct::cref win::rect wrect win::top)) - (setf (ct::cref win::point botright win::x) (ct::cref win::rect wrect win::right)) - (setf (ct::cref win::point botright win::y) (ct::cref win::rect wrect win::bottom)) - (win::clientToScreen handle topleft) - (win::clientToScreen handle botright) - - (let ((wleft (ct::cref win::point topleft win::x)) - (wtop (ct::cref win::point topleft win::y)) - (wright (ct::cref win::point botright win::x)) - (wbottom (ct::cref win::point botright win::y))) + (win:getClientRect handle wrect) + (setf (ct:cref win:point topleft win::x) (ct:cref win:rect wrect win::left)) + (setf (ct:cref win:point topleft win::y) (ct:cref win:rect wrect win::top)) + (setf (ct:cref win:point botright win::x) (ct:cref win:rect wrect win::right)) + (setf (ct:cref win:point botright win::y) (ct:cref win:rect wrect win::bottom)) + (win:clientToScreen handle topleft) + (win:clientToScreen handle botright) + + (let ((wleft (ct:cref win:point topleft win::x)) + (wtop (ct:cref win:point topleft win::y)) + (wright (ct:cref win:point botright win::x)) + (wbottom (ct:cref win:point botright win::y))) (values (coordinate wleft) (coordinate wtop) (coordinate wright) (coordinate wbottom))))) @@ -392,62 +401,62 @@ ;; Returns x,y,width,height (defmethod mirror-inside-region* ((port acl-port) sheet) - (let ((crect (ct::ccallocate win::rect))) - (win::getClientRect (sheet-mirror sheet) crect) ; 0 0 width height - (let ((cwidth (ct::cref win::rect crect win::right)) - (cheight (ct::cref win::rect crect win::bottom))) + (let ((crect (ct:ccallocate win:rect))) + (win:getClientRect (sheet-mirror sheet) crect) ; 0 0 width height + (let ((cwidth (ct:cref win:rect crect win::right)) + (cheight (ct:cref win:rect crect win::bottom))) (values (coordinate 0) (coordinate 0) (coordinate cwidth) (coordinate cheight))))) ;;--- Shouldn't this be the same as MIRROR-REGION*? (defmethod mirror-native-edges* ((port acl-port) sheet) - (let ((wrect (ct::ccallocate win::rect))) - (win::getWindowRect (sheet-direct-mirror sheet) wrect) - (let ((wleft (ct::cref win::rect wrect win::left)) - (wtop (ct::cref win::rect wrect win::top)) - (wright (ct::cref win::rect wrect win::right)) - (wbottom (ct::cref win::rect wrect win::bottom))) + (let ((wrect (ct:ccallocate win:rect))) + (win:getWindowRect (sheet-direct-mirror sheet) wrect) + (let ((wleft (ct:cref win:rect wrect win::left)) + (wtop (ct:cref win:rect wrect win::top)) + (wright (ct:cref win:rect wrect win::right)) + (wbottom (ct:cref win:rect wrect win::bottom))) (values (coordinate wleft) (coordinate wtop) (coordinate wright) (coordinate wbottom))))) (defmethod mirror-inside-edges* ((port acl-port) sheet) - (let ((crect (ct::ccallocate win::rect))) - (win::getClientRect (sheet-mirror sheet) crect) ; 0 0 width height - (let ((cwidth (ct::cref win::rect crect win::right)) - (cheight (ct::cref win::rect crect win::bottom))) + (let ((crect (ct:ccallocate win:rect))) + (win:getClientRect (sheet-mirror sheet) crect) ; 0 0 width height + (let ((cwidth (ct:cref win:rect crect win::right)) + (cheight (ct:cref win:rect crect win::bottom))) (values (coordinate 0) (coordinate 0) (coordinate cwidth) (coordinate cheight))))) ;;mm: compute the offset and size deltas between frame and client area. (defun get-nonclient-deltas (sheet) - (let ((wrect (ct::ccallocate win::rect)) - (crect (ct::ccallocate win::rect)) - (topleft (ct::ccallocate win::point)) - (botright (ct::ccallocate win::point)) + (let ((wrect (ct:ccallocate win:rect)) + (crect (ct:ccallocate win:rect)) + (topleft (ct:ccallocate win:point)) + (botright (ct:ccallocate win:point)) (handle (sheet-direct-mirror sheet)) ) (unless (and handle (win:iswindow handle)) ;; No need to plunge ahead in this case... (error "Sheet no longer has a valid window handle: ~S" handle)) - (win::getWindowRect handle wrect) - (win::getClientRect handle crect) ; 0 0 width height - (setf (ct::cref win::point topleft win::x) (ct::cref win::rect crect win::left)) - (setf (ct::cref win::point topleft win::y) (ct::cref win::rect crect win::top)) - (setf (ct::cref win::point botright win::x) (ct::cref win::rect crect win::right)) - (setf (ct::cref win::point botright win::y) (ct::cref win::rect crect win::bottom)) - (win::clientToScreen handle topleft) + (win:getWindowRect handle wrect) + (win:getClientRect handle crect) ; 0 0 width height + (setf (ct:cref win:point topleft win::x) (ct:cref win:rect crect win::left)) + (setf (ct:cref win:point topleft win::y) (ct:cref win:rect crect win::top)) + (setf (ct:cref win:point botright win::x) (ct:cref win:rect crect win::right)) + (setf (ct:cref win:point botright win::y) (ct:cref win:rect crect win::bottom)) + (win:clientToScreen handle topleft) (win::clientToScreen handle botright) - (let ((ctop (ct::cref win::point topleft win::y)) - (cleft (ct::cref win::point topleft win::x)) - (cright (ct::cref win::point botright win::x)) - (cbottom (ct::cref win::point botright win::y)) - (wleft (ct::cref win::rect wrect win::left)) - (wtop (ct::cref win::rect wrect win::top)) - (wright (ct::cref win::rect wrect win::right)) - (wbottom (ct::cref win::rect wrect win::bottom))) + (let ((ctop (ct:cref win:point topleft win::y)) + (cleft (ct:cref win:point topleft win::x)) + (cright (ct:cref win:point botright win::x)) + (cbottom (ct:cref win:point botright win::y)) + (wleft (ct:cref win:rect wrect win::left)) + (wtop (ct:cref win:rect wrect win::top)) + (wright (ct:cref win:rect wrect win::right)) + (wbottom (ct:cref win:rect wrect win::bottom))) (values (- wleft cleft) (- wtop ctop) (- (- wright wleft) (- cright cleft)) @@ -456,29 +465,29 @@ (defun clim-internals::bounding-rectangle-inside-size (top-sheet) - (let ((crect (ct::ccallocate win::rect))) - (win::getClientRect (sheet-mirror top-sheet) crect) ; 0 0 width height - (let ((cwidth (ct::cref win::rect crect win::right)) - (cheight (ct::cref win::rect crect win::bottom))) + (let ((crect (ct:ccallocate win:rect))) + (win:getClientRect (sheet-mirror top-sheet) crect) ; 0 0 width height + (let ((cwidth (ct:cref win:rect crect win::right)) + (cheight (ct:cref win:rect crect win::bottom))) (values (coordinate cwidth) (coordinate cheight))))) (defmethod mirror-client-region-internal* ((port acl-port) mirror target) - (let ((wrect (ct::ccallocate win::rect)) - (topleft (ct::ccallocate win::point)) - (botright (ct::ccallocate win::point)) + (let ((wrect (ct:ccallocate win:rect)) + (topleft (ct:ccallocate win:point)) + (botright (ct:ccallocate win:point)) ) - (win::getWindowRect mirror wrect) - (setf (ct::cref win::point topleft win::x) (ct::cref win::rect wrect win::left)) - (setf (ct::cref win::point topleft win::y) (ct::cref win::rect wrect win::top)) - (setf (ct::cref win::point botright win::x) (ct::cref win::rect wrect win::right)) - (setf (ct::cref win::point botright win::y) (ct::cref win::rect wrect win::bottom)) - (win::screenToClient target topleft) - (win::screenToClient target botright) - (let ((wleft (ct::cref win::point topleft win::x)) - (wtop (ct::cref win::point topleft win::y)) - (wright (ct::cref win::point botright win::x)) - (wbottom (ct::cref win::point botright win::y))) + (win:getWindowRect mirror wrect) + (setf (ct:cref win::point topleft win::x) (ct:cref win:rect wrect win::left)) + (setf (ct:cref win:point topleft win::y) (ct:cref win:rect wrect win::top)) + (setf (ct:cref win:point botright win::x) (ct:cref win:rect wrect win::right)) + (setf (ct:cref win:point botright win::y) (ct:cref win:rect wrect win::bottom)) + (win:screenToClient target topleft) + (win:screenToClient target botright) + (let ((wleft (ct:cref win:point topleft win::x)) + (wtop (ct:cref win:point topleft win::y)) + (wright (ct:cref win:point botright win::x)) + (wbottom (ct:cref win:point botright win::y))) (values (coordinate wleft) (coordinate wtop) (coordinate wright) (coordinate wbottom))))) @@ -498,8 +507,8 @@ (ptdt (+ top dt))) ;; rl: +++kludge, why doesn't it know the size of the menu bar ;; in the first pass?, so add 19 for now - (win::setWindowPos (sheet-mirror sheet) - #+aclpc (ct::null-handle win::hwnd) ; we really want win::HWND_TOP + (win:setWindowPos (sheet-mirror sheet) + #+aclpc (ct:null-handle win:hwnd) ; we really want win:HWND_TOP #+acl86win32 0 pldl ptdt @@ -520,20 +529,20 @@ #+ignore (if (and (minusp ptdt) (> ptdt -30)) 19 0)) (logior - win::swp_noactivate - win::swp_nozorder))))) + win:swp_noactivate + win:swp_nozorder))))) ;;; unspecialized (not top) (defmethod set-sheet-mirror-edges* ((port acl-port) sheet left top right bottom) (fix-coordinates left top right bottom) - (win::setWindowPos (sheet-mirror sheet) - (ct::null-handle win::hwnd) ; we really want win::HWND_TOP + (win:setWindowPos (sheet-mirror sheet) + (ct:null-handle win:hwnd) ; we really want win:HWND_TOP left top (- right left) (- bottom top) - (logior win::swp_noactivate - win::swp_nozorder))) + (logior win:swp_noactivate + win:swp_nozorder))) (defmethod set-sheet-mirror-edges* :around ((port acl-port) sheet @@ -591,7 +600,7 @@ (let ((mirror (sheet-direct-mirror sheet)) (pattern *clim-icon-pattern*) frame icon) - (when (and mirror (win::IsIconic mirror)) + (when (and mirror (win:IsIconic mirror)) (setf frame (pane-frame sheet)) (setf icon (clim-internals::frame-icon frame)) (with-sheet-medium (medium sheet) @@ -604,7 +613,7 @@ #+ignore (multiple-value-bind (left top right bottom) (mirror-native-edges* acl-clim::*acl-port* sheet) - (let ((dc (win::GetDc mirror))) - (win::DrawIcon dc 0 0 *clim-icon*) - (win::releaseDC mirror dc))) + (let ((dc (GetDc mirror))) + (win:DrawIcon dc 0 0 *clim-icon*) + (win:releaseDC mirror dc))) ))))) diff --git a/aclpc/acl-pixmaps.lisp b/aclpc/acl-pixmaps.lisp index d5d043727e2fb909fe07e1d33bdbe8d6e52e408a..29945c8a582f0b8afb4a20495681f0b54eb43558 100644 --- a/aclpc/acl-pixmaps.lisp +++ b/aclpc/acl-pixmaps.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-pixmaps.lisp,v 1.5 1998/08/06 23:15:44 layer Exp $ #|**************************************************************************** * * @@ -29,29 +47,19 @@ (rtop (min from-y to-y)) (rright (+ (max from-x to-x) width)) (rbottom (+ (max from-y to-y) height))) - (let ((scrollrect (ct:callocate win:rect - ; win::left rleft - ; win::top rtop - ; win::right rright - ; win::bottom rbottom - )) - (cliprect (ct:callocate win:rect - ; win::left rleft - ; win::top rtop - ; win::right rright - ; win::bottom rbottom - ))) - (setf (ct::cref win::rect scrollrect win::left) rleft) - (setf (ct::cref win::rect cliprect win::left) rleft) - (setf (ct::cref win::rect scrollrect win::top) rtop) - (setf (ct::cref win::rect cliprect win::top) rtop) - (setf (ct::cref win::rect scrollrect win::right) rright) - (setf (ct::cref win::rect cliprect win::right) rright) - (setf (ct::cref win::rect scrollrect win::bottom) rbottom) - (setf (ct::cref win::rect cliprect win::bottom) rbottom) + (let ((scrollrect (ct:callocate win:rect)) + (cliprect (ct:callocate win:rect))) + (setf (ct:cref win:rect scrollrect win::left) rleft) + (setf (ct:cref win:rect cliprect win::left) rleft) + (setf (ct:cref win:rect scrollrect win::top) rtop) + (setf (ct:cref win:rect cliprect win::top) rtop) + (setf (ct:cref win:rect scrollrect win::right) rright) + (setf (ct:cref win:rect cliprect win::right) rright) + (setf (ct:cref win:rect scrollrect win::bottom) rbottom) + (setf (ct:cref win:rect cliprect win::bottom) rbottom) (win::scrollDc dc (- to-x from-x) (- to-y from-y) - scrollrect cliprect (ct::null-handle win::hrgn) - #+aclpc ct::null #-aclpc 0) + scrollrect cliprect (ct:null-handle win::hrgn) + #+aclpc ct:null #-aclpc 0) ))))))) ;; changed bop->winop to return the val let variable rather than the @@ -59,29 +67,25 @@ ;; the function. (sdj 9/27/96) (defun bop->winop (bop) - (let ((val - (cond - ((eq bop boole-1) #xcc0020) ; srccopy - ((eq bop boole-2) #xaa0029) ; - ((eq bop boole-clr) #xff0062) ; whiteness - ((eq bop boole-set) #x42) ; blackness - ((eq bop boole-c1) #x330008) ; notsrccopy - ((eq bop boole-c2) #x550009) ; dstinvert - ((eq bop boole-and) #x8800c6) ; srcand - ((eq bop boole-ior) #xee0086) ; srcpaint - ((eq bop boole-xor) #x660046) ; srcinvert - ((eq bop boole-eqv) #x990066) ; - ((eq bop boole-nand) #x7700e6) ; - ((eq bop boole-nor) #x1100a6) ; notsrcerase - ((eq bop boole-andc1) #x220326) ; - ((eq bop boole-andc2) #x440328) ; srcerase - ((eq bop boole-orc1) #xbb0226) ; mergepaint - ((eq bop boole-orc2) #xdd0228) ; - (t win:srccopy) - )) - #+ignore - (winop (ct:ccallocate :long))) - val)) + (cond + ((eq bop boole-1) #xcc0020) ; srccopy + ((eq bop boole-2) #xaa0029) ; + ((eq bop boole-clr) #xff0062) ; whiteness + ((eq bop boole-set) #x42) ; blackness + ((eq bop boole-c1) #x330008) ; notsrccopy + ((eq bop boole-c2) #x550009) ; dstinvert + ((eq bop boole-and) #x8800c6) ; srcand + ((eq bop boole-ior) #xee0086) ; srcpaint + ((eq bop boole-xor) #x660046) ; srcinvert + ((eq bop boole-eqv) #x990066) ; + ((eq bop boole-nand) #x7700e6) ; + ((eq bop boole-nor) #x1100a6) ; notsrcerase + ((eq bop boole-andc1) #x220326) ; + ((eq bop boole-andc2) #x440328) ; srcerase + ((eq bop boole-orc1) #xbb0226) ; mergepaint + ((eq bop boole-orc2) #xdd0228) ; + (t win:srccopy) + )) ;;; consider caching instance in port (defmethod port-allocate-pixmap ((port acl-port) medium width height) @@ -93,16 +97,14 @@ (with-dc (window dc) (setq cdc (win:createCompatibleDC dc)) (setq bitmap (win:createCompatibleBitmap dc width height)) - (setf obitmap (win:selectObject cdc bitmap))) + (setf obitmap (selectobject cdc bitmap))) (make-instance 'acl-pixmap :bitmap bitmap :for-medium medium :width width :height height :cdc cdc - :original-bitmap obitmap - ))) - + :original-bitmap obitmap))) (defmethod port-deallocate-pixmap ((port acl-port) (pixmap acl-pixmap)) (with-slots (bitmap cdc original-bitmap) pixmap @@ -110,7 +112,7 @@ (win:deleteObject bitmap) (setq bitmap nil)) (when cdc - (win:selectObject cdc original-bitmap) + (selectobject cdc original-bitmap) (win:deleteDC cdc) (setq bitmap nil cdc nil)))) diff --git a/aclpc/acl-port.lisp b/aclpc/acl-port.lisp index f9f140451dc8296822f07d99efb305ffde0ac2e8..5c4a63df85824002a84fcd5f1116348dda6a220c 100644 --- a/aclpc/acl-port.lisp +++ b/aclpc/acl-port.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-port.lisp,v 1.7 1998/08/06 23:15:45 layer Exp $ #|**************************************************************************** * * @@ -129,21 +147,20 @@ ;; was suspect. (cim 10/14/96) (defclass acl-port (basic-port) - ((text-style->acl-font-mapping :initform (make-hash-table)) - #+ignore (font-cache-style :initform nil) - #+ignore (font-cache-font :initform nil) - (vk->keysym :initform (make-hash-table)) - (keysym->keysym :initform (make-hash-table)) - logpixelsy - (event-queue :initform (make-acl-event-queue)) - (mirror-with-focus :initform nil :accessor acl-port-mirror-with-focus) - (pointer-sheet :initform nil) - (motion-pending :initform nil) - (cursor-cache :initform nil) - (grab-cursor :initform nil :accessor port-grab-cursor) - (resources :initform nil :accessor port-default-resources) - pointer-x - pointer-y)) + ((dc-cache :initform (make-hash-table) :accessor port-dc-cache) + (text-style->acl-font-mapping :initform (make-hash-table)) + (vk->keysym :initform (make-hash-table)) + (keysym->keysym :initform (make-hash-table)) + logpixelsy + (event-queue :initform (make-acl-event-queue)) + (mirror-with-focus :initform nil :accessor acl-port-mirror-with-focus) + (pointer-sheet :initform nil) + (motion-pending :initform nil) + (cursor-cache :initform nil) + (grab-cursor :initform nil :accessor port-grab-cursor) + (resources :initform nil :accessor port-default-resources) + (pointer-x :initform 0) + (pointer-y :initform 0))) (defmethod restart-port ((port acl-port)) ;; No need to devote a thread to receiving messages @@ -186,6 +203,34 @@ :color-p color-p :dynamic-p dynamic-p)) +(defclass acl-device-color (device-color) + ((color :initform nil))) + +(defmethod make-device-color ((palette acl-palette) pixel) + (make-instance 'acl-device-color + :palette palette + :pixel pixel)) + +(defmethod device-color-color ((device-color acl-device-color)) + (with-slots (color) device-color + (or color + (setq color (wincolor->color (device-color-pixel device-color)))))) + +(defmethod silica::port-set-pane-background ((port acl-port) pane medium ink) + (declare (ignore pane)) + ;; Invoked :after (setf pane-background) + (setf (medium-background medium) ink)) + +(defmethod silica::port-set-pane-foreground ((port acl-port) pane medium ink) + (declare (ignore pane)) + ;; Invoked :after (setf pane-foreground) + (setf (medium-foreground medium) ink)) + +(defmethod silica::port-set-pane-text-style ((port acl-port) pane medium style) + (declare (ignore pane)) + ;; Invoked :after (setf pane-text-style) + (setf (medium-text-style medium) style)) + (defmethod initialize-instance :before ((port acl-port) &key) (ensure-clim-initialized) (unless (null *acl-port*) @@ -212,13 +257,12 @@ ;; get-sheet-resources: (setf (port-default-resources port) `(:background - ,(wincolor->color (win:getSysColor win:color_btnface)) + ,+ltgray+ :foreground ,(wincolor->color (win:getSysColor win:color_windowtext)))) ;; Panes that don't have a direct mirror will use this as ;; the default background: - (setq silica:*default-pane-background* - (wincolor->color (win:getSysColor win:color_btnface))) + (setq silica:*default-pane-background* +ltgray+) )) (defmethod destroy-port :before ((port acl-port)) @@ -274,33 +318,38 @@ (let ((face (text-style-face style))) (typecase face (cons - (values (if (member :bold face) 700 400) + (values (if (member :bold face) win:FW_BOLD win:FW_NORMAL) (member :italic face))) (otherwise (case face - (:roman (values 400 nil)) - (:bold (values 700 nil)) - (:italic (values 400 t)) - (otherwise (values 400 nil)))))) + (:roman (values win:FW_NORMAL nil)) + (:bold (values win:FW_BOLD nil)) + (:italic (values win:FW_NORMAL t)) + (otherwise (values win:FW_BOLD nil)))))) (multiple-value-bind (family face-name) (case (text-style-family style) - (:fix (values 0 "courier")) - (:serif (values 0 "times new roman")) - (:sans-serif (values 0 "arial")) + (:fix (values (logior win:FIXED_PITCH win:FF_MODERN) + "courier")) + (:serif (values (logior win:VARIABLE_PITCH win:FF_ROMAN) + "times new roman")) + (:sans-serif (values (logior win:VARIABLE_PITCH win:FF_SWISS) + "arial")) ;;--- some of these specify ugly ugly linedrawn fonts - (otherwise (values 0 nil))) + (otherwise (values (logior win:DEFAULT_PITCH win:FF_DONTCARE) + (string (text-style-family style))))) (let ((point-size (let ((size (text-style-size style))) (typecase size - (number - size) + (number size) (otherwise - (or (second (assoc size *acl-logical-size-alist*)) 12)))))) + (or (second (assoc size *acl-logical-size-alist*)) + 12)))))) (make-windows-font - (- (round (* point-size (slot-value port 'logpixelsy)) - 72)) - :weight weight :italic italic - :pitch-and-family family :face face-name)))))))) + (- (round (* point-size (slot-value port 'logpixelsy)) 72)) + :weight weight + :italic italic + :pitch-and-family family + :face face-name)))))))) (defmethod text-style-mapping ((device acl-port) (style silica::device-font) @@ -324,36 +373,53 @@ (let ((name (silica::device-font-name style))) (make-device-font (win:getstockobject name))))))) -(defvar *fwt* nil) - -(defun make-font-width-table (dc last-character first-character) +(defun make-font-width-table (dc last-character first-character default-width) (let* ((tepsize (ct:ccallocate win::size)) (string (make-string 1) ) (array (make-array (1+ last-character)))) (loop for i from first-character to last-character do (setf (char string 0) (code-char i)) - (win:getTextExtentPoint dc string 1 tepsize) - (setf (aref array i) (ct:cref win::size tepsize win::cx))) - (setq *fwt* array))) + (cond ((win:getTextExtentPoint dc string 1 tepsize) + (setf (aref array i) (ct:cref win:size tepsize cx))) + (t + ;; Why does this clause ever run? getlasterror=10035. + (check-last-error "GetTextExtentPoint" :action :warn) + (setf (aref array i) default-width)))) + array)) (defun make-system-font () (make-device-font (win:getstockobject win:system_font))) (defun make-windows-font (height &key (width 0) (escapement 0) (orientation 0) - (weight 400) (italic nil) (underline nil) (strikeout nil) - (charset 0) (output-precision 0) (clip-precision 0) - (quality 2) ;; ie PROOF_QUALITY - (pitch-and-family 0) (face nil) win-font) + (weight win:FW_NORMAL) + (italic nil) (underline nil) (strikeout nil) + (charset win:ANSI_CHARSET) + (output-precision WIN:OUT_DEFAULT_PRECIS) + (clip-precision WIN:CLIP_DEFAULT_PRECIS) + (quality win:PROOF_QUALITY) + (pitch-and-family (logior win:DEFAULT_PITCH win:FF_DONTCARE)) + (face nil) + win-font) (let ((win-font (or win-font - (win:createFont height width escapement orientation weight - (if italic 1 0) (if underline 1 0) - (if strikeout 1 0) charset - output-precision clip-precision quality - pitch-and-family (or face ""))))) + (win:createFont height ; logical height + width ; logical average width + escapement ; angle of escapement (tenths of degrees) + orientation; normally the same as escapement + weight ; font weight (FW_NORMAL=400, FW_BOLD=700) + (if italic 1 0) + (if underline 1 0) + (if strikeout 1 0) + charset ; if you want chinese or greek + output-precision + clip-precision + quality + pitch-and-family + (or face "") + )))) (when (zerop win-font) - (error "CreateFont: system error ~s" (win:getlasterror))) + (check-last-error "CreateFont")) (make-device-font win-font))) (defun make-device-font (win-font) @@ -362,9 +428,26 @@ (sheet-mirror (frame-top-level-sheet *application-frame*)))) (tmstruct (ct:ccallocate win:textmetric))) (unless cw (setf cw *current-window*)) + (unless (win:iswindow cw) + ;; This clause is for the rare case that you are doing drawing + ;; from a background process the first time you attempt to use + ;; this font. It doesn't really matter which frame you pick. + (let* ((framem (find-frame-manager)) + (frame (some #'(lambda (f) + (when (win:iswindow + (sheet-mirror (frame-top-level-sheet + f))) + f)) + (when framem + (frame-manager-frames framem))))) + (when frame + (setq cw (sheet-mirror (frame-top-level-sheet frame)))))) + (unless (win:iswindow cw) + (error "No window found for calculating text font metrics.")) (with-dc (cw dc) - (win:selectObject dc win-font) - (win:getTextMetrics dc tmstruct) + (selectobject dc win-font) + (or (win:getTextMetrics dc tmstruct) + (check-last-error "GetTextMetrics")) (let ((average-character-width (ct:cref win:textmetric tmstruct tmavecharwidth)) (maximum-character-width @@ -374,7 +457,8 @@ (font-width-array-or-nil nil)) (setq font-width-array-or-nil (and (/= average-character-width maximum-character-width) - (make-font-width-table dc last-character first-character))) + (make-font-width-table dc last-character first-character + maximum-character-width))) (make-acl-font :index win-font :height (ct:cref win:textmetric tmstruct tmheight) @@ -429,6 +513,8 @@ (values index acl-font escapement-x escapement-y origin-x origin-y bb-x bb-y)))) +;; The second element of each item is passed to +;; LoadCursor and SetCursor. (defvar *win-cursor-type-alist* `((:appstarting ,win:idc_appstarting) (:default ,win:IDC_ARROW) @@ -450,13 +536,21 @@ (defmethod port-set-sheet-pointer-cursor ((port acl-port) sheet cursor) (unless (eq (sheet-pointer-cursor sheet) cursor) + #+ignore (win:setCursor (realize-cursor port cursor)) ; mouse cursor + ;; SetCursor doesn't seem to be the right thing. + ;; Each time the mouse moves, Windows sets the cursor back + ;; to the default for the class and then sends a WM_SETCURSOR + ;; message where we get a chance to SetCursor again. + (win:setClassLong (sheet-mirror sheet) + -12 ; GCL_HCURSOR + (realize-cursor port cursor)) ) cursor) (defmethod realize-cursor ((port acl-port) (cursor symbol)) (let ((cursor (or (second (assoc cursor *win-cursor-type-alist*)) - :default))) + win:IDC_ARROW))) (realize-cursor port cursor))) (defvar *loaded-cursors* nil) @@ -467,7 +561,10 @@ (setq result (win:LoadCursor 0 cursor)) (when (zerop result) - (error "LoadCursor: system error ~s" (win:getlasterror))) + ;; Suppress the error for now to be compatible with + ;; previous versions of CLIM. It would be nice to + ;; figure out what is causing this and fix it. JPM 6/98. + (check-last-error "LoadCursor" :action :warn)) (push (list cursor result) *loaded-cursors*)) result)) @@ -497,13 +594,13 @@ (declare (ignore pointer)) (fix-coordinates x y) (or (win:setCursorPos x y) - (error "SetCursorPos: system error ~S" (win:getlasterror)))) + (check-last-error "SetCursorPos"))) (defmethod clim-internals::port-query-pointer ((port acl-port) sheet) (let ((point (ct:ccallocate win:point)) (native-x 0)(native-y 0)) (or (win:getCursorPos point) - (error "GetCursorPos: system error ~s" (win:getlasterror))) + (check-last-error "GetCursorPos")) (let ((root-x (ct:cref win:point point x)) (root-y (ct:cref win:point point y))) (multiple-value-bind (x y) @@ -560,11 +657,24 @@ (defmethod note-pointer-motion ((port acl-port) sheet x y) + ;; X and Y come straight from WM_MOUSEMOVE. + ;; Take care not to declare motion-pending in the case where there + ;; was no motion, WM_MOUSEMOVE gives you more than you need. (with-slots (pointer-sheet motion-pending pointer-x pointer-y) port - (setf pointer-sheet sheet) - (setf pointer-x x) - (setf pointer-y y) - (setf motion-pending t))) + (cond ((and (eq x pointer-x) + (eq y pointer-y)) + nil) + (t + #+debug + (format *trace-output* + "~% Was ~A ~A ~A IS ~A ~A ~A~%" + pointer-sheet pointer-x pointer-y + sheet x y) + (setf pointer-sheet sheet) + (setf pointer-x x) + (setf pointer-y y) + (setf motion-pending t) + t)))) (defmethod flush-pointer-motion ((port acl-port)) (with-slots (event-queue motion-pending pointer-sheet pointer-x pointer-y) @@ -620,43 +730,12 @@ (defvar *l-counter* 0) (defvar *nowait* nil) -;;--- event-processing is horribly wrong on aclwin; fix me!!! -#+aclpc -(defmethod process-next-event ((port acl-port) - &key (timeout nil) (wait-function nil) - (state "Windows Event")) - (setq *l-counter* 0) - ; (if (and timeout (= timeout 0)) (cerror "timeout" "zero")) - (with-slots (event-queue) port ; nil to disable timeout - (let ((end-time (and timeout (+ (get-internal-real-time) - (* internal-time-units-per-second - timeout))))) - ;; dispatch one pending message, if one is pending - (await-response nil) - (loop - (incf *l-counter*) - (flush-pointer-motion port) ; adds mouse-moved event to port's - ; queue if necessary - (let ((event (queue-get event-queue))) - (when event - (distribute-event port event) - (return t))) - (when (and wait-function - (funcall wait-function)) - (return nil)) - (when (and end-time (>= (get-internal-real-time) end-time)) - (return nil)) - (loop - ;; dispatches all pending messages - (unless (await-response nil) (return nil))) - )))) - -#+acl86win32 +(defvar *clim-pulse-rate* 1.0) ; seconds. + (defmethod process-next-event ((port acl-port) &key (timeout nil) (wait-function nil) (state "Windows Event")) - (declare (ignore state)) (with-slots (event-queue motion-pending) port (let ((event (queue-get event-queue)) (reason nil)) @@ -673,9 +752,19 @@ (funcall wait-function) (setq reason :wait-function))))) (if timeout - (mp:process-wait-with-timeout "Windows Event" timeout + (mp:process-wait-with-timeout state timeout #'wait-for-event) - (mp:process-wait "Windows Event" #'wait-for-event)))) + (loop + ;; 5/28/98 JPM ACL 5.0.beta + ;; There seems to be a bug in process-wait that + ;; it does not run the test function often enough. + ;; The workaround is to wake up every so often and + ;; run the test function. + (when (mp:process-wait-with-timeout + state *clim-pulse-rate* #'wait-for-event) + (return))) + #+someday + (mp:process-wait state #'wait-for-event)))) (cond (event (distribute-event port event) t) diff --git a/aclpc/acl-prel.lisp b/aclpc/acl-prel.lisp index 113d478147b43e07c2055cfd2ca2020ddb5ee2ae..0584cba61287d1c115f9d20efbdf0593a66d962c 100644 --- a/aclpc/acl-prel.lisp +++ b/aclpc/acl-prel.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-prel.lisp,v 1.6 1998/08/06 23:15:45 layer Exp $ + #|**************************************************************************** * * * * @@ -14,47 +33,55 @@ (declaim (special *hinst*)) +(defun combobox-scroll-bars (items) + ;; If there are many items, you won't be able + ;; to see them without a scroll bar. + (if (> (length items) 30) :vertical nil)) + (defun hcombo-open (parent id left top width height - &key (mode :exclusive) - (items nil) + &key (items nil) (value nil) (name-key #'identity) - (border3d t) - (sorted nil) - (label "")) - (declare (ignore sorted border3d mode height id)) + (label "") + (scroll-mode (combobox-scroll-bars items))) + (declare (ignore id)) (let* ((hwnd - (win:CreateWindowEx 0 ; extended-style - "COMBOBOX" ; classname - (nstringify label) ; windowname - (logior - win:WS_CHILD - win:CBS_DROPDOWNLIST) - 0 0 0 0 - parent (ct::null-handle win::hmenu) - *hinst* (symbol-name (gensym))))) + (win:CreateWindowEx + 0 ; extended-style + "COMBOBOX" ; classname + (nstringify label) ; windowname + (logior + (if (member scroll-mode '(:vertical :both t :dynamic)) + win:WS_VSCROLL + 0) + (if (member scroll-mode '(:horizontal :both t :dynamic)) + win:WS_HSCROLL + 0) + win:WS_CHILD + win:WS_TABSTOP + win:CBS_DROPDOWNLIST) + 0 0 0 0 + parent (ct::null-handle win::hmenu) + *hinst* (symbol-name (gensym))))) (if (ct:null-handle-p hwnd hwnd) ;; failed (cerror "proceed" "failed") ;; else succeed if we can init the DC (progn (win:SetWindowPos hwnd (ct:null-handle hwnd) - left top width 250 ;height - 0 - ;;#.(logior win:SWP_NOACTIVATE win:SWP_NOZORDER) - ) + left top width height + 0 + ;;#.(logior win:SWP_NOACTIVATE win:SWP_NOZORDER) + ) (let* ((index -1) - (item-name "") - ;;(cstr (ct::callocate (:char *) :size 256)) - ;;(subsize 0) - ) + (item-name "")) (dolist (item items) (setf item-name (funcall name-key item)) (incf index) (win:SendMessage hwnd win:CB_INSERTSTRING index item-name) )) (win:sendMessage hwnd win:CB_SETCURSEL (or value 0) 0) - (win:sendMessage hwnd win:CB_SETTOPINDEX (or value 0) 0))) + (win:sendMessage hwnd CB_SETTOPINDEX (or value 0) 0))) hwnd)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -73,47 +100,44 @@ (label "") (horizontal-extent 0)) (declare (ignore border3d id)) - (let* ((hwnd - (win:CreateWindowEx 0 ; extended-style - "LISTBOX" ; classname - (nstringify label) ; windowname - (logior - win:LBS_NOINTEGRALHEIGHT ; partial item displayed at bottom - win:LBS_NOTIFY - win:LBS_USETABSTOPS ; Expands tab characters in items - (if sorted win:LBS_SORT 0) - (if (eq mode :nonexclusive) win:LBS_MULTIPLESEL 0) - win:WS_CHILD - win:WS_BORDER - (if (member scroll-mode '(:horizontal :both t :dynamic)) - win:WS_HSCROLL - 0) - (if (member scroll-mode '(:vertical :both t :dynamic)) - win:WS_VSCROLL - 0) - (if (member scroll-mode '(:horizontal :vertical :both t)) - win:LBS_DISABLENOSCROLL - 0) - win:WS_CLIPCHILDREN - win:WS_CLIPSIBLINGS) ; style - 0 0 0 0 - parent - #+acl86win32 (ct::null-handle win::hmenu) - #-acl86win32 (let ((hmenu (ccallocate hmenu))) - (setf (handle-value hmenu hmenu) id) - ; (or id (next-child-id parent)) - hmenu) - *hinst* - #+acl86win32 (symbol-name (gensym)) - #+aclpc acl-clim::*win-arg*))) + (let* ((style + (logior + win:LBS_NOINTEGRALHEIGHT ; partial item displayed at bottom + win:LBS_NOTIFY + win:LBS_USETABSTOPS ; Expands tab characters in items + (if sorted win:LBS_SORT 0) + (if (eq mode :nonexclusive) win:LBS_MULTIPLESEL 0) + win:WS_CHILD + (if (member scroll-mode '(:horizontal :both t :dynamic)) + win:WS_HSCROLL + 0) + (if (member scroll-mode '(:vertical :both t :dynamic)) + win:WS_VSCROLL + 0) + (if (member scroll-mode '(:horizontal :vertical :both t)) + LBS_DISABLENOSCROLL + 0) + win:WS_CLIPCHILDREN + win:WS_CLIPSIBLINGS)) + (exstyle win:ws_ex_clientedge) + (hwnd + (win:CreateWindowEx exstyle + "LISTBOX" ; classname + (nstringify label) ; windowname + style + 0 0 0 0 + parent + (ct::null-handle win::hmenu) + *hinst* + (symbol-name (gensym))))) (if (ct:null-handle-p hwnd hwnd) ;; failed (cerror "proceed" "failed") ;; else succeed if we can init the DC (progn (win:SetWindowPos hwnd (ct:null-handle hwnd) - left top width height - #.(logior win:SWP_NOACTIVATE win:SWP_NOZORDER)) + left top width height + #.(logior win:SWP_NOACTIVATE win:SWP_NOZORDER)) (let* ((index -1) (item-name "") ;;(cstr (ct::callocate (:char *) :size 256)) @@ -297,7 +321,7 @@ (defconstant +rgb-bitmapinfo+ (ct:callocate win:bitmapinfo :size +bitmapinfosize+)) -(defun acl-bitmapinfo (colors width height) +(defun acl-bitmapinfo (colors width height medium) (assert (< (length colors) +maxcolors+)) ;; returns the appropriate bitmapinfo and DIB_XXX_COLORS constant (let ((bitcount +bits-per-pixel+) @@ -317,6 +341,12 @@ ) (dotimes (i (length colors)) (let ((rgb (aref colors i))) + (cond ((eq rgb +foreground-ink+) + (setq rgb (medium-foreground medium))) + ((eq rgb +background-ink+) + (setq rgb (medium-background medium))) + ((eq rgb +transparent-ink+) + (setq rgb (medium-background medium)))) (multiple-value-bind (red green blue) (color-rgb rgb) (ct:cset windows:bitmapinfo bmi (windows::bmicolors (fixnum i) rgbreserved) @@ -333,12 +363,12 @@ ;; return values (values bmi win:DIB_RGB_COLORS))) -(defmethod get-texture (device-context pixel-map colors) +(defmethod get-texture (device-context pixel-map colors medium) (let* ((width (array-dimension pixel-map 1)) (height (array-dimension pixel-map 0)) texture-handle) (multiple-value-bind (bitmapinfo dib-mode) - (acl-bitmapinfo colors width height) + (acl-bitmapinfo colors width height medium) (setq texture-handle (win:CreateDIBitmap device-context @@ -348,44 +378,9 @@ bitmapinfo dib-mode)) (when (zerop texture-handle) - (error "CreateDIBitmap: error")) + (check-last-error "CreateDIBitmap")) texture-handle))) - -;;; clipboard support -#|| +++ broken (ct::callocate handle) -(defconstant clphdata (ct::callocate handle)) -(defconstant clppdata (ct::callocate (:void *))) - - -(defun lisp->clipboard (object) - (let ((*inside-convert-clipboard-from-lisp* t)) - (when (OpenClipboard (ct:null-handle hwnd)) - (unwind-protect - (add-string-to-clipboard object) - (CloseClipboard))))) - -(defmethod clipboard->lisp () - (when (OpenClipboard (ct:null-handle hwnd)) - (unwind-protect - (progn - (GetClipboardData CF_TEXT clphdata) - (unless (ct:null-handle-p handle clphdata) - (GlobalLock clphdata clppdata) - (unless (null-cpointer-p clppdata) - (let* ((raw-clpsize (GlobalSize clphdata :static)) - (clpsize - (if (fixnump raw-clpsize) - raw-clpsize - most-positive-fixnum)) - (string (make-string clpsize))) - (far-peek string clppdata 0 clpsize) - (GlobalUnlock clphdata) - (shorten-vector string (strlen string)) - string)))) - (CloseClipboard)))) -||# - ;;; about box support (defun pop-up-about-climap-dialog (frame &rest ignoreargs) @@ -394,4 +389,98 @@ (clim-internals::frame-pretty-name frame) (lisp-implementation-version)) :exit-boxes '((:exit "OK")) - :title (format nil "About ~A" (clim-internals::frame-pretty-name frame)))) + :title (format nil "About ~A" + (clim-internals::frame-pretty-name frame)))) + +(defun errno-to-text (errno) + (let* ((pointer (make-array 1 + :element-type '(unsigned-byte 32) + :initial-element 0)) + (flags (logior #x100 ; format_message_allocate_buffer + #x1000 ; format_message_from_system + )) + ;; Unfortunately, most of the interesting error codes are not + ;; in the system's message table. Where are they? If we had + ;; a handle to the relevant module, we could specify that + ;; to FormatMessage in order to search a module's message table. + (chars (formatmessage flags + 0 errno 0 + pointer 0 0))) + (values (if (plusp chars) + (nsubstitute #\space #\return (ff:char*-to-string (aref pointer 0))) + "unidentified system error") + chars))) + +(defun check-last-error (name &key (action :error)) + ;; Check the value of GetLastError. It is quite + ;; impossible to ensure correct operation of CLIM + ;; without paying attention to the errors that come + ;; back from the system calls. Sometimes, however, + ;; it is more appropriate to warn about the problem + ;; than to signal an error. + (let* ((code (win:getlasterror))) + (cond ((zerop code) nil) + ((eq action :error) + (error "~A: (error ~A) ~A" name code (errno-to-text code))) + ((eq action :warn) + ;; Printing warnings on clim windows risks recursive + ;; warning loop. + (format *trace-output* + "~&Warning: ~A: (error ~A) ~A~%" name code (errno-to-text code)) + code) + (t code)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Clipboard Support +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This seems to work, but CLIM doesn't really use it +;; other than in one of the CLIM Demos. + +(defun lisp->clipboard (object &key (printer #'prin1-to-string) + (format win:CF_TEXT)) + ;; Can't open clipboard if somebody else has it open. + (if (win:OpenClipboard (ct:null-handle hwnd)) + (unwind-protect + (let* ((string + (let ((*print-readably* t)) + (funcall printer object))) + (cstring nil) + (l (length string)) + (hmem (win:GlobalAlloc (logior win:GMEM_MOVEABLE + win:GMEM_DDESHARE) + (1+ l))) + (mem (win:GlobalLock hmem))) + (setq cstring (ff:string-to-char* string mem)) + (win:GlobalUnlock hmem) + ;; After calling SetClipboardData, the + ;; clipboard owns hMem. It must not be + ;; modified or freed. + (or (win:emptyclipboard) + (check-last-error "EmptyClipboard")) + (win:SetClipboardData format hmem) + (ff:free-fobject-c cstring) + t) + (win:CloseClipboard)) + (check-last-error "OpenClipboard"))) + +(defun clipboard->lisp (&key (parser #'read-from-string) + (format win:CF_TEXT)) + ;; Can't open clipboard if somebody else has it open. + (if (win:OpenClipboard (ct:null-handle hwnd)) + (unwind-protect + (let ((hmem (win:GetClipboardData format)) + (string nil)) + ;; The clipboard owns hMem. The application must + ;; not modify it, free it, or rely on it's value being + ;; stable after closing the clipboard. + (when (zerop hmem) + (check-last-error "GetClipboardData")) + (setq string (ct:handle-value win:handle hmem)) + (cond ((zerop string) (values nil nil)) + (t + (when (integerp string) + (setq string (ff:char*-to-string string))) + (values (funcall parser string) string)))) + (win:CloseClipboard)) + (check-last-error "OpenClipboard"))) diff --git a/aclpc/acl-scroll.lisp b/aclpc/acl-scroll.lisp index f2361e1e0182eb3d5abc9ccb1fe98f5313cc47f2..8b7bdc593f2a49251b70b46114e1330c022a153b 100644 --- a/aclpc/acl-scroll.lisp +++ b/aclpc/acl-scroll.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-scroll.lisp,v 1.6 1998/08/06 23:15:45 layer Exp $ #|**************************************************************************** * * @@ -24,24 +42,30 @@ ) ;; eval-when (defmethod handle-event ((pane mswin-scroll-bar) - (event silica::scrollbar-event)) + (event silica::scrollbar-event)) (with-slots (silica::orientation silica::action silica::amount) event - (assert (eql silica::orientation (gadget-orientation pane))) - (multiple-value-bind (min max) (gadget-range* pane) - (setf (gadget-value pane) - (max min - (min (- max (scroll-bar-size pane)) - (case silica::action - (:relative-jump ; press arrows - (+ (gadget-value pane) - (* (scroll-bar-size pane) silica::amount))) - (:screenful ; click near thumb - (+ (gadget-value pane) - (* (scroll-bar-size pane) silica::amount))) - (:percentage ; drag thumb - (+ min - (* (- max min (scroll-bar-size pane)) - (/ silica::amount (float acl-clim::*win-scroll-grain*)))))))))))) + (assert (eql silica::orientation (gadget-orientation pane))) + (multiple-value-bind (min max) (gadget-range* pane) + (let ((new + (max min + (min (- max (scroll-bar-size pane)) + (case silica::action + (:relative-jump ; press arrows + (+ (gadget-value pane) + (* (scroll-bar-size pane) silica::amount))) + (:screenful ; click near thumb + (+ (gadget-value pane) + (* (scroll-bar-size pane) silica::amount))) + (:percentage ; drag thumb + (+ min + (* (- max min (scroll-bar-size pane)) + (/ silica::amount + (float acl-clim::*win-scroll-grain*)))))))))) + #+ignore + (setf (gadget-value pane) new) + (value-changed-callback pane (gadget-client pane) + (gadget-id pane) new) + )))) (define-event-resource scrollbar-event 10) @@ -149,7 +173,8 @@ ;;--- In the case where the viewport is bigger than the window this ;;--- code gets things wrong. Check out the thinkadot demo. It's ;;--- because (- (--) (- vmin)) is negative. -(defun update-mswin-sbar (scroll-bar min max vmin vmax orientation) +(defmethod update-scroll-bar ((scroll-bar silica::mswin-scroller-pane) + min max vmin vmax orientation) (declare (optimize (safety 0) (speed 3))) ;;-- Is this really the right thing to do? ;;-- If in an interactor some draws at -ve coordinates but the @@ -173,7 +198,7 @@ (declare (type single-float range gmin gmax)) (when (and (and current-size (= (the single-float current-size) range)) (= min vmin) (> (- vmax vmin) (- max min))) - (return-from update-mswin-sbar)) + (return-from update-scroll-bar)) ;; The elevator size in 01 units - calculated from the contents (let* ((contents-range (float (- max min) 0.0s0)) (viewport-range (float (- vmax vmin) 0.0s0)) @@ -229,18 +254,7 @@ ;;-- It would be nice if we could do this at the point of scrolling #+foo (cerror "foo" "pos=~a size=~a min=~a max=~a vmin=~a vmax=~a contents-range=~a" pos size min max vmin vmax contents-range) - #+ignore - (let* ((line-scroll1 (line-scroll-amount - scroll-bar orientation :down) - #||(line-scroll-amount (slot-value scroll-bar 'client) - orientation nil)||#) - (line-scroll (if (zerop contents-range) - 0 ;-- Who knows - (* range (/ line-scroll1 contents-range))))) - (change-scroll-bar-values scroll-bar - :slider-size size - :value pos - :line-increment line-scroll))))))) + ))))) (defmethod contents-range ((scroller mswin-scroller-pane) orientation) @@ -395,7 +409,11 @@ (event scrollbar-event)) (deallocate-event event)) -(defvar *win-border-thick* 2) ;; ??? +;; The way this is used, it has to be the width of two borders. +;; If it is too small, then when you scroll, you will get +;; garbage pixels. JPM. +(defparameter *win-border-thick* 4) + ;; this used to be hardwired to 18 -tjm 17Jul97 (defun win-scroll-thick (x-or-y) (+ *win-border-thick* @@ -445,8 +463,7 @@ (resize-sheet child nwidth nheight) ;;; get the viewport sized correctly! (allocate-space child nwidth nheight))) - - -(eval-when (compile load eval) - (provide :climnt) - (setq excl::*enable-package-locked-errors* nil)) +(eval-when (compile load eval) + ;; 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/acl-widget.lisp b/aclpc/acl-widget.lisp index d65e6dcc02ed329289dffc350ba5b5dd56a92901..c9ae0754a738bd5c87b4f16087e2f67dae502f14 100644 --- a/aclpc/acl-widget.lisp +++ b/aclpc/acl-widget.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: acl-widget.lisp,v 1.9 1998/08/06 23:15:45 layer Exp $ #|**************************************************************************** * * @@ -26,13 +44,13 @@ (gadget acl-gadget-id-mixin)) (let (m) (when (setq m (sheet-direct-mirror gadget)) - (win::enablewindow m #+acl86win32 1 #-acl86win32 t)))) + (win:enablewindow m 1)))) (defmethod note-gadget-deactivated :after ((client t) (gadget acl-gadget-id-mixin)) (let (m) (when (setq m (sheet-direct-mirror gadget)) - (win::enablewindow m #+acl86win32 0 #-acl86win32 nil)))) + (win:enablewindow m 0)))) @@ -51,18 +69,18 @@ ; try without this sheet-mute-input-mixin space-requirement-mixin basic-pane) - ()) + () + (:default-initargs :background +white+)) (defmethod handle-event ((pane hlist-pane) ;; use window-change-event to workaround bug ;; with bad redirection of pointer-events - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) + (event window-change-event)) (let ((mirror (sheet-direct-mirror pane)) (index 0)) (when mirror - (setf index (win::sendmessage mirror win:lb_getcursel 0 0)) + (setf index (win:sendmessage mirror win:lb_getcursel 0 0)) (with-slots (items value mode value-key name-key) pane ;;mm: 11Jan95 - we need to invoke the callback so that list-pane-view ;; will return a value. @@ -137,17 +155,12 @@ (declare (ignore width height)) (with-slots (items name-key text-style visible-items initial-space-requirement) pane - (let (;;(name "") - (name-width 0) + (let ((name-width 0) (name-height 0) - ;;(index 0) (tsh 0) (iwid (or (space-requirement-width initial-space-requirement) 0)) (ihgt (or (space-requirement-height initial-space-requirement) 0)) - #+ignore - (vizlimit (and items visible-items (numberp visible-items) - (> (length items) visible-items))) - ) + ) (multiple-value-setq (name-width tsh) (compute-set-gadget-dimensions pane)) (setq name-height (* (if visible-items visible-items (max (length items) 1)) @@ -173,7 +186,7 @@ (depth :initarg :depth) (x-margin :initarg :x-margin) (y-margin :initarg :y-margin) - (default-window-procedure :initform (ct::callocate (:void *))) + (default-window-procedure :initform (ct:callocate (:void *))) ;; needed for text-editor (ncolumns :initarg :ncolumns :accessor gadget-columns) @@ -183,10 +196,14 @@ :accessor gadget-word-wrap)) (:default-initargs :text-style nil + :background +white+ :external-label nil :x-margin 2 :y-margin 0 ;; needed for text-editor - :ncolumns nil :nlines nil :editable-p t :word-wrap nil)) + :ncolumns nil + :nlines nil + :editable-p t + :word-wrap nil)) (defmethod handle-repaint ((pane mswin-text-edit) region) @@ -216,22 +233,23 @@ (let* ((p (sheet-parent pane)) (ext-label-width 0) (ext-label-height 0) - (tswid 0) - (tshgt 0) + (tswid 20) + (tshgt 20) (space-for-scrollbars (if (and (typep p 'silica::scroller-pane) (silica::scroller-pane-scroll-bar-policy p)) 2 0)) (iwid (or (space-requirement-width initial-space-requirement) 0)) (ihgt (or (space-requirement-height initial-space-requirement) 0))) - (with-sheet-medium (medium pane) - (multiple-value-setq (tswid tshgt) - (text-size medium "W" :text-style text-style))) + (when (port pane) + (with-sheet-medium (medium pane) + (multiple-value-setq (tswid tshgt) + (text-size medium "W" :text-style text-style)))) (if (numberp ncolumns) (setq iwid (max iwid (* (+ space-for-scrollbars ncolumns) tswid)))) (if (numberp nlines) (setq ihgt (max ihgt (* (+ space-for-scrollbars nlines) tshgt)))) - (when external-label + (when (and external-label (port pane)) (let ((text-style (slot-value pane 'text-style))) (with-sheet-medium (medium pane) (multiple-value-bind (w h) @@ -260,8 +278,7 @@ (let* ((ext-label-width 0) (ext-label-height 0) (iwid (or (space-requirement-width initial-space-requirement) 0)) - #+ignore - (ihgt (or (space-requirement-height initial-space-requirement) 0))) + ) (when external-label (let ((text-style (slot-value pane 'text-style))) (with-sheet-medium (medium pane) @@ -290,7 +307,7 @@ (let ((mirror (sheet-direct-mirror pane))) (declare (ignore mirror)) ;; Give up the focus - (win::setfocus (win::getactivewindow) #-acl86win32 :static))) + (win:setfocus (win:getactivewindow)))) (defmethod handle-event ((pane mswin-text-edit) (event window-change-event)) (let ((mirror (sheet-direct-mirror pane))) @@ -306,49 +323,42 @@ (focus-out-callback pane (gadget-client pane) (gadget-id pane))) (defun xlat-newline-return (str) - (let* ((subsize (length str)) - (nnl (let ((nl 0)) - (dotimes (i subsize) - (when (char= (char str i) #\Newline) - (incf nl))) - nl)) - (cstr (ct::callocate (:char *) :size (+ 1 nnl subsize))) - (pos 0)) - #+acl86win32 - (dotimes (i subsize) - (when (char= (char str i) #\Newline) - (ct::cset (:char 256) cstr ((fixnum pos)) (char-int #\Return)) + ;; Given a Lisp string, create an equivalent C string. + ;; Replace Newline with Return&Newline. + (if (not (find #\Newline str :test #'char=)) + (values str (length str)) + (let* ((subsize (length str)) + (nnl (let ((nl 0)) + (dotimes (i subsize) + (when (char= (char str i) #\Newline) + (incf nl))) + nl)) + (cstr (ct:callocate (:char *) :size (+ 1 nnl subsize))) + (pos 0)) + (dotimes (i subsize) + (when (char= (char str i) #\Newline) + (ct:cset (:char 256) cstr ((fixnum pos)) (char-int #\Return)) + (incf pos)) + (ct:cset (:char 256) cstr ((fixnum pos)) (char-int (char str i))) (incf pos)) - (ct::cset (:char 256) cstr ((fixnum pos)) (char-int (char str i))) - (incf pos)) - #+aclpc - (dotimes (i subsize) - (cond ((char= (char str i) #\Newline) - (ct::cset (:char *) cstr ((fixnum pos)) 13) - (incf pos) - (ct::cset (:char *) cstr ((fixnum pos)) 10) - (incf pos)) - (t (ct::cset (:char *) cstr ((fixnum pos)) (char-int (char str i))) - (incf pos)))) - ;; terminate with null - (ct::cset #+acl86win32 (:char 256) #+aclpc (:char *) cstr ((fixnum pos)) 0) - cstr)) + ;; terminate with null + (ct:cset (:char 256) cstr ((fixnum pos)) 0) + (values cstr pos)))) -;; pr Aug97 (defun unxlat-newline-return (str) + ;; Given a C string, create an equivalent Lisp string. + ;; Replace Return&Newline with Newline. (let* ((subsize (length str)) (nnl (let ((nl 0)) (dotimes (i subsize) - #+acl86win32 (when (char= (char str i) #\Return) (incf nl)) - #+aclpc (when (= (char-int (char str i)) 13) (incf nl))) + (when (char= (char str i) #\Return) (incf nl)) ) (- nl))) (cstr (make-string (+ nnl subsize))) (pos 0)) (dotimes (i subsize) - (unless #+acl86win32 (char= (char str i) #\Return) - #+aclpc (= (char-int (char str i)) 13) - (setf (char cstr pos) (char str i)) - (incf pos))) + (unless (char= (char str i) #\Return) + (setf (char cstr pos) (char str i)) + (incf pos))) cstr)) ;; added back with mods by pr 1May97 (from whence?) -tjm 23May97 @@ -370,11 +380,11 @@ (defmethod gadget-value ((pane mswin-text-edit)) (with-slots (mirror value) pane (if mirror ; else clause added - smh 26Nov96 - (let* ((wl (win::SendMessage mirror - win::WM_GETTEXTLENGTH - 0 0 #-acl86win32 :static)) + (let* ((wl (win:SendMessage mirror + win:WM_GETTEXTLENGTH + 0 0)) (teb (make-string wl)) - (tlen (win::GetWindowText mirror teb (1+ wl)))) + (tlen (win:GetWindowText mirror teb (1+ wl)))) (declare (ignorable tlen)) (setf teb (unxlat-newline-return teb)) ;; pr Aug97 (setf value teb) @@ -457,23 +467,19 @@ (height (pixmap-height pixmap)) (x (floor (- bwidth width) 2)) (y (floor (- bheight height) 2)) - (selected (logtest state win::ods_selected))) + (selected (logtest state win:ods_selected))) (when selected (incf x) (incf y)) - (win::DrawEdge hdc + (win:DrawEdge hdc rect (if selected - win::BDR_SUNKEN - win::BDR_RAISED) - (+ win::BF_RECT win::BF_MIDDLE)) - (win::bitblt hdc x y width height (acl-clim::pixmap-cdc pixmap) 0 0 + win:BDR_SUNKEN + win:BDR_RAISED) + (+ win:BF_RECT win:BF_MIDDLE)) + (win:bitblt hdc x y width height (acl-clim::pixmap-cdc pixmap) 0 0 (acl-clim::bop->winop op))))) -;; (method draw-picture-button (hbutton-pane t t t)) moved below defclass -;; for hbutton-pane - - ;; deallocate and pixmap associated with a picture button when it's ;; destroyed - this is the only note-sheet-degrafted method in the ;; aclpc directory - someone should check what other resources @@ -502,8 +508,7 @@ ;; use window-change-event to workaround bug ;; with bad redirection of pointer-events - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) + (event window-change-event)) ;; removed the armed test that came from db-button.lisp - not ;; applicable for built in gadgets - check for other gadget classes ;; (cim 9/17/96) @@ -553,17 +558,17 @@ (height (pixmap-height pixmap)) (x (floor (- bwidth width) 2)) (y (floor (- bheight height) 2)) - (selected (logtest state win::ods_selected))) + (selected (logtest state win:ods_selected))) (when selected (incf x) (incf y)) - (win::DrawEdge hdc + (win:DrawEdge hdc rect (if selected - win::BDR_SUNKEN - win::BDR_RAISED) - (+ win::BF_RECT win::BF_MIDDLE)) - (win::bitblt hdc x y width height (acl-clim::pixmap-cdc pixmap) 0 0 + win:BDR_SUNKEN + win:BDR_RAISED) + (+ win:BF_RECT win:BF_MIDDLE)) + (win:bitblt hdc x y width height (acl-clim::pixmap-cdc pixmap) 0 0 (acl-clim::bop->winop op))))) (defmethod compose-space ((pane hbutton-pane) &key width height) @@ -594,8 +599,7 @@ ;; use window-change-event to workaround bug ;; with bad redirection of pointer-events - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) + (event window-change-event)) ;; removed the armed test that came from db-button.lisp - not ;; applicable for built in gadgets - check for other gadget classes ;; (cim 9/17/96) @@ -609,190 +613,27 @@ ;;; clim\db-list (defclass acl-clim::winwidget-mixin () ()) -(defclass mswin-option-pane (option-pane hpbutton-pane - acl-clim::winwidget-mixin) - ((menu :initform nil)) - (:default-initargs - :pattern *right-triangle-button-pattern* - :mode :exclusive - :label "Choose" - :name-key #'(lambda (it) (princ-to-string it #+ignore (gadget-value it))))) - ;;; When an hbutton is set, update its checkmark appropriately. -#+(or aclpc acl86win32) (defmethod (setf gadget-value) :after (value (pane hbutton-pane) &key invoke-callback) (declare (ignore invoke-callback)) (with-slots (mirror) pane (when mirror ;;(break "About to set value of ~a to ~a." pane value) - (win::sendmessage mirror win::BM_SETCHECK (if value 1 0) 0 #-acl86win32 :static)))) - -;;; When items are set in an option-pane, the option-pane mirror must be -;;; made to update its appearance appropriately. -#+(or aclpc acl86win32) -(defmethod (setf set-gadget-items) :after (nitems (pane mswin-option-pane)) - (declare (ignore nitems)) - (with-slots (items name-key value-key test mode) pane - (let* ((frame (pane-frame pane)) - (framem (frame-manager frame)) - (buttons nil) - ;;(val (gadget-value pane)) - ) - ;; (break "adding options to pane") - ;; First of all destroy existing panes! +++ - ;; default is not set - (dolist (item items) - (with-look-and-feel-realization (framem frame) - (push (make-pane 'toggle-button - :value (ecase mode - (:exclusive - (funcall test (funcall value-key item) - (gadget-value pane))) - (:nonexclusive - (and (member (funcall value-key item) - (gadget-value pane) - :test test) - t))) - :label (funcall name-key item) - :id item - :client pane) - buttons))) - (setq buttons (nreverse buttons)) - (setq items (copy-list buttons)) ;save them away - (let ((menu (make-pull-down-menu :port (port frame)))) - (initialize-pull-down-menu menu buttons) - (setf (slot-value pane 'menu) menu))))) + (win:sendmessage mirror win:BM_SETCHECK (if value 1 0) 0)))) ;;; When items are set in an hlist-pane the mirror must be ;;; made to update its appearance appropriately. -#+(or aclpc acl86win32) (defmethod (setf set-gadget-items) :after (items (pane hlist-pane)) (with-slots (name-key mirror) pane (when mirror - (win:SendMessage mirror win:LB_RESETCONTENT 0 0 #-acl86win32 :static) + (win:SendMessage mirror win:LB_RESETCONTENT 0 0) (dolist (item items) (let ((str (acl-clim::nstringify (funcall name-key item))) (pos (position item items))) ;;(break "insert gadget item [~a @ ~a]" str pos) (win:SendMessage mirror win:LB_INSERTSTRING pos str))) - (win:InvalidateRect mirror ct::hnull win:true)))) ;; make sure it updates - -;;--- The idea is the the option pane itself is a pushbutton which, when -;;--- pressed, pops up a menu containing the options. -(defmethod initialize-instance :after ((pane mswin-option-pane) &key visible-items) - (declare (ignore visible-items)) - (with-slots (external-label label - items name-key value-key test mode) pane - ; (shiftf external-label label nil) - (let* ((frame (pane-frame pane)) - (framem (frame-manager frame)) - (buttons nil) - (val (gadget-value pane))) - (assert (and frame framem) () - "There must be both a frame and frame manager active") - (when (and val (eql mode :exclusive)) - (setf label (funcall name-key val))) - (with-look-and-feel-realization (framem frame) - (dolist (item items) - (push (make-pane 'toggle-button - :value (ecase mode - (:exclusive - (funcall test (funcall value-key item) (gadget-value pane))) - (:nonexclusive - (and (member (funcall value-key item) (gadget-value pane) :test test) - t))) - :label (funcall name-key item) ; was item - :id item - :client pane) - buttons)) - (setq buttons (nreverse buttons)) - (setq items (copy-list buttons)) ;save them away - (let ((menu (make-pull-down-menu :port (port frame)))) - (initialize-pull-down-menu menu buttons) - (setf (slot-value pane 'menu) menu)))))) - -(defmethod handle-event ((pane mswin-option-pane) - ;; use window-change-event to workaround bug - ;; with bad redirection of pointer-events - - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) - (with-slots (armed menu) pane - (when (eq armed :active) - (setf armed t) - (with-sheet-medium (medium pane) - (highlight-button pane medium)) - (choose-from-pull-down-menu menu pane)))) - -(defmethod (setf gadget-value) :after (value (pane mswin-option-pane) &key invoke-callback) - (declare (ignore invoke-callback)) - (with-slots (name-key mirror mode) pane - (when (and mirror - (eql mode :exclusive)) - (let ((str (acl-clim::nstringify (funcall name-key value)))) - (win:setWindowText mirror str))))) - -(defmethod value-changed-callback :around - ((selection toggle-button) (client mswin-option-pane) gadget-id value) - #-aclpc (declare (ignore gadget-id)) - (let ((subvert value)) - (with-slots (items value-key mode) client - (let ((real-value (funcall value-key (gadget-id selection))) - (old-selection nil)) - (ecase mode - (:exclusive - (setq old-selection (gadget-value client)) - (when (and old-selection (not (and value real-value))) - (let ((button - (find old-selection items - :key #'(lambda (val) - (funcall value-key (gadget-id val))) - :test #'equal))) - (setq subvert t) - (unless button - (cerror "never mind" "button not found ~a in ~a" old-selection items)) - (when button - (with-slots (mirror) button - (when mirror - (win:sendmessage mirror win:bm_setcheck 1 1))) - (setf (gadget-value button) t))) - ;(setf (gadget-value old-selection) t) - (setq real-value old-selection - value t - old-selection nil)) - (setf (gadget-value client) (and value real-value))) - (:nonexclusive - (if value - (pushnew real-value (gadget-value client)) - (setf (gadget-value client) (delete real-value (gadget-value client)))))) - ;;(setq *sel* selection) - ;;(setq *cl* client) - ;(if t ;(eql old-selection (gadget-value client)) - ; (cerror "do it" "old-selection=~a new=~a" old-selection (gadget-value client))) - (when old-selection - (let ((button - (find old-selection items - :key #'(lambda (val) - (funcall value-key (gadget-id val))) - :test #'equal))) - (when (null button) - (let (;;(*selection* selection) - ;;(*client* client) - ;;(*old-selection* old-selection) - ;;(*items* items) - ) - (cerror "never mind" "Button not found in options pane"))) - (when button - (with-slots (mirror) button - (when mirror - (win:sendmessage mirror win:bm_setcheck 0 0))) - (setf (gadget-value button :invoke-callback nil) nil)))) - (value-changed-callback - client (gadget-client client) (gadget-id client) (gadget-value client)))) - (call-next-method) - (with-slots (value) selection - (setf value subvert)))) + (win:InvalidateRect mirror ct:hnull win:true)))) ;; make sure it updates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Combo Box @@ -807,7 +648,8 @@ ; try without this sheet-mute-input-mixin space-requirement-mixin basic-pane) - ()) + () + (:default-initargs :background +white+)) (defmethod initialize-instance :after ((sheet mswin-combo-box-pane) &key visible-items) (declare (ignore visible-items)) @@ -822,7 +664,7 @@ (index 0)) (with-slots (items value mode value-key) pane (when (and mirror items) - (setf index (win::sendmessage mirror win:cb_getcursel 0 0)) + (setf index (win:sendmessage mirror win:cb_getcursel 0 0)) (setf (gadget-value pane :invoke-callback t) (funcall value-key (elt items index))))))) (defmethod (setf gadget-value) :after @@ -850,7 +692,7 @@ (multiple-value-setq (name-width tsh) (compute-set-gadget-dimensions pane)) ;; this specifies the regular size, not the dropped-down size - (setq name-height tsh #+ignore (* (+ 2 (length items)) tsh)) + (setq name-height tsh) (make-space-requirement :width (+ name-width 20) :height (+ name-height 7))))) @@ -876,13 +718,13 @@ left top right bottom) (fix-coordinates left top right bottom) (let* ((hwnd (sheet-mirror sheet)) - (height (* (+ 2 (win:sendMessage hwnd win::CB_GETCOUNT 0 0)) + (height (* (+ 2 (win:sendMessage hwnd win:CB_GETCOUNT 0 0)) ;; I'd have expected the wparam to be 0 here ;; according to the docs but this doesn't work ;; right (cim 9/25/96) - (win:sendMessage hwnd win::CB_GETITEMHEIGHT -1 0)))) - (win::setWindowPos hwnd - (ct::null-handle win:hwnd) ; we really want win:HWND_TOP + (win:sendMessage hwnd win:CB_GETITEMHEIGHT -1 0)))) + (win:setWindowPos hwnd + (ct:null-handle win:hwnd) ; we really want win:HWND_TOP left top (- right left) height #| (- bottom top) |# @@ -893,27 +735,54 @@ ;;; When items are set in an combo-pane the mirror must be ;;; made to update its appearance appropriately. -#+(or aclpc acl86win32) (defmethod (setf set-gadget-items) :after (items (pane mswin-combo-box-pane)) (with-slots (name-key mirror) pane (when mirror - (win:SendMessage mirror win:CB_RESETCONTENT 0 0 #-acl86win32 :static) + (win:SendMessage mirror win:CB_RESETCONTENT 0 0) (dolist (item items) (let ((str (acl-clim::nstringify (funcall name-key item))) (pos (position item items))) ;;(break "insert gadget item [~a @ ~a]" str pos) (win:SendMessage mirror win:CB_INSERTSTRING pos str))) ;; make sure it updates - (win:InvalidateRect mirror ct::hnull win:true) + (win:InvalidateRect mirror ct:hnull win:true) (note-sheet-region-changed pane)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; widget button Menu bars -(defclass mswin-menu-bar-pane (menu-bar) +;;; Windoz will not give you a menu bar anywhere but the +;;; top level. Period. To implement this, we have to +;;; use "non-native" menu bars. + +(defclass mswin-menu-bar-pane (menu-bar + sheet-permanently-enabled-mixin + space-requirement-mixin + sheet-single-child-mixin + basic-pane) ()) +(defmethod compose-space ((pane mswin-menu-bar-pane) &key width height) + (unless width (setq width 150)) + (unless height (setq height 25)) + (make-space-requirement + :width (max width 40) + :min-width 40 + :height (max height 25) + :min-height 25)) + +(defmethod allocate-space ((pane mswin-menu-bar-pane) width height) + (let ((child (sheet-child pane))) + (when child (move-and-resize-sheet child 0 0 width height)))) + +(defmethod initialize-instance :after ((object mswin-menu-bar-pane) + &rest options + &key command-table frame) + (when (and frame command-table) + (let ((inferiors (silica::compute-menu-bar-pane-1 frame command-table))) + (sheet-adopt-child object inferiors)))) + (defclass mswin-menu-bar-button (hpbutton-pane) ((next-menu :initform nil :initarg :next-menu))) @@ -928,34 +797,30 @@ (event pointer-exit-event)) (with-slots (armed next-menu) pane (when armed - (setf armed nil))) -) - + (setf armed nil)))) (defmethod handle-event ((pane mswin-menu-bar-button) - (event pointer-button-press-event)) + (event window-change-event)) (with-slots (armed next-menu) pane (with-sheet-medium (medium pane) (declare (ignore medium)) (when armed (setf armed :active)) - (if (typep next-menu 'pull-down-menu) - (choose-from-pull-down-menu next-menu pane) - (activate-callback pane (gadget-client pane) (gadget-id pane))) + (let ((choice + (menu-choose next-menu :associated-window pane))) + (when choice + (apply #'queue-command pane choice))) (setf armed t) ))) -(defmethod handle-event ((pane mswin-menu-bar-button) - ;; use window-change-event to workaround bug - ;; with bad redirection of pointer-events - - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) - (with-slots (armed) pane - (when (and (eq armed :active)) - (with-sheet-medium (medium pane) - (declare (ignore medium)) - (setf armed t) - )))) +(defun queue-command (button command command-table) + (let ((frame (pane-frame button))) + (distribute-event + (port button) + (allocate-event 'presentation-event + :frame frame + :sheet (frame-top-level-sheet frame) + :presentation-type `(command :command-table ,command-table) + :value command)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; scroll-bar @@ -995,7 +860,7 @@ (setf (sheet-native-transformation sheet) (sheet-native-transformation (sheet-parent sheet))) (setf (silica::gadget-id->window sheet gadget-id) window) - (win::showWindow window win::sw_show) + (win:showWindow window win:sw_show) (setf (sheet-direct-mirror sheet) window) ; needed only to initialize (change-scroll-bar-values sheet) ; initialize window))) @@ -1017,8 +882,6 @@ :width (* 2 x) :max-width +fill+))))) -(in-package :silica) - (defmethod change-scroll-bar-values ((sb mswin-scroll-bar) &key slider-size @@ -1031,27 +894,31 @@ (unless slider-size (setq slider-size (scroll-bar-size sb))) (unless value (setq value (gadget-value sb))) (multiple-value-bind (min max) (gadget-range* sb) - (let* ((scrollinfo-struct (ct:ccallocate win::scrollinfo)) - (win-id win::SB_CTL) ; a control (decoupled from other panes) + (let* ((scrollinfo-struct (ct:ccallocate win:scrollinfo)) + (win-id win:SB_CTL) ; a control (decoupled from other panes) (range (- max min)) (win-size (floor (* acl-clim::*win-scroll-grain* - (/ slider-size (+ range slider-size))))) + ;; Don't divide zero by zero + (if (zerop slider-size) slider-size + (/ slider-size (+ range slider-size)))))) (win-pos (floor (* (- acl-clim::*win-scroll-grain* slider-size) - (/ (- value min) (- range slider-size)))))) - (ct::csets - win::scrollinfo scrollinfo-struct - win::cbSize (ct:sizeof win::scrollinfo) + ;; Don't divide zero by zero + (if (= value min) 0 + (/ (- value min) (- range slider-size))))))) + (ct:csets + win:scrollinfo scrollinfo-struct + win::cbSize (ct:sizeof win:scrollinfo) win::fMask #.(logior - win::SIF_PAGE - win::SIF_POS - 1 ;win::SIF_RANGE - win::SIF_DISABLENOSCROLL) + win:SIF_PAGE + win:SIF_POS + 1 ;win:SIF_RANGE + win:SIF_DISABLENOSCROLL) win::nMin 0 win::nMax acl-clim::*win-scroll-grain* win::nPage win-size win::nPos win-pos) - (win::SetScrollInfo (sheet-mirror sb) win-id scrollinfo-struct t)))))) + (win:SetScrollInfo (sheet-mirror sb) win-id scrollinfo-struct t)))))) (defmethod (setf gadget-value) :after (nv (gadget mswin-scroll-bar) &key invoke-callback) @@ -1122,8 +989,7 @@ ;; use window-change-event to workaround bug ;; with bad redirection of pointer-events - ;; see comment in silica/event.lisp (cim 9/17/96) - (event #+ignore pointer-button-release-event - #-ignore window-change-event)) + (event window-change-event)) (with-slots (armed) pane (when (eq armed :active) (setf armed t) @@ -1132,10 +998,7 @@ (throw 'exit-pull-down-menu (values))))) (defun winhandle-equal (x y) - (cond (#+acl86win32 nil - #-acl86win32 - (and (typep x 'win:lhandle) - (typep y 'win:lhandle)) + (cond (nil (eql (ct:lhandle-value x) (ct:lhandle-value y))) (t (equal x y)))) @@ -1158,9 +1021,8 @@ (defun choose-from-pull-down-menu (menu &optional button &key cascade-p) (let ((menu-frame (pane-frame menu)) (event-queue (sheet-event-queue menu)) - #+(or aclpc acl86win32) (mirror (sheet-mirror menu))) - (when #-(or aclpc acl86win32) button - #+(or aclpc acl86win32) (and acl-clim::*generic-gadgets* button) + (mirror (sheet-mirror menu))) + (when (and acl-clim::*generic-gadgets* button) (with-bounding-rectangle* (bleft btop bright bbottom) (sheet-device-region button) (declare (ignore bright)) @@ -1177,12 +1039,8 @@ (move-sheet (frame-top-level-sheet menu-frame) (+ bleft fleft 4) (+ bbottom ftop 23)))))) - #+(or aclpc acl86win32) (when (and (not acl-clim::*generic-gadgets*) button) - (let (#+ignore - (mirror (sheet-mirror button)) - #+ignore - (tls (sheet-mirror (get-top-level-sheet button)))) + (let () (multiple-value-bind (bleft btop bright bbottom) (acl-clim::mirror-native-edges* acl-clim::*acl-port* button) @@ -1205,7 +1063,7 @@ ;; Wait for an event and then handle it ;; make sure that the pulldown has the focus - (win::setFocus mirror #-acl86win32 :static) + (win:setFocus mirror) (setf (acl-clim::acl-port-mirror-with-focus acl-clim::*acl-port*) mirror) @@ -1231,8 +1089,6 @@ (handle-event (event-sheet event) event))))))) (disable-frame menu-frame)))) -;;;(win::setFocus (sheet-direct-mirror stream) #-acl86win32 :static) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; slider fixes @@ -1337,12 +1193,12 @@ (defmethod adjust-gadget-colors (pane hdc) (let* ((bg (color->wincolor (pane-background pane))) (fg (color->wincolor (pane-foreground pane))) - (new-brush (win::createSolidBrush bg)) + (new-brush (win:createSolidBrush bg)) (old-brush *background-brush*)) - (win::setBkColor hdc bg) - (win::setTextColor hdc fg) + (win:setBkColor hdc bg) + (win:setTextColor hdc fg) (when old-brush - (win::deleteObject old-brush)) + (win:deleteObject old-brush)) (setq *background-brush* new-brush) new-brush)) @@ -1360,7 +1216,7 @@ ;; explicit text-style is given. (cim 10/14/96) (defmethod get-sheet-resources :around ((port acl-port) - (sheet silica::acl-gadget-id-mixin)) + (sheet t)) (or *windows-system-text-style* (setq *windows-system-text-style* #+ignore @@ -1376,11 +1232,78 @@ (let ((resources (call-next-method))) `(:text-style ,*windows-system-text-style* ,@resources))))) -(in-package :silica) - (defmethod standardize-text-style ((port basic-port) style &optional (character-set *standard-character-set*)) (standardize-text-style-1 port style character-set acl-clim::*acl-logical-size-alist*)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Outlined-pane + +(defclass mswin-outlined-pane (silica::acl-gadget-id-mixin + mirrored-sheet-mixin + outlined-pane) + () + (:default-initargs :thickness 2)) + +(defun outline-open (parent left top width height) + (let ((winstyle + (logior win:WS_CHILD + win:WS_CLIPCHILDREN + win:WS_CLIPSIBLINGS)) + (exstyle win:WS_EX_CLIENTEDGE) + (window nil)) + (setq window + (win:createWindowEx exstyle + *clim-class* + *win-name* + winstyle + left top width height + (or parent 0) + 0 ; menu + *hinst* + (symbol-name (gensym)) )) + (when (zerop window) + (or (check-last-error "CreateWindowEx") + (error "CreateWindowEx: unknown error"))) + window)) + +(defmethod realize-mirror ((port acl-port) + (sheet mswin-outlined-pane)) + (multiple-value-bind (left top right bottom) + (sheet-native-region* sheet) + (fix-coordinates left top right bottom) + (let* ((parent (sheet-mirror sheet)) + (window nil) + (width (- right left)) + (height (- bottom top)) + (gadget-id (silica::allocate-gadget-id sheet))) + (setq window + (outline-open parent left top width height)) + (setf (sheet-native-transformation sheet) + (sheet-native-transformation (sheet-parent sheet))) + (setf (silica::gadget-id->window sheet gadget-id) window) + (win:showWindow window win:sw_show) + (setf (sheet-direct-mirror sheet) window) + window))) + +(defmethod handle-repaint ((pane mswin-outlined-pane) region) + (declare (ignore region)) + nil) + +(defmethod compose-space ((pane mswin-outlined-pane) &key width height) + (let ((thickness (slot-value pane 'silica::thickness)) + (child (sheet-child pane))) + (space-requirement+ + (compose-space child :width width :height height) + (make-space-requirement + :width (* 2 thickness) + :height (* 2 thickness))))) + +(defmethod allocate-space ((pane mswin-outlined-pane) width height) + (let ((thickness (slot-value pane 'silica::thickness))) + (move-and-resize-sheet + (sheet-child pane) + 0 0 + (- width (* 2 thickness)) (- height (* 2 thickness))))) diff --git a/aclpc/climpat.lisp b/aclpc/climpat.lisp index 2d50a012644afcd292a5945f8a6aa972c897cec9..fffc1188999c690e5b38a87be317095b2e7e19b7 100644 --- a/aclpc/climpat.lisp +++ b/aclpc/climpat.lisp @@ -1,3 +1,21 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: climpat.lisp,v 1.2 1998/08/06 23:15:46 layer Exp $ #|**************************************************************************** * * @@ -9,7 +27,6 @@ * * ****************************************************************************|# - (in-package :clim-internals) diff --git a/aclpc/pkgdcl.lisp b/aclpc/pkgdcl.lisp index 78a4b924a0b3cf2d3b03aa34626cf7f04f436547..06037ae6ff5a358ce8e07e247d3f21816331980a 100644 --- a/aclpc/pkgdcl.lisp +++ b/aclpc/pkgdcl.lisp @@ -1,7 +1,27 @@ ;;; -*- Mode: Lisp; Package: CL-USER -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: pkgdcl.lisp,v 1.3 1998/08/06 23:15:46 layer Exp $ (in-package :common-lisp-user) +(defvar *lock-preference* excl:*enable-package-locked-errors*) + ;; Invite everybody to the party. (eval-when (compile load eval) (require :climg) @@ -11,8 +31,10 @@ ;;(require :for) ; for FOR macro (require :winapi) (require :winapi-dev) - (load "user32.dll") - (setq excl::*enable-package-locked-errors* nil) + (load "user32.dll") + + ;; Turn this off as long as clim-utils is a locked package. + (setq excl:*enable-package-locked-errors* nil) ) (defpackage acl-clim diff --git a/aclpc/sysdcl.lisp b/aclpc/sysdcl.lisp index a4755e6cad25d6af1ed577daea35407aee73ed09..6722550878b9ac3b99f8d0cfd9755a04d68406c6 100644 --- a/aclpc/sysdcl.lisp +++ b/aclpc/sysdcl.lisp @@ -1,4 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl.lisp,v 1.4 1998/08/06 23:15:46 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) @@ -30,8 +48,6 @@ (:default-pathname "clim2:;aclpc;") (:serial clim-standalone - ;;"winapi" - ;;"cgapi" "pkgdcl" "winwidgh" "climpat" @@ -44,7 +60,8 @@ "acl-pixmaps" "acl-frames" "acl-widget" - "acl-scroll")) + "acl-scroll" + ("clim2:;utils;last"))) #+Genera (clim-defsys:import-into-sct 'aclpc-clim diff --git a/aclpc/winwidgh.lisp b/aclpc/winwidgh.lisp index c39644397bcf82e6b710608630d43cee7dab2e38..f54bb02c9cfa1f4efd14025cc9d64d0e730e94c9 100644 --- a/aclpc/winwidgh.lisp +++ b/aclpc/winwidgh.lisp @@ -1,163 +1,76 @@ ;;; -*- Package: win; mode: Common-Lisp -*- - -(in-package :win) - -#+ignore -(eval-when (compile load eval) - (defmacro defsystemcall (name &key entry-point arguments return-type - arg-checking call-direct - (release-heap :when-ok)) - (if (constantp arguments) (setq arguments (eval arguments))) - (setq arguments - (if arguments - (mapcar #'(lambda (type) - (list (gensym) - (cond ((eq type t) :int) - ((eq type 'integer) :int) - ((eq type 'fixnum) :int) - (type)))) - arguments) - '(:void))) - (if (constantp name) (setq name (eval name))) - (setq return-type - (case return-type - (:integer :int) - (:unsigned-integer :unsigned-int) - (otherwise return-type))) - `(ff:def-foreign-call (,name ,entry-point) ,arguments - :returning ,return-type - :call-direct ,call-direct - :arg-checking ,arg-checking - :release-heap ,release-heap))) - -#+ignore -(defsystemcall 'createpen - :entry-point "CreatePen" - :arguments '(integer integer integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'createpopupmenu - :entry-point "CreatePopupMenu" - :arguments '() - :return-type :unsigned-integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'createrectrgn - :entry-point "CreateRectRgn" - :arguments '(integer integer integer integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'createsolidbrush - :entry-point "CreateSolidBrush" - :arguments '(integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'getactivewindow - :entry-point "GetActiveWindow" - :arguments '() - :return-type :unsigned-integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'getdc - :entry-point "GetDC" - :arguments '(integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'getlasterror - :entry-point "GetLastError" - :arguments '() - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'getversion - :entry-point "GetVersion" - :arguments '() - :return-type :unsigned-integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'lineto - :entry-point "LineTo" - :arguments '(integer fixnum fixnum) - :return-type :boolean - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'movetoex - :entry-point "MoveToEx" - :arguments '(integer integer integer integer) - :return-type :boolean - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'releasedc - :entry-point "ReleaseDC" - :arguments '(integer fixnum) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'selectobject - :entry-point "SelectObject" - :arguments '(integer integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -#+ignore -(defsystemcall 'setrop2 - :entry-point "SetROP2" - :arguments '(integer integer) - :return-type :integer - :arg-checking nil - :call-direct t) - -(eval-when (compile load eval) - (export '( - LBS_DISABLENOSCROLL - HLN_SELCHANGE - CB_SETTOPINDEX - ) - 'windows)) - - - +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: winwidgh.lisp,v 1.3 1998/08/06 23:15:46 layer Exp $ + +(in-package :acl-clim) + +;; These seem to be missing from winapi-dev (defconstant LBS_DISABLENOSCROLL #x1000) (defconstant HLN_SELCHANGE #x1) (defconstant CB_SETTOPINDEX #x015c) - -#+ignore -(def-foreign-type scrollinfo - (:struct (cbSize uint) - (fMask uint) - (nMin int) - (nMax int) - (nPage uint) - (nPos int) - (nTrackPos int))) - -#+ignore -(ct:defctype lpscrollinfo (scrollinfo *)) +(ff:def-foreign-type browseinfo + (:struct (hwndOwner win:hwnd) + (pidlRoot win:long #+ig win:lpcitemidlist) + (pszDisplayName win:lpstr) + (lpszTitle win:lpcstr) + (ulflags win:uint) + (lpfn (* :void) #+ig win:bffcallback) + (lparam win:lparam) + (iImage :int))) + +(ff:def-foreign-call (SHBrowseForFolder "SHBrowseForFolder") + ((info browseinfo)) + :returning :int + :release-heap :when-ok) + +(ff:def-foreign-call (FormatMessage "FormatMessageA") + ((flags :int) (source :int) (messageid :int) + (languageid :int) (buffer :int) + (size :int) (arguments :int)) + :arg-checking nil + :returning :int) + +;; This should be equivalent to win:createpen but not cons. +(ff:def-foreign-call (CreatePen "CreatePen") + ((flags :int) (source :int) (color :int)) + :arg-checking nil + :call-direct t + :returning :int) + +;; This should be equivalent to win:createrectrgn but not cons. +(ff:def-foreign-call (CreateRectRgn "CreateRectRgn") + ((left :int) (top :int) (right :int) (bottom :int)) + :arg-checking nil + :call-direct t + :returning :int) + +;; This should be equivalent to win:getdc but not cons. +(ff:def-foreign-call (GetDC "GetDC") + ((window :int)) + :arg-checking nil + :call-direct t + :returning :int) + +;; This should be equivalent to win:selectobject but not cons. +(ff:def-foreign-call (SelectObject "SelectObject") + ((a :int) (b :int)) + :arg-checking nil + :call-direct t + :returning :int) diff --git a/buildclim.cl b/buildclim.cl index c15ad8922277ceeb4c5aecec8312c216331e859e..3a8208399c3df027f7e088b908da3cacb918093d 100644 --- a/buildclim.cl +++ b/buildclim.cl @@ -1,5 +1,5 @@ ;; Load this file to make a clim image. -;; $Id: buildclim.cl,v 1.3 1998/05/19 18:50:20 layer Exp $ +;; $Id: buildclim.cl,v 1.4 1998/08/06 23:15:36 layer Exp $ (excl:generate-application #+ics "climi" #-ics "clim" @@ -18,7 +18,6 @@ ) :autoload-warning nil :image-only t - :print-startup-message :default :purify t :debug-on-error t :internal-debug "buildclim.out" diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp index e7fc73bc4b8e868244ba03833e7e26fca16b963c..5d97c613583f07beaec8f882ab0e85bc9ed3247b 100644 --- a/clim/accept-values.lisp +++ b/clim/accept-values.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/accept-values.lisp,v 1.83 1998/05/19 18:50:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: accept-values.lisp,v 1.84 1998/08/06 23:15:49 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; For historical reasons "AVV" means "accepting-values"... diff --git a/clim/accept.lisp b/clim/accept.lisp index 832bc23a7aaa16687799ce1e6828ebbf48fa39b6..bb89c6848df1e8e1ab7c4cfdf147c42cc800e8c0 100644 --- a/clim/accept.lisp +++ b/clim/accept.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/accept.lisp,v 1.28 1998/05/19 18:50:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: accept.lisp,v 1.29 1998/08/06 23:15:50 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (defun accept (type &rest accept-args &key (stream *standard-input*) diff --git a/clim/activities.lisp b/clim/activities.lisp index e9cf034bdc21c6f3102160b7e1283298f17df4b5..64a3b37950b2181b837f2504ac24b1d9693b05bd 100644 --- a/clim/activities.lisp +++ b/clim/activities.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/activities.lisp,v 1.16 1998/05/19 18:50:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: activities.lisp,v 1.17 1998/08/06 23:15:50 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved." ;;; Activities diff --git a/clim/basic-translators.lisp b/clim/basic-translators.lisp index 7a18e6bac0c3dc0cc48ff68e2d5454bbb03e287c..19b81e03d4e67f2aa0c62391720840dc4b4bf737 100644 --- a/clim/basic-translators.lisp +++ b/clim/basic-translators.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/basic-translators.lisp,v 1.22 1998/05/19 18:50:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: basic-translators.lisp,v 1.23 1998/08/06 23:15:50 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;; The translator that normally runs. (define-presentation-translator identity diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp index 3a5f177650c445e80ea5bca399bb9dcb5f5502b0..1de87f60c8906f3a5e4e5cdf6612c587e0880c54 100644 --- a/clim/clim-defs.lisp +++ b/clim/clim-defs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/clim-defs.lisp,v 1.27 1998/05/19 18:50:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clim-defs.lisp,v 1.28 1998/08/06 23:15:50 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;; POSITIONS is a list of pairs of numbers. ;; No assumptions are made about the types of the numbers. diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp index ad50c5af828d0380237d35e35bc7ef1e6e06b1a5..0ede9fb1516c83f83f688b081c4dd988b4f83bd3 100644 --- a/clim/command-processor.lisp +++ b/clim/command-processor.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/command-processor.lisp,v 1.27 1998/05/19 18:50:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: command-processor.lisp,v 1.28 1998/08/06 23:15:50 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (defparameter *command-dispatchers* '(#\:)) @@ -766,6 +782,13 @@ (let ((*command-parser* command-parser) (*command-unparser* command-unparser) (*partial-command-parser* partial-command-parser)) + ;; spr16572: Due to the identity translator, it is possible to + ;; click on anything that has been presented as a command, including + ;; disabled commands, commands from other command tables, and lists + ;; that aren't even funcallable. This problem may be rooted in the + ;; design of the identity translator and all the cures I have tried + ;; create much bigger problems. + ;; JPM 5/27/98. (values (accept `(command :command-table ,command-table) :stream stream :prompt nil))))) diff --git a/clim/command.lisp b/clim/command.lisp index 56716716d17c3bf00f5426d3b8e111cd896f3ddb..2c514bad95f94ce7a9999bdddd5fe488c413229a 100644 --- a/clim/command.lisp +++ b/clim/command.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/command.lisp,v 1.32 1998/05/19 18:50:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: command.lisp,v 1.33 1998/08/06 23:15:51 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Command objects diff --git a/clim/completer.lisp b/clim/completer.lisp index 61e730f6681d4da1d829c18aa0514d008b631fce..232ca576e9f4df754fa92cf4487a9c3463b54292 100644 --- a/clim/completer.lisp +++ b/clim/completer.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/completer.lisp,v 1.18 1998/05/19 18:50:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: completer.lisp,v 1.19 1998/08/06 23:15:51 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;; VECTOR must be adjustable... (defun extend-vector (vector token) diff --git a/clim/coordinate-sorted-set.lisp b/clim/coordinate-sorted-set.lisp index dfcfa23da58d5ee63f5e25ac4a44a89cdcc94f27..c3c2306cda20b31a4bf0572d684a5c4d3295561f 100644 --- a/clim/coordinate-sorted-set.lisp +++ b/clim/coordinate-sorted-set.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/coordinate-sorted-set.lisp,v 1.12 1998/05/19 18:50:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: coordinate-sorted-set.lisp,v 1.13 1998/08/06 23:15:51 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;;; The output record generics: ;;; output-record-children: (record) diff --git a/clim/cursor.lisp b/clim/cursor.lisp index fca62b555f82fc53cdbca306af304bbd2ca01869..073e04226383ee5c3de7da278389717896a0f266 100644 --- a/clim/cursor.lisp +++ b/clim/cursor.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/cursor.lisp,v 1.30 1998/05/19 18:50:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: cursor.lisp,v 1.31 1998/08/06 23:15:51 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved. - Portions copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This is the for the abstract cursor protocol (define-protocol-class cursor ()) diff --git a/clim/db-list.lisp b/clim/db-list.lisp index acdf5d8dd6f01408189fbec1527f135d9bfadebd..e43fb1db2a43cab1cbb5d49f5489a6d01a44304f 100644 --- a/clim/db-list.lisp +++ b/clim/db-list.lisp @@ -1,8 +1,24 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-list.lisp,v 1.8 1998/08/06 23:15:51 layer Exp $ -;; $Header: /repo/cvs.copy/clim2/clim/db-list.lisp,v 1.7 1998/05/19 18:50:29 layer Exp $ - -"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends @@ -170,6 +186,26 @@ ((menu :initform nil)) (:default-initargs :pattern *right-triangle-button-pattern*)) +#+(or aclpc acl86win32) +(defmacro initialize-pull-down-menu (menu &body buttons) + (assert (= (length buttons) 1)) + `(with-look-and-feel-realization () + (setf (pull-down-menu-buttons ,menu) ,@buttons) + (sheet-adopt-child ,menu (make-pane 'vbox-pane + :contents (pull-down-menu-buttons ,menu) + :spacing 0)) + (layout-frame (pane-frame ,menu)) + ,menu)) + +#+(or aclpc acl86win32) +(defun make-pull-down-menu (&key port) + (let ((frame + (make-application-frame + 'pull-down-menu-frame + :frame-manager (find-frame-manager :port port) + :save-under t))) + (values (slot-value frame 'menu) frame))) + ;;--- The idea is the the option pane itself is a pushbutton which, when ;;--- pressed, pops up a menu containing the options. #+(or aclpc acl86win32) diff --git a/clim/db-menu.lisp b/clim/db-menu.lisp index 9bb4ac175a368b3281628f72026abf20c0d08e77..47127383427cffc2f9632b6e8ed59fb2e94bc926 100644 --- a/clim/db-menu.lisp +++ b/clim/db-menu.lisp @@ -1,8 +1,24 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/db-menu.lisp,v 1.10 1998/05/19 18:50:30 layer Exp $ - -"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-menu.lisp,v 1.11 1998/08/06 23:15:52 layer Exp $ + +;;;"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends @@ -205,7 +221,7 @@ (plusp (pointer-event-y event))) (setf (pull-down-menu-entered pane) t))) -#-(or aclpc acl86win32) +#+broken (defmethod handle-event ((pane pull-down-menu) (event pointer-exit-event)) ;; Don't punt if we've never entered the menu, or if we are entering ;; one of the buttons within the menu @@ -217,94 +233,6 @@ (defmethod handle-event :after ((pane pull-down-menu) (event pointer-event)) (deallocate-event event)) - -;;; Interface to pull-down menus - -#+(or aclpc acl86win32) -(define-application-frame pull-down-menu-frame () - (menu) - (:pane - (with-slots (menu) *application-frame* - (outlining () - (setq menu (make-pane 'pull-down-menu - :width 100 :height 100))))) - (:menu-bar nil)) - -#+(or aclpc acl86win32) -(defun make-pull-down-menu (&key port) - (let ((frame (make-application-frame 'pull-down-menu-frame - :frame-manager (find-frame-manager :port port) - :save-under t))) - (values (slot-value frame 'menu) frame))) - -;; Pull-down menus share their event queue with the owning application -#+(or aclpc acl86win32) -(defresource pull-down-menu (port) - :constructor (make-pull-down-menu :port port) - :matcher (eq (port pull-down-menu) port) - :deinitializer - (progn - (setf (pull-down-menu-buttons pull-down-menu) nil) - (setf (pull-down-menu-entered pull-down-menu) nil) - (dolist (child (sheet-children pull-down-menu)) - (sheet-disown-child pull-down-menu child)))) - -#+(or aclpc acl86win32) -(defmacro initialize-pull-down-menu (menu &body buttons) - (assert (= (length buttons) 1)) - `(with-look-and-feel-realization () - (setf (pull-down-menu-buttons ,menu) ,@buttons) - (sheet-adopt-child ,menu (make-pane 'vbox-pane - :contents (pull-down-menu-buttons ,menu) - :spacing 0)) - (layout-frame (pane-frame ,menu)) - ,menu)) - -#-(or aclpc acl86win32) -(defvar *subsidiary-pull-down-menu* nil) -#-(or aclpc acl86win32) -(defun choose-from-pull-down-menu (menu &optional button &key cascade-p) - (let ((menu-frame (pane-frame menu)) - (event-queue (sheet-event-queue menu))) - (when button - (with-bounding-rectangle* (bleft btop bright bbottom) - (sheet-device-region button) - (declare (ignore bright)) - (multiple-value-bind (fleft ftop fright fbottom) - (let ((tls (get-top-level-sheet button))) - (mirror-region* (port tls) tls)) - (declare (ignore fright fbottom)) - (if cascade-p - (let ((pattern-width (pattern-width (slot-value button 'normal-pattern))) - (button-x-margin (slot-value button 'x-margin))) - (move-sheet (frame-top-level-sheet menu-frame) - (+ bleft fleft pattern-width button-x-margin -16) - (+ btop ftop))) - (move-sheet (frame-top-level-sheet menu-frame) - (+ bleft fleft 10) - (+ bbottom ftop -10)))))) - (enable-frame menu-frame) - ;; Share the event queue with the application frame - (setf (sheet-event-queue (frame-top-level-sheet (pane-frame menu))) - (sheet-event-queue (frame-top-level-sheet *application-frame*))) - ;; Ensure no surprise exit events - (setf (pull-down-menu-entered menu) nil) - ;; Wait for an event and then handle it - (unwind-protect - (flet ((waiter () - (not (queue-empty-p event-queue)))) - #-Allegro (declare (dynamic-extent #'waiter)) - (catch (if *subsidiary-pull-down-menu* - '|Not exit-pull-down-menu| - 'exit-pull-down-menu) - (let ((*subsidiary-pull-down-menu* t)) - (loop - (port-event-wait (port menu) #'waiter - :wait-reason "Pull Down Menu" :timeout 2) - (let ((event (queue-get event-queue))) - (handle-event (event-sheet event) event)))))) - (disable-frame menu-frame)))) - ;;--- Kludge alert #+(or aclpc acl86win32) (defun get-top-level-sheet (pane) @@ -316,33 +244,33 @@ ;;; Menu bars #+(or aclpc acl86win32) -(defclass menu-bar-pane (menu-bar) - ()) - +(defclass menu-bar-pane (menu-bar) ()) ;;mm: add this to allow multiple functions to value of command-table slot -#+(or aclpc acl86win32) (defun default-command-table-p (command-table) (and command-table (not (or (listp command-table) (typep command-table 'command-table))))) ;;--- What about when the command menu tick changes? ;;--- What about graying of disabled commands? -#+(or aclpc acl86win32) (defun compute-menu-bar-pane (frame command-table) - (let* ((text-style (and (listp command-table) - (getf (cdr command-table) :text-style) - `(:text-style ,(getf (cdr command-table) :text-style)))) - (command-table (if (listp command-table) (car command-table) command-table))) - (when ;;mm was:(eq command-table 't) - ;; command-table arg comes from menu-bar slot of frame - ;; and may be NIL T=menu-hbox-pane command-table-arg - (default-command-table-p command-table) + (outlining () + (setf (slot-value frame 'menu-bar) + (compute-menu-bar-pane-1 frame command-table)))) + +(defun compute-menu-bar-pane-1 (frame command-table) + ;; Returns an hbox-pane containing a row of buttons. + (let* ((command-table + (if (listp command-table) (car command-table) command-table))) + (when (default-command-table-p command-table) + ;;mm was:(eq command-table 't) + ;; command-table arg comes from menu-bar slot of frame + ;; and may be NIL T=menu-hbox-pane command-table-arg (setq command-table (frame-command-table frame))) (with-look-and-feel-realization ((frame-manager frame) frame) (labels - ((make-command-table-buttons (command-table top-level) - (let ((buttons nil)) + ((make-command-table-menu (command-table) + (let ((choices nil)) (map-over-command-table-menu-items #'(lambda (menu keystroke item) (declare (ignore keystroke)) @@ -350,73 +278,34 @@ (value (command-menu-item-value item))) (case type (:command - (push - (apply - #'make-pane - (if top-level - 'push-button - #+(or aclpc acl86win32) 'pull-down-button-logic - #-(or aclpc acl86win32) 'pull-down-menu-button) - :label menu - :activate-callback - #'(lambda (button) - (menu-bar-command-callback - button command-table value)) - text-style) - buttons)) - (:function - ;;--- Do something about this + (push `(,menu :value + (,value ,command-table)) + choices)) + (:function ;--- Do something about this ) - (:menu - (push (apply #'make-pane - (if top-level - #-(or aclpc acl86win32) 'menu-bar-button - #+(or aclpc acl86win32) 'menu-bar-button-logic - #+(or aclpc acl86win32) 'pull-down-button-logic - #-(or aclpc acl86win32) 'pull-down-menu-button) - :label menu - :next-menu (make-command-table-menu value nil) - :activate-callback nil - text-style) - buttons)) - (:divider - (unless top-level - ;;--- Do something about this - ))))) + (:menu + (push (list menu :items + (make-command-table-menu value)) + choices)) + (:divider + (push (list nil :type :divider) choices))))) command-table) - (nreverse buttons))) - (make-command-table-menu (command-table top-level) - (let ((buttons (make-command-table-buttons command-table top-level))) - (if top-level - #-(or ACLPC acl86win32) - (outlining () - (make-pane 'hbox-pane :contents buttons)) - ;;mm: We need to remember the ultimate menu-bar pane so that - ;; we can resize if all the buttons are dropped, or we go - ;; from no buttons to some. - #+(or ACLPC acl86win32) - (outlining () - (setf (slot-value frame 'menu-bar) - (make-pane 'hbox-pane :contents buttons - :min-height 2 :height 2))) - (let ((menu (make-pull-down-menu :port (port frame)))) - (initialize-pull-down-menu menu buttons) - menu))))) - (declare (dynamic-extent #'make-command-table-buttons #'make-command-table-menu)) - (make-command-table-menu command-table t))))) - - -#+(or aclpc acl86win32) -(defun menu-bar-command-callback (button command-table command) - (let ((frame (pane-frame button))) - (distribute-event - (port button) - (allocate-event 'presentation-event - :frame frame - :sheet (frame-top-level-sheet frame) - :presentation-type `(command :command-table ,command-table) - :value command)))) - - - - + (nreverse choices))) + (make-menubar-buttons (command-table) + (let ((buttons + (mapcar #'(lambda (menu) + (let ((name (first menu)) + (kind (second menu)) + (value (third menu))) + (if (eq kind :items) + (make-pane 'menu-bar-button-logic + :label name + :next-menu value) + (error "not yet implemented") + ))) + (make-command-table-menu command-table)))) + (make-pane 'hbox-pane :contents buttons + :min-height 2 :height 2)))) + (declare (dynamic-extent #'make-command-table-menu + #'make-menubar-buttons)) + (make-menubar-buttons command-table))))) diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp index 8877a75f286baaef1c485691c933a0a1b3d0d645..6234ce18798b73c4c3e32f1aaf30408d234d2ff3 100644 --- a/clim/db-stream.lisp +++ b/clim/db-stream.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/db-stream.lisp,v 1.67 1998/03/21 01:54:57 smh Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-stream.lisp,v 1.68 1998/08/06 23:15:52 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990 by International Lisp Associates. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990 by International Lisp Associates. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 Symbolics, Inc. All rights reserved." ;;; CLIM stream sheets and panes diff --git a/clim/db-text.lisp b/clim/db-text.lisp index 71ca47daccd5c3796beec5326af63c9aec9214ad..e67191742a3dbaeadfa32ae77590437bd652e2f5 100644 --- a/clim/db-text.lisp +++ b/clim/db-text.lisp @@ -1,8 +1,24 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/db-text.lisp,v 1.10 1998/05/19 18:50:30 layer Exp $ - -"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-text.lisp,v 1.11 1998/08/06 23:15:52 layer Exp $ + +;;;"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends diff --git a/clim/default-frame.lisp b/clim/default-frame.lisp index 4d33d5913a67bc7af2fe5835c10cd93ae2a7156f..64b2bee80d1ff3dd0e99758c03176ef0ca6db1bd 100644 --- a/clim/default-frame.lisp +++ b/clim/default-frame.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/default-frame.lisp,v 1.10 1998/05/19 18:50:30 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: default-frame.lisp,v 1.11 1998/08/06 23:15:52 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; The default application frame diff --git a/clim/defprotocol.lisp b/clim/defprotocol.lisp index ebc9c0d1eeea87556894dc739721ccc5e4e7414e..aeab474903abf786f2e44619d42148e3e65bde13 100644 --- a/clim/defprotocol.lisp +++ b/clim/defprotocol.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/defprotocol.lisp,v 1.9 1998/05/19 18:50:30 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defprotocol.lisp,v 1.10 1998/08/06 23:15:52 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." (defvar *stream-protocols* nil) diff --git a/clim/defresource.lisp b/clim/defresource.lisp index 54997329118be7bf9debb2adabd0b65a2ea4a457..7f4dc991a594cf4dfd392ca6e0752eec22a9f7fe 100644 --- a/clim/defresource.lisp +++ b/clim/defresource.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/defresource.lisp,v 1.14 1998/05/19 18:50:30 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defresource.lisp,v 1.15 1998/08/06 23:15:52 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." (defstruct (resource-descriptor (:conc-name rd-) #+Allegro (:print-function print-resource) diff --git a/clim/design-recording.lisp b/clim/design-recording.lisp index a99147c8c6b5bdc38b864ef86c129d7b2a6dd54a..2ceaaac31c7f52d3eac89fa018e9c9aa8a64a5cc 100644 --- a/clim/design-recording.lisp +++ b/clim/design-recording.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/design-recording.lisp,v 1.6 1998/05/19 18:50:30 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: design-recording.lisp,v 1.7 1998/08/06 23:15:53 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Designs meet output records @@ -47,6 +63,9 @@ ;; Clips INK to the inside of DESIGN. (apply #'draw-design design stream :ink ink args)))) +(defun nyi () + (error "This internal CLIM operation is NYI (Not Yet Implemented).")) + (defmethod draw-design ((composite composite-out) stream &rest args &key ink &allow-other-keys) (declare (dynamic-extent args)) (with-slots ((designs clim-utils::designs)) composite diff --git a/clim/drag-and-drop.lisp b/clim/drag-and-drop.lisp index 75a58106b8de7b6029e6b9e030b4ccb5ebf5be33..765f0734a60f040b27348c791c5ebee2b3a967b0 100644 --- a/clim/drag-and-drop.lisp +++ b/clim/drag-and-drop.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/drag-and-drop.lisp,v 1.18 1998/05/19 18:50:30 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: drag-and-drop.lisp,v 1.19 1998/08/06 23:15:53 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Direct manipulation ("click and drag", "drag and drop") translators diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp index 9cdaf7703cffe7a0e58c1008bb1cd47dcf924cc2..4ebe4543620308e715f9b7d7a032e45a5551295e 100644 --- a/clim/dragging-output.lisp +++ b/clim/dragging-output.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/dragging-output.lisp,v 1.15 1998/05/19 18:50:31 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: dragging-output.lisp,v 1.16 1998/08/06 23:15:53 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (defparameter *dragging-output-finish-on-release* nil) diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp index da4ff33be52a9c4999035ce74081ad51c205874b..647ddea2ae214c8bc948584eab90d95ee767e247 100644 --- a/clim/excl-presentations.lisp +++ b/clim/excl-presentations.lisp @@ -1,10 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -20,10 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; - -;; $Header: /repo/cvs.copy/clim2/clim/excl-presentations.lisp,v 1.20 1998/05/19 18:50:31 layer Exp $ - - +;; $Id: excl-presentations.lisp,v 1.21 1998/08/06 23:15:55 layer Exp $ (in-package :clim-internals) diff --git a/clim/formatted-output-defs.lisp b/clim/formatted-output-defs.lisp index b9dde53a7a62a5e6e0439180c5419b8cc2b42b78..40a337928519167329f162957a913c7d3744b3f9 100644 --- a/clim/formatted-output-defs.lisp +++ b/clim/formatted-output-defs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/formatted-output-defs.lisp,v 1.11 1998/05/19 18:50:31 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: formatted-output-defs.lisp,v 1.12 1998/08/06 23:15:55 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; We want to evaluate the user's :RECORD-TYPE option, right? (defmacro formatting-table ((&optional stream diff --git a/clim/frames.lisp b/clim/frames.lisp index 84294977ac65cf6ea8fee358271ac7c80dbd2e76..fdcd458376426a5f3bd8c1c20608c20635dcbc0d 100644 --- a/clim/frames.lisp +++ b/clim/frames.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/frames.lisp,v 1.89 1998/05/19 18:50:33 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: frames.lisp,v 1.90 1998/08/06 23:15:56 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (define-protocol-class application-frame ()) @@ -472,12 +488,6 @@ (if (frame-resizable frame) (values) (bounding-rectangle-size (frame-top-level-sheet frame)))) - #+acl86win32 ;; spr16580, port-trace-thing was getting mangled - (let ((port (port frame))) - (when port - (let ((port-trace-thing (silica::port-trace-thing port))) - (when port-trace-thing - (setf (fill-pointer port-trace-thing) 0))))) ;;--- Don't throw, just recompute stream bindings in a principled way (setf (sheet-enabled-p sheets) t)) (note-frame-layout-changed (frame-manager frame) frame) @@ -1170,6 +1180,7 @@ ;;; This is the wrong modularity... Bury calls in commands for acl case later. ;;;-- pr Aug97 (defmacro with-menu-disabled (frame &body body) + #-acl86win32 (declare (ignore frame)) #+(or aclpc acl86win32) `(unwind-protect (progn (enable-menu-items ,frame nil) ,@body) diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp index 648958d6472fb05529deaec28635f1e30ae72de5..a3a2ca2edb1003bd9812a289b73cdee91bc30930 100644 --- a/clim/gadget-output.lisp +++ b/clim/gadget-output.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/gadget-output.lisp,v 1.63 1998/05/19 18:50:34 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: gadget-output.lisp,v 1.64 1998/08/06 23:15:56 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; Implementation of output-records that are tied to gadgets. diff --git a/clim/gestures.lisp b/clim/gestures.lisp index fba436da8990d08b6f8dcb1ed2e3aeabab426299..b9aefd3cfc482ed4af6f06824e28ac8853046e81 100644 --- a/clim/gestures.lisp +++ b/clim/gestures.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/gestures.lisp,v 1.26 1998/05/19 18:50:34 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: gestures.lisp,v 1.27 1998/08/06 23:15:56 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;;; The implementation layer constructs a modifier key mask to go along with each ;;; pointer gesture, e.g., Shift-Left. diff --git a/clim/graph-formatting.lisp b/clim/graph-formatting.lisp index 7838ba526ecd3dd10f3991fe9d22275a4a01ed61..dcb9cf3257e2ef66c170450926b1f503f1b04484 100644 --- a/clim/graph-formatting.lisp +++ b/clim/graph-formatting.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/graph-formatting.lisp,v 1.35 1998/05/19 18:50:34 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: graph-formatting.lisp,v 1.36 1998/08/06 23:15:56 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved." (defvar *graph-type-record-type-alist* nil) diff --git a/clim/graphics-recording.lisp b/clim/graphics-recording.lisp index 39874b65a7360ca33be9f2319b961a31d32522c8..909bd3955dc7f87d5b628d77fa28c78091f4a6ce 100644 --- a/clim/graphics-recording.lisp +++ b/clim/graphics-recording.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/graphics-recording.lisp,v 1.31 1998/05/19 18:50:34 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: graphics-recording.lisp,v 1.32 1998/08/06 23:15:57 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (defmacro define-graphics-recording (name medium-components &key bounding-rectangle diff --git a/clim/histories.lisp b/clim/histories.lisp index 0ddc691b2040c7372fbbf4c498f2fd689c7dc9d0..ad42fef049ddf581a3db55a88e2dc4e87f3d0197 100644 --- a/clim/histories.lisp +++ b/clim/histories.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/histories.lisp,v 1.21 1998/05/19 18:50:34 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: histories.lisp,v 1.22 1998/08/06 23:15:57 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Basic histories diff --git a/clim/incremental-redisplay.lisp b/clim/incremental-redisplay.lisp index bb353dc4b211c3e5dde2ad45edba7b863bfc3b46..6cb251cfd52102734c61dabeb5a49b613009f50c 100644 --- a/clim/incremental-redisplay.lisp +++ b/clim/incremental-redisplay.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/incremental-redisplay.lisp,v 1.24 1998/05/19 18:50:35 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: incremental-redisplay.lisp,v 1.25 1998/08/06 23:15:57 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; The incremental redisplay protocol: diff --git a/clim/input-defs.lisp b/clim/input-defs.lisp index 4a990c44206cf411d8028e2cebbc010b5616af11..c82a32793ebeaa558542704fbb04fbbb3a1db7df 100644 --- a/clim/input-defs.lisp +++ b/clim/input-defs.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/input-defs.lisp,v 1.23 1998/05/19 18:50:35 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: input-defs.lisp,v 1.24 1998/08/06 23:15:57 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." ;;; Pointers and pointer events diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp index 048815d751cdac45217a91ed73abfe2ef8ca2bfa..6e0ea638e213f226d166056e40cba6ce697a921a 100644 --- a/clim/input-editor-commands.lisp +++ b/clim/input-editor-commands.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/input-editor-commands.lisp,v 1.36 1998/05/19 18:50:35 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: input-editor-commands.lisp,v 1.37 1998/08/06 23:15:58 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Define some useful input editor commands. For now, all these are defined ;;; on INPUT-EDITING-STREAM-MIXIN rather than on our specific implementation of diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp index 2cd094ab808f842c8d0e8e8c182755f5e9809be1..04e956b28206810d02a2137abd4efd550d5e91df 100644 --- a/clim/input-protocol.lisp +++ b/clim/input-protocol.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/input-protocol.lisp,v 1.52 1998/05/19 18:50:35 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: input-protocol.lisp,v 1.53 1998/08/06 23:15:58 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; This file implements our extended input protocol on top of the ;;; proposed "standard" protocol defined in CL-STREAMS.LISP. diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp index e6164a5913275ee45bd76999a58b8fd6becd149e..9ce742551a47e64ea05d88d520328f5b404c820c 100644 --- a/clim/interactive-defs.lisp +++ b/clim/interactive-defs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/interactive-defs.lisp,v 1.29 1998/05/19 18:50:36 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: interactive-defs.lisp,v 1.30 1998/08/06 23:15:58 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;; For communication through parsers to lower levels. (defvar *input-wait-test* nil) diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp index 451ea430ca64b11b3872493ade20564d96ae0a32..1f328e74c26b9a31e6f47ecc772ed3f531fcf333 100644 --- a/clim/interactive-protocol.lisp +++ b/clim/interactive-protocol.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/interactive-protocol.lisp,v 1.38 1998/05/19 18:50:36 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: interactive-protocol.lisp,v 1.39 1998/08/06 23:15:58 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; This file implements our input editing stream protocol on top of the ;;; proposed "standard" protocol defined in CL-STREAMS.LISP. diff --git a/clim/item-list-manager.lisp b/clim/item-list-manager.lisp index 220bb2ae0cf6491e13a234ddbe855dc92e9da653..dfaa46b5e9ff1367a1699f9e5f3bca66f39f334a 100644 --- a/clim/item-list-manager.lisp +++ b/clim/item-list-manager.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/item-list-manager.lisp,v 1.6 1998/05/19 18:50:36 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: item-list-manager.lisp,v 1.7 1998/08/06 23:15:58 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." (defclass item-list-manager () ((item-list :initarg :item-list :accessor ilm-item-list) diff --git a/clim/japanese-input-editor.lisp b/clim/japanese-input-editor.lisp index 83b8db9dd438c05835b7d101cf53a09bd86cbdc8..0d6cdb5fe6bcc1993af301b7c8e596321c6c874b 100644 --- a/clim/japanese-input-editor.lisp +++ b/clim/japanese-input-editor.lisp @@ -1,7 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -14,12 +13,10 @@ ;; Use, duplication, and disclosure of the software, data and information ;; contained herein by any agency, department or entity of the U.S. ;; Government are subject to restrictions of Restricted Rights for -;; Commercial Software developed at private expense as specified in FAR -;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as -;; applicable. +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; - -;; $Header: /repo/cvs.copy/clim2/clim/japanese-input-editor.lisp,v 1.5 1998/05/19 18:50:36 layer Exp $ +;; $Id: japanese-input-editor.lisp,v 1.6 1998/08/06 23:15:59 layer Exp $ (in-package :clim-internals) diff --git a/clim/logical-gestures.lisp b/clim/logical-gestures.lisp index eb75e6bbe72ba4a72a0f2e24c2908097c26178f0..475631a6f2de3bb63cf7f929f1b3ed0d9f4061b3 100644 --- a/clim/logical-gestures.lisp +++ b/clim/logical-gestures.lisp @@ -1,7 +1,6 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,12 +16,12 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/clim/logical-gestures.lisp,v 1.7 1998/05/19 18:50:36 layer Exp $ - +;; $Id: logical-gestures.lisp,v 1.8 1998/08/06 23:15:59 layer Exp $ +;; (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." ;;; a logical-gesture-name is a symbol that is not eq to a defined keysym or a ;;; defined shift. diff --git a/clim/lucid-after.lisp b/clim/lucid-after.lisp index 545e1f2d84ba862e2e88c2109b604583609f31a8..2c1f6da47cce174d3139797cc47ad2e37819aea6 100644 --- a/clim/lucid-after.lisp +++ b/clim/lucid-after.lisp @@ -22,7 +22,7 @@ (in-package :lucid) -;;; $Header: /repo/cvs.copy/clim2/clim/lucid-after.lisp,v 1.5 1998/05/19 18:50:36 layer Exp $ +;;; $Id: lucid-after.lisp,v 1.6 1998/08/06 23:15:59 layer Exp $ ;;; Workaround for a disksave/hash bug. ;;; (defun rehash-ptypes () diff --git a/clim/menus.lisp b/clim/menus.lisp index 1d2bf3a79fdf4f55ac78c16cb0a5a3c177fc5272..727da2276a25ebfbdff2763b4342ef2a8add6fbd 100644 --- a/clim/menus.lisp +++ b/clim/menus.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/menus.lisp,v 1.52 1998/05/19 18:50:37 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: menus.lisp,v 1.53 1998/08/06 23:16:00 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (defvar *abort-menus-when-buried* t) @@ -380,20 +396,6 @@ ;; 2) Using that type to find a printer for PRESENT purposes ;; 3) Presenting a different set of choices based on the type, or graying over things ;; that are of different types. See example below -#+acl86win32 -(defun input-wait-test (menu) - ;; Wake up if the menu becomes buried, or if highlighting - ;; is needed. - ;;--- This screws up in Allegro because querying the server - ;;--- in the wait function screws event handling. - ;; on nt there is no server round trip so - ;; it's safe to check window-visibility - ;; (cim 9/16/96) - (or #-(and Allegro (not acl86win32)) - (and *abort-menus-when-buried* - (not (window-visibility menu))) - (pointer-motion-pending menu))) - (defun menu-choose-from-drawer (menu presentation-type drawer &key x-position y-position cache unique-id (id-test #'equal) @@ -460,8 +462,7 @@ (let ((*pointer-documentation-output* pointer-documentation)) (with-input-context (presentation-type :override T) (object type gesture) - (labels (#-acl86win32 - (input-wait-test (menu) + (labels ((input-wait-test (menu) ;; Wake up if the menu becomes buried, or if highlighting ;; is needed. ;;--- This screws up in Allegro because querying the server @@ -470,34 +471,30 @@ ;; on nt there is no server round trip so ;; it's safe to check window-visibility ;; (cim 9/16/96) - (or #-(and Allegro (not acl86win32)) - (and *abort-menus-when-buried* + (or (and *abort-menus-when-buried* (not (window-visibility menu))) (pointer-motion-pending menu))) (input-wait-handler (menu) ;; Abort if the menu becomes buried - #-(and Allegro (not acl86win32)) (when (and *abort-menus-when-buried* (not (window-visibility menu))) (return-from menu-choose-from-drawer nil)) ;; Take care of highlighting (highlight-presentation-of-context-type menu))) - #-Allegro (declare (dynamic-extent #'input-wait-test #'input-wait-handler)) ;; Await exposure before going any further, since X can get ;; to the call to READ-GESTURE before the menu is visible. (when *abort-menus-when-buried* #-Silica (wait-for-window-exposed menu)) (with-mouse-grabbed-in-window (menu) - #+(or aclpc acl86win32) (beep menu) (loop - #+(or aclpc acl86win32); fix for menu aborting - (unless (window-visibility menu) - (return-from menu-choose-from-drawer nil)) (read-gesture :stream menu :input-wait-test #'input-wait-test :input-wait-handler #'input-wait-handler) - #-(or aclpc acl86win32) (beep menu)))) + ;; Silly user typed a character at a window. + ;; Admonish now. + #+ignore + (beep menu)))) (t (values object gesture))))) (unless leave-menu-visible (setf (window-visibility menu) nil)) diff --git a/clim/noting-progress.lisp b/clim/noting-progress.lisp index d1d0ff13aecfa6f10c9d6450876017155b1c3b33..f6b709218af2531616b8413c1004a3d35bc19788 100644 --- a/clim/noting-progress.lisp +++ b/clim/noting-progress.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/noting-progress.lisp,v 1.11 1998/05/19 18:50:37 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: noting-progress.lisp,v 1.12 1998/08/06 23:16:00 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." (defvar *progress-notes* ()) diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp index bd9bd2be01b89ae08eb6c34d6a4f0a1d707be250..0c2b46203c93f8fe939241b594e62aab173196d2 100644 --- a/clim/output-protocol.lisp +++ b/clim/output-protocol.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/output-protocol.lisp,v 1.47 1998/05/19 18:50:37 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: output-protocol.lisp,v 1.48 1998/08/06 23:16:01 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; This file implements our extended output protocol on top of the ;;; proposed "standard" protocol defined in cl-streams.lisp. @@ -214,10 +230,14 @@ (defmethod stream-force-output ((stream output-protocol-mixin)) - (medium-force-output (sheet-medium stream))) + (let ((medium (sheet-medium stream))) + ;; null medium is a transient initial state we should tolerate. + (when medium (medium-force-output medium)))) (defmethod stream-finish-output ((stream output-protocol-mixin)) - (medium-finish-output (sheet-medium stream))) + (let ((medium (sheet-medium stream))) + ;; null medium is a transient initial state we should tolerate. + (when medium (medium-finish-output medium)))) (defmethod stream-terpri ((output-stream output-protocol-mixin)) (stream-write-char output-stream #\Newline) diff --git a/clim/panes.lisp b/clim/panes.lisp index 026440399eb09e224d434c2e7d4a405093c1dbdd..89c692fe50ea281ab22234d9d4f99ab3fec40968 100644 --- a/clim/panes.lisp +++ b/clim/panes.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/panes.lisp,v 1.4 1998/05/19 18:50:37 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: panes.lisp,v 1.5 1998/08/06 23:16:01 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (defun compute-pane-constructor-code (panes) (check-type panes list) diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp index 960c39d017ec4c0d3555284b55c244a75051ce87..b57f0b4557e64881e8903c5a99ab9ae597ad1e1f 100644 --- a/clim/pixmap-streams.lisp +++ b/clim/pixmap-streams.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/pixmap-streams.lisp,v 1.26 1998/05/19 18:50:37 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: pixmap-streams.lisp,v 1.27 1998/08/06 23:16:01 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1992 Franz, Inc. All rights reserved." ;;; CLIM pixmap streams diff --git a/clim/prefill.lisp b/clim/prefill.lisp index 4bef53542dea7740646de95a7ff56468852860d1..8b78f232e806af69450f991580f4142f75481f05 100644 --- a/clim/prefill.lisp +++ b/clim/prefill.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/prefill.lisp,v 1.18 1998/03/21 01:55:01 smh Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: prefill.lisp,v 1.19 1998/08/06 23:16:02 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This file prefills generic function dispatch caches at load time so that ;;; there won't be so much delay starting things up the first time the application diff --git a/clim/present.lisp b/clim/present.lisp index 425262ba3d48e7efa3f118cbafc1016c97e32c19..c89c232081e7dfb312b5f984ee7426ec8c834c3f 100644 --- a/clim/present.lisp +++ b/clim/present.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/present.lisp,v 1.16 1998/05/19 18:50:38 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: present.lisp,v 1.17 1998/08/06 23:16:02 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (defun present (object &optional (presentation-type (presentation-type-of object)) &rest present-args diff --git a/clim/presentations.lisp b/clim/presentations.lisp index 06bf4571a63a39ec21a2f9917695264b8d7e5c54..5c11c1201920d70d5380f412ddbac4265c1650c1 100644 --- a/clim/presentations.lisp +++ b/clim/presentations.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/presentations.lisp,v 1.24 1998/05/19 18:50:38 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: presentations.lisp,v 1.25 1998/08/06 23:16:03 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (define-protocol-class presentation ()) diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp index 7bc6cad9e88b6ad61f15a3c73de5ba049ed4450e..1398359237a642076d0c25b8df0267a615d0c298 100644 --- a/clim/ptypes1.lisp +++ b/clim/ptypes1.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/ptypes1.lisp,v 1.29 1998/05/19 18:50:38 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: ptypes1.lisp,v 1.30 1998/08/06 23:16:03 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This file contains the substrate for presentation types diff --git a/clim/ptypes2.lisp b/clim/ptypes2.lisp index bd056cd0ab364db7cbe576d3b9f9aaaa01519e6c..8637057bab9d5559c49ba973269db889e887846a 100644 --- a/clim/ptypes2.lisp +++ b/clim/ptypes2.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/ptypes2.lisp,v 1.28 1998/05/19 18:50:38 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: ptypes2.lisp,v 1.29 1998/08/06 23:16:03 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This file contains portions of the presentation type implementation that ;;; cannot be compiled until PTYPES1.LISP is loaded diff --git a/clim/r-tree.lisp b/clim/r-tree.lisp index 1fdad4a6a1c54e2e01fb7d2695ce298f6e95c783..ae229bd479162dc31ca0afec56f4c564f8ae320b 100644 --- a/clim/r-tree.lisp +++ b/clim/r-tree.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/r-tree.lisp,v 1.7 1998/05/19 18:50:39 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: r-tree.lisp,v 1.8 1998/08/06 23:16:04 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; R tree output records diff --git a/clim/recording-defs.lisp b/clim/recording-defs.lisp index 9cc5e38767bf602bb0e8aca77e281dbff1095c81..23c7fb2e7e62cac76dbc9b36a5014f443d79fbbd 100644 --- a/clim/recording-defs.lisp +++ b/clim/recording-defs.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/recording-defs.lisp,v 1.6 1998/05/19 18:50:39 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: recording-defs.lisp,v 1.7 1998/08/06 23:16:04 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;; The protocol class for an object that obeys the output record protocol, ;; that is, can hold output record elements diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp index 641155f2f6a8157a005f4f1f7425a6a4e3e37451..257ec70406b88e6b24d7b0551110b1285eee3884 100644 --- a/clim/recording-protocol.lisp +++ b/clim/recording-protocol.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/recording-protocol.lisp,v 1.42 1998/05/19 18:50:39 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: recording-protocol.lisp,v 1.43 1998/08/06 23:16:04 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; A mix-in for classes that can be stored by other output records diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp index c5a8382e5d555bda9d0f445bd5e55e82dd2a398d..7d48b7a634160559e4fb66e099c17fb09781ce2d 100644 --- a/clim/standard-types.lisp +++ b/clim/standard-types.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/standard-types.lisp,v 1.39 1998/05/19 18:50:40 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: standard-types.lisp,v 1.40 1998/08/06 23:16:04 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This file contains the standard, canned presentation types diff --git a/clim/stream-class-defs.lisp b/clim/stream-class-defs.lisp index 657dd6d365cdc390e5671f3625dacfc727019276..486bb42b0b0e168ede550673c3d5037f128d9ece 100644 --- a/clim/stream-class-defs.lisp +++ b/clim/stream-class-defs.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/stream-class-defs.lisp,v 1.16 1998/05/19 18:50:40 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: stream-class-defs.lisp,v 1.17 1998/08/06 23:16:04 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." ;; It's not really theoretically right to define these methods on ;; STANDARD-ENCAPSULATING-STREAM, but since window streams obey the bounding diff --git a/clim/stream-defprotocols.lisp b/clim/stream-defprotocols.lisp index 534d78115f54e01ebe58de9521c7ee8352f48b8b..69c456b33c08f958ed43a0011e37ad4b12694ea0 100644 --- a/clim/stream-defprotocols.lisp +++ b/clim/stream-defprotocols.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/stream-defprotocols.lisp,v 1.18 1998/05/19 18:50:40 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: stream-defprotocols.lisp,v 1.19 1998/08/06 23:16:05 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;;; Fundamental input diff --git a/clim/stream-trampolines.lisp b/clim/stream-trampolines.lisp index 2c64060ba1e529e9872007d8314bc3ce885d9d94..3b239fa48b6ef794db999a4adccb94ce7567f67c 100644 --- a/clim/stream-trampolines.lisp +++ b/clim/stream-trampolines.lisp @@ -1,9 +1,25 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/stream-trampolines.lisp,v 1.6 1998/05/19 18:50:40 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: stream-trampolines.lisp,v 1.7 1998/08/06 23:16:05 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." (generate-stream-protocol-trampolines) diff --git a/clim/surround-output.lisp b/clim/surround-output.lisp index e7a0615a4a8859805251df876b9199d077e67bfa..ef1bb54c61b8e26b7e1727e67dacb6552951e8f2 100644 --- a/clim/surround-output.lisp +++ b/clim/surround-output.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/surround-output.lisp,v 1.15 1998/05/19 18:50:41 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: surround-output.lisp,v 1.16 1998/08/06 23:16:05 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (defvar *border-shape-drawer-alist* nil) diff --git a/clim/table-formatting.lisp b/clim/table-formatting.lisp index 0fe16da9280fa07b3165055e085a4d06d0431bcc..56c0d80591f276bbf0f6e291f094ba46d6953a42 100644 --- a/clim/table-formatting.lisp +++ b/clim/table-formatting.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/table-formatting.lisp,v 1.24 1998/05/19 18:50:41 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: table-formatting.lisp,v 1.25 1998/08/06 23:16:06 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;;; Tables diff --git a/clim/temp-strings.lisp b/clim/temp-strings.lisp index febcc4be94550662e93972f74c082e08dd69e296..05875aac6dbba86d13c822180fea97e1b2456261 100644 --- a/clim/temp-strings.lisp +++ b/clim/temp-strings.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/temp-strings.lisp,v 1.10 1998/05/19 18:50:41 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: temp-strings.lisp,v 1.11 1998/08/06 23:16:06 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1988, 1989, 1990 International Lisp Associates. All rights reserved." ;;; A specific facility for temporary strings. This could be replaced by ;;; a general STACK-LET facility if we write something like that. diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp index cc985e7d73582e97866e3da018b9289a189ca424..0843da52eec3ed9e59b5d581f8d0cf59f02d197f 100644 --- a/clim/text-formatting.lisp +++ b/clim/text-formatting.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/text-formatting.lisp,v 1.18 1998/05/19 18:50:41 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: text-formatting.lisp,v 1.19 1998/08/06 23:16:06 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved." ;;; Filling output @@ -152,12 +168,14 @@ continuation &rest continuation-args) (declare (dynamic-extent continuation continuation-args)) (let ((stream (slot-value filling-stream 'stream)) + #+(or aclpc acl86win32) (fill-width (slot-value filling-stream 'fill-width)) + #+(or aclpc acl86win32) (buffer (slot-value filling-stream 'buffer))) ;; Flush the current line buffer -#-(or aclpc acl86win32) + #-(or aclpc acl86win32) (filling-stream-write-buffer filling-stream t) -#+(or aclpc acl86win32) + #+(or aclpc acl86win32) (progn (stream-write-string stream buffer) (setf (fill-pointer buffer) 0) diff --git a/clim/text-recording.lisp b/clim/text-recording.lisp index b813692e9c7a8dc3ed2346f1a97a88f5d69dc13b..043e6e3b9d8d989490222ca661217940918fda4e 100644 --- a/clim/text-recording.lisp +++ b/clim/text-recording.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/text-recording.lisp,v 1.23 1998/05/19 18:50:41 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: text-recording.lisp,v 1.24 1998/08/06 23:16:06 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; Text line output recording. A stream which does text output creates one of ;;; these per line of text. Lines are delimited by either #\RETURNs or by diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp index c1bccc923fc150a0d4b02b30ec4a17e7dc1799e2..1d373c976c939c8b7def290868d5553af31309b8 100644 --- a/clim/tracking-pointer.lisp +++ b/clim/tracking-pointer.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/tracking-pointer.lisp,v 1.22 1998/05/19 18:50:42 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: tracking-pointer.lisp,v 1.23 1998/08/06 23:16:06 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (eval-when (compile load eval) diff --git a/clim/translators.lisp b/clim/translators.lisp index 0f739dbf3bd7c4b7c7d07e1b4dc8b2f1775371d3..6b5dc1840c8547e4f6205e42848ca54afe18d706 100644 --- a/clim/translators.lisp +++ b/clim/translators.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/translators.lisp,v 1.17 1998/05/19 18:50:42 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: translators.lisp,v 1.18 1998/08/06 23:16:07 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Presentation Translators. diff --git a/clim/view-defs.lisp b/clim/view-defs.lisp index 0c180f1d6d02f1a6ccc6d7822492f1ba83dad5de..d009bf3500055212b462ca74b4499eba7ae61717 100644 --- a/clim/view-defs.lisp +++ b/clim/view-defs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/view-defs.lisp,v 1.18 1998/05/19 18:50:42 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: view-defs.lisp,v 1.19 1998/08/06 23:16:07 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved." ;; VIEW protocol class diff --git a/clim/window-stream.lisp b/clim/window-stream.lisp index 8f8937277c01624a2df8ad17d5898dff824742b7..59ba786440ffe37d9befc1c13abf17cb0d68297f 100644 --- a/clim/window-stream.lisp +++ b/clim/window-stream.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clim/window-stream.lisp,v 1.16 1998/05/19 18:50:42 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: window-stream.lisp,v 1.17 1998/08/06 23:16:07 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (defclass console () diff --git a/cloe/cloe-activities.lisp b/cloe/cloe-activities.lisp index d4559645366a63718c617dab3c7b55dcdbc854b1..1a644453151f854bb29663d28d6738c5854a0683 100644 --- a/cloe/cloe-activities.lisp +++ b/cloe/cloe-activities.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-activities.lisp,v 1.4 1997/02/05 01:45:49 tomj Exp $ +;; $Id: cloe-activities.lisp,v 1.5 1998/08/06 23:16:11 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-dc.lisp b/cloe/cloe-dc.lisp index cabfe11aae8ed70e3200e39736d3780328729e51..3aed9c003a8c5a111eefea9dd0fdbfd39a53af37 100644 --- a/cloe/cloe-dc.lisp +++ b/cloe/cloe-dc.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-dc.lisp,v 1.4 1997/02/05 01:45:51 tomj Exp $ +;; $Id: cloe-dc.lisp,v 1.5 1998/08/06 23:16:13 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-frames.lisp b/cloe/cloe-frames.lisp index cce3a560bd6e441ce9afe69ec0678bb804b9eab6..a332d309730a6de0d8031eed5216f3b01ce64e10 100644 --- a/cloe/cloe-frames.lisp +++ b/cloe/cloe-frames.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-frames.lisp,v 1.5 1997/02/05 01:45:53 tomj Exp $ +;; $Id: cloe-frames.lisp,v 1.6 1998/08/06 23:16:13 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-gadgets.lisp b/cloe/cloe-gadgets.lisp index b78677771d8cf9b64f2e435609d548ce598d2423..6bbfe5226583eecdf4f21bdd4ea3a6473962b5f0 100644 --- a/cloe/cloe-gadgets.lisp +++ b/cloe/cloe-gadgets.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-gadgets.lisp,v 1.3 1997/02/05 01:45:55 tomj Exp $ +;; $Id: cloe-gadgets.lisp,v 1.4 1998/08/06 23:16:13 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-implementation.lisp b/cloe/cloe-implementation.lisp index 1927c5308ddfae574386792c2f6d01854336a37c..988a81ce85d9caacacc7c259e1f8a5eb5071dcb5 100644 --- a/cloe/cloe-implementation.lisp +++ b/cloe/cloe-implementation.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-implementation.lisp,v 1.4 1997/02/05 01:45:56 tomj Exp $ +;; $Id: cloe-implementation.lisp,v 1.5 1998/08/06 23:16:13 layer Exp $ ;;; Support for the shared class DC. diff --git a/cloe/cloe-medium.lisp b/cloe/cloe-medium.lisp index 6d788ea6fdc6a1b2ab032ee746ca66d26bde1f81..d9cf391501d14ffcd63542b19b14f6660d807149 100644 --- a/cloe/cloe-medium.lisp +++ b/cloe/cloe-medium.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-medium.lisp,v 1.5 1997/02/05 01:45:58 tomj Exp $ +;; $Id: cloe-medium.lisp,v 1.6 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-menus.lisp b/cloe/cloe-menus.lisp index e20ed0513eb7aa0ec5e0c3015a4c68e3c25c91d8..95b3783e8a6690d4cd77a1d7c736f0fe69604e7c 100644 --- a/cloe/cloe-menus.lisp +++ b/cloe/cloe-menus.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-menus.lisp,v 1.4 1997/02/05 01:46:00 tomj Exp $ +;; $Id: cloe-menus.lisp,v 1.5 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-mirror.lisp b/cloe/cloe-mirror.lisp index 94eb14254f4b9f61b2d25e1f03577b1e2af5bba5..f0df8673b2109c7134de8d0302d7c43810759c29 100644 --- a/cloe/cloe-mirror.lisp +++ b/cloe/cloe-mirror.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-mirror.lisp,v 1.5 1997/02/05 01:46:01 tomj Exp $ +;; $Id: cloe-mirror.lisp,v 1.6 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-pixmaps.lisp b/cloe/cloe-pixmaps.lisp index b7d5d558e5d372528f1cea44efbcd0189ee58248..9f53ee25d0a7e1b3ac31325cf53d3cb9dcb0491c 100644 --- a/cloe/cloe-pixmaps.lisp +++ b/cloe/cloe-pixmaps.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-pixmaps.lisp,v 1.5 1997/02/05 01:46:02 tomj Exp $ +;; $Id: cloe-pixmaps.lisp,v 1.6 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-port.lisp b/cloe/cloe-port.lisp index 5e1ecec0323945efd416505d64b363182fb4b85d..c0219e945020441e75622494ed7f5057ae1fa82b 100644 --- a/cloe/cloe-port.lisp +++ b/cloe/cloe-port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-port.lisp,v 1.6 1997/02/05 01:46:05 tomj Exp $ +;; $Id: cloe-port.lisp,v 1.7 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/cloe-streams.lisp b/cloe/cloe-streams.lisp index d0628d9f32a13f4804ff18a3a8e21bb60ae2f3c7..dfacb89f43f1090b399342a935e44edcb7a95ee8 100644 --- a/cloe/cloe-streams.lisp +++ b/cloe/cloe-streams.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLOE-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/cloe-streams.lisp,v 1.4 1997/02/05 01:46:06 tomj Exp $ +;; $Id: cloe-streams.lisp,v 1.5 1998/08/06 23:16:14 layer Exp $ (in-package :cloe-clim) diff --git a/cloe/patch.lisp b/cloe/patch.lisp index c41f037720298514b72a96dc7673c96a77880339..5ae2ee893a9ef89fb80ab37b15218364d8b4d36a 100644 --- a/cloe/patch.lisp +++ b/cloe/patch.lisp @@ -1,6 +1,6 @@ (in-package :win) -;; $Header: /repo/cvs.copy/clim2/cloe/patch.lisp,v 1.3 1997/02/05 01:46:08 tomj Exp $ +;; $Id: patch.lisp,v 1.4 1998/08/06 23:16:14 layer Exp $ (DEFCONSTANT WM_SYSKEYDOWN #x0104) (DEFCONSTANT WM_SYSKEYUP #x0105) diff --git a/cloe/pkgdcl.lisp b/cloe/pkgdcl.lisp index 1cf480296520090e377d43abc543271c4496cb34..e7299cdc1571a1a8b06414b6303d2ef51ecb2f82 100644 --- a/cloe/pkgdcl.lisp +++ b/cloe/pkgdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/pkgdcl.lisp,v 1.5 1997/02/05 01:46:09 tomj Exp $ +;; $Id: pkgdcl.lisp,v 1.6 1998/08/06 23:16:15 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) diff --git a/cloe/sysdcl.lisp b/cloe/sysdcl.lisp index 03855b7c7dbc40c49bd592ed5007ab6a89bb65c0..9c51c70940b077a7664a8eafc7f970ad236d515b 100644 --- a/cloe/sysdcl.lisp +++ b/cloe/sysdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/sysdcl.lisp,v 1.6 1997/02/05 01:46:11 tomj Exp $ +;; $Id: sysdcl.lisp,v 1.7 1998/08/06 23:16:15 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/cloe/wheader.lisp b/cloe/wheader.lisp index c44c5398f428345bd7342869df98c0ff5392b31e..8f28e4dc460f9021eba2e12283b5216065718277 100644 --- a/cloe/wheader.lisp +++ b/cloe/wheader.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/wheader.lisp,v 1.3 1997/02/05 01:46:13 tomj Exp $ +;; $Id: wheader.lisp,v 1.4 1998/08/06 23:16:15 layer Exp $ (in-package :win) diff --git a/cloe/windows.lisp b/cloe/windows.lisp index c613ddcb81feed87a60ae2aa0b8a2eb5fb354aec..edc7dc399aeedb9f9a5085e33f6eaf14de287b80 100644 --- a/cloe/windows.lisp +++ b/cloe/windows.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/cloe/windows.lisp,v 1.3 1997/02/05 01:46:15 tomj Exp $ +;; $Id: windows.lisp,v 1.4 1998/08/06 23:16:15 layer Exp $ (in-package :win) diff --git a/clx/clx-fast.lisp b/clx/clx-fast.lisp index 3823163cb2f1eff81292282d3305fff054fc9989..e1ac7045fd133611469411acf4e16acc32ca9507 100644 --- a/clx/clx-fast.lisp +++ b/clx/clx-fast.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-fast.lisp,v 1.3 1997/02/05 01:46:23 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-fast.lisp,v 1.4 1998/08/06 23:16:17 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; Fast drawing function constructors diff --git a/clx/clx-frames.lisp b/clx/clx-frames.lisp index fbefca0b4549aee29c57e9b03d251a7c0777426e..23293ef388e454d30f40b5756ec44abec7a80bd8 100644 --- a/clx/clx-frames.lisp +++ b/clx/clx-frames.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-frames.lisp,v 1.15 1997/02/05 01:46:25 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-frames.lisp,v 1.16 1998/08/06 23:16:17 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (defclass clx-frame-manager (standard-frame-manager) diff --git a/clx/clx-gadgets.lisp b/clx/clx-gadgets.lisp index 0f9b2f58a73949bfb766f9d3f174137978a79fd5..e2ae61488f0caa9e4ee52a6f03c003b5f3c43913 100644 --- a/clx/clx-gadgets.lisp +++ b/clx/clx-gadgets.lisp @@ -1,2 +1,2 @@ -;; $Header: /repo/cvs.copy/clim2/clx/clx-gadgets.lisp,v 1.8 1997/02/05 01:46:27 tomj Exp $ +;; $Id: clx-gadgets.lisp,v 1.9 1998/08/06 23:16:18 layer Exp $ ;; The contents of this file have been moves into silica/framem.lisp diff --git a/clx/clx-medium.lisp b/clx/clx-medium.lisp index 311f740bb4bcdf0a2e8d905fbe0af52779769dac..8e9a4785b17f308613a2c5ae49f8a18b23f01c0f 100644 --- a/clx/clx-medium.lisp +++ b/clx/clx-medium.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-medium.lisp,v 1.16 1997/02/05 01:46:29 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-medium.lisp,v 1.17 1998/08/06 23:16:18 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (defclass clx-medium (basic-medium) diff --git a/clx/clx-mirror.lisp b/clx/clx-mirror.lisp index 08201d098f8ad2e7f415709f9c6e19366eaac073..035a6c00f5bf1051a4f2e8f70ebeae7b122457ad 100644 --- a/clx/clx-mirror.lisp +++ b/clx/clx-mirror.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-mirror.lisp,v 1.19 1997/02/05 01:46:31 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-mirror.lisp,v 1.20 1998/08/06 23:16:18 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 International Lisp Associates." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 International Lisp Associates." ;;--- This isn't really right, figure out what to do diff --git a/clx/clx-pixmaps.lisp b/clx/clx-pixmaps.lisp index 224cada4083a4b62f56f57a913dd96c6325f5bdc..4459f6f7c73512b204a33b47625dbf8ad096613a 100644 --- a/clx/clx-pixmaps.lisp +++ b/clx/clx-pixmaps.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-pixmaps.lisp,v 1.9 1997/02/05 01:46:34 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-pixmaps.lisp,v 1.10 1998/08/06 23:16:18 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (defclass clx-pixmap (pixmap) diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp index e3657d7aab8d7d47a968c99b4264a74708667139..3edf6178b084e3ea7bf33a81cc4bad86046990ec 100644 --- a/clx/clx-port.lisp +++ b/clx/clx-port.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-port.lisp,v 1.20 1997/02/05 01:46:36 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-port.lisp,v 1.21 1998/08/06 23:16:18 layer Exp $ (in-package :clx-clim) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 International Lisp Associates." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 International Lisp Associates." (defclass clx-port (basic-port) diff --git a/clx/clx-prefill.lisp b/clx/clx-prefill.lisp index 7cf4be4ce381a30bbd94c77fb20995ea344a54e1..8c6ba8231ab9af91e7e3453868d3a4ca4356e6b9 100644 --- a/clx/clx-prefill.lisp +++ b/clx/clx-prefill.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/clx-prefill.lisp,v 1.9 1997/02/05 01:46:37 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clx-prefill.lisp,v 1.10 1998/08/06 23:16:19 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; (generate-prefill-dispatch-caches 'design) diff --git a/clx/old-clx-implementation.lisp b/clx/old-clx-implementation.lisp index d061d6521b9b903440a5f9dfe2d4cc0967e7f107..35fcdf4897ab316a333620033079e068bf8a6ff7 100644 --- a/clx/old-clx-implementation.lisp +++ b/clx/old-clx-implementation.lisp @@ -1,6 +1,23 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLX-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/clx/old-clx-implementation.lisp,v 1.8 1997/02/05 01:46:39 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: old-clx-implementation.lisp,v 1.9 1998/08/06 23:16:19 layer Exp $ ;;--- (1) Why does the new CLX port flush WHITE- and BLACK-PIXEL? ;;--- (2) What to do about reparenting? diff --git a/clx/pkgdcl.lisp b/clx/pkgdcl.lisp index 7b54c15a4890bfac6bf67f8e51db7e3dcf12f57d..f66267a6a585d4ec3f21d47fda1ab198d643b79d 100644 --- a/clx/pkgdcl.lisp +++ b/clx/pkgdcl.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/pkgdcl.lisp,v 1.7 1997/02/05 01:46:41 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: pkgdcl.lisp,v 1.8 1998/08/06 23:16:19 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clx-clim (:use clim-lisp clim-sys clim clim-utils clim-silica) diff --git a/clx/sysdcl.lisp b/clx/sysdcl.lisp index f9000c290faca22d4c8b0ff5afcda979c6fd10aa..00dc37317922d7bc67cc0fb0494e5aa109dcf3cb 100644 --- a/clx/sysdcl.lisp +++ b/clx/sysdcl.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/clx/sysdcl.lisp,v 1.6 1997/02/05 01:46:42 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl.lisp,v 1.7 1998/08/06 23:16:19 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (clim-defsys:defsystem clx-clim (:default-pathname #+Genera "SYS:CLIM;REL-2;CLX;" diff --git a/compatibility/clim1-compatibility.lisp b/compatibility/clim1-compatibility.lisp index 7228a9ad1af4506c73816f7234ac9a3f67ae6644..7e2b53d92ab7e56dcbc5b47757a6ad4cc4b43a3a 100644 --- a/compatibility/clim1-compatibility.lisp +++ b/compatibility/clim1-compatibility.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes; Patch-File: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/compatibility/clim1-compatibility.lisp,v 1.8 1997/02/05 01:46:49 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clim1-compatibility.lisp,v 1.9 1998/08/06 23:16:21 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; Compatibility stubs for CLIM 1.1 diff --git a/compatibility/packages.lisp b/compatibility/packages.lisp index e25f3566aa46a038dc4a47fdac1df9b214553abe..91049694fac9b50e855400fc1aecfe54744db613 100644 --- a/compatibility/packages.lisp +++ b/compatibility/packages.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/compatibility/packages.lisp,v 1.7 1997/02/05 01:46:52 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: packages.lisp,v 1.8 1998/08/06 23:16:21 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (eval-when (compile load eval) diff --git a/compatibility/sysdcl.lisp b/compatibility/sysdcl.lisp index 9ff6b40994aab2fa1e74cb64d33b4e42b30509e5..29d2d2ce47abcf86599ef2d293dbc84d122c80d9 100644 --- a/compatibility/sysdcl.lisp +++ b/compatibility/sysdcl.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/compatibility/sysdcl.lisp,v 1.6 1997/02/05 01:46:53 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl.lisp,v 1.7 1998/08/06 23:16:21 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (clim-defsys:defsystem clim-compatibility (:default-pathname #+Genera "SYS:CLIM;REL-2;COMPATIBILITY;" diff --git a/demo/address-book.lisp b/demo/address-book.lisp index e2f80de13397f30f31331a8c8c2363ad774fea51..f3e4e28ee942feb3573f797ba8a201265d31b8b9 100644 --- a/demo/address-book.lisp +++ b/demo/address-book.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/address-book.lisp,v 1.23 1998/05/19 18:50:46 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: address-book.lisp,v 1.24 1998/08/06 23:16:23 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1990 International Lisp Associates. All rights reserved." ;;; Define a simple CLIM program. This program maintains a simple address book. ;;; First, we need a minimal address database. diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp index 23df9829f853559c7aaa0aae9d049bc73941cf68..53b736bdf8c0ef4b02153db17da59b0b8cb454c6 100644 --- a/demo/bitmap-editor.lisp +++ b/demo/bitmap-editor.lisp @@ -1,5 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/demo/bitmap-editor.lisp,v 1.20 1998/05/19 18:50:48 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: bitmap-editor.lisp,v 1.21 1998/08/06 23:16:23 layer Exp $ (in-package :clim-demo) diff --git a/demo/browser.lisp b/demo/browser.lisp index edf77e7f1a6c5028f39e43572285761ddec9ade4..3d45d61ea3a4871dcf48c9b5b0e377beb1251892 100644 --- a/demo/browser.lisp +++ b/demo/browser.lisp @@ -1,13 +1,29 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-lisp; Package: CLIM-BROWSER; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: browser.lisp,v 1.27 1998/08/06 23:16:23 layer Exp $ ;;; Simple extensible browser ;;; Scott McKay -;; $Header: /repo/cvs.copy/clim2/demo/browser.lisp,v 1.26 1998/05/19 18:50:48 layer Exp $ - (in-package :clim-browser) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; To use the Browser, first choose a browser type and browser subtype from diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp index 465c63d6024aefee15158a5e335601b45a505d7a..3ffd3a3e280a3c7a908d82c80ab026f29e61290d 100644 --- a/demo/cad-demo.lisp +++ b/demo/cad-demo.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/cad-demo.lisp,v 1.26 1998/05/19 18:50:48 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: cad-demo.lisp,v 1.27 1998/08/06 23:16:24 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; A simple gate-level CAD program. diff --git a/demo/cload-demos.lisp b/demo/cload-demos.lisp index afe5821823bf9a23549125901ad5568a06d77551..4544f754e76e7a21827f72a85641c2a22eb3312f 100644 --- a/demo/cload-demos.lisp +++ b/demo/cload-demos.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/demo/cload-demos.lisp,v 1.10 1998/05/19 18:50:49 layer Exp $ +;; $Id: cload-demos.lisp,v 1.11 1998/08/06 23:16:24 layer Exp $ (in-package :clim-user) diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp index 9f4f5fa2bd944020a58bb4a9bfb0b9316f3ff721..59544e1eb18769c71aef9bc2b2a872d266c979cb 100644 --- a/demo/color-editor.lisp +++ b/demo/color-editor.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/color-editor.lisp,v 1.16 1998/05/19 18:50:49 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: color-editor.lisp,v 1.17 1998/08/06 23:16:24 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." (defclass color-chooser-pane (clim-stream-pane) ()) diff --git a/demo/custom-records.lisp b/demo/custom-records.lisp index ecac681891626c02b97936fc58d50b2f79063400..d7f48d2e9e9780db29a31250ea643d9afe2c7d39 100644 --- a/demo/custom-records.lisp +++ b/demo/custom-records.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/custom-records.lisp,v 1.9 1998/05/19 18:50:49 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: custom-records.lisp,v 1.10 1998/08/06 23:16:25 layer Exp $ (in-package :clim-user) @@ -444,7 +460,7 @@ (vertically () (1/5 caption) (4/5 display))))) (defmethod frame-standard-output ((frame scigraph)) - (get-frame-pane *application-frame* 'display)) + (get-frame-pane frame 'display)) (define-scigraph-command (com-exit-scigraph :menu "Exit") () (frame-exit *application-frame*)) diff --git a/demo/default-frame-top-level.lisp b/demo/default-frame-top-level.lisp index 99586cbebe909721dface3b2ce33ebcae431e65a..9b8ec367c17e59195a8ca0f97bf1b266369224e3 100644 --- a/demo/default-frame-top-level.lisp +++ b/demo/default-frame-top-level.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: clim-internals -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,6 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; +;; $Id: default-frame-top-level.lisp,v 1.4 1998/08/06 23:16:25 layer Exp $ (in-package :clim-internals) diff --git a/demo/demo-activity.lisp b/demo/demo-activity.lisp index f6b39ec003d5e5d5deb107ed148ac44b438e42fe..b56cd3e24d318734bef10ae6fa1861660cdc41a5 100644 --- a/demo/demo-activity.lisp +++ b/demo/demo-activity.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/demo-activity.lisp,v 1.11 1998/05/19 18:50:49 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: demo-activity.lisp,v 1.12 1998/08/06 23:16:26 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved." (defclass demo-activity (activity) ()) diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp index 776e1f97a77d741c8b144719cb687391a954957a..a7a2482f4586f8ecbaa5673faf91ce0f0f07e95b 100644 --- a/demo/demo-driver.lisp +++ b/demo/demo-driver.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/demo-driver.lisp,v 1.34 1998/05/19 18:50:49 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: demo-driver.lisp,v 1.35 1998/08/06 23:16:27 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (defvar *demos* nil) diff --git a/demo/demo-last.lisp b/demo/demo-last.lisp index 1e559479e9618c86dcb9d9e25e47f5d50f4f8cd3..a8511a9d493fd1294c2f17680c3f13731a27358b 100644 --- a/demo/demo-last.lisp +++ b/demo/demo-last.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/demo/demo-last.lisp,v 1.5 1998/05/19 18:50:49 layer Exp $ - +;; $Id: demo-last.lisp,v 1.6 1998/08/06 23:16:27 layer Exp $ (in-package :user) diff --git a/demo/demo-prefill.lisp b/demo/demo-prefill.lisp index 712e7c80a26c22ebad99d694f039d1b4895911d4..37a1042fe8d3e96290ab3d545770796b01e88386 100644 --- a/demo/demo-prefill.lisp +++ b/demo/demo-prefill.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/demo-prefill.lisp,v 1.12 1998/05/19 18:50:50 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: demo-prefill.lisp,v 1.13 1998/08/06 23:16:27 layer Exp $ (in-package :clim-internals) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved." ;;; This file prefills generic function dispatch caches at load time so that ;;; there won't be so much delay starting things up the first time the application diff --git a/demo/graphics-demos.lisp b/demo/graphics-demos.lisp index e35d075773a5e0a406b1260425813c4837811db2..7b8a583c20f47e6e2ceab16ce0bd83e8cea68177 100644 --- a/demo/graphics-demos.lisp +++ b/demo/graphics-demos.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/graphics-demos.lisp,v 1.17 1998/05/19 18:50:50 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: graphics-demos.lisp,v 1.18 1998/08/06 23:16:27 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." (define-application-frame graphics-demo () () diff --git a/demo/graphics-editor.lisp b/demo/graphics-editor.lisp index ff31863fc4650eb20eab423ab5f45c0b0808e4f8..9fbab128a3fb2d0f9510a8875f0b512690eb5cb8 100644 --- a/demo/graphics-editor.lisp +++ b/demo/graphics-editor.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/graphics-editor.lisp,v 1.27 1998/05/19 18:50:50 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: graphics-editor.lisp,v 1.28 1998/08/06 23:16:27 layer Exp $ (in-package :clim-graphics-editor) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; Define a "mix-in" frame class that manages a selected object diff --git a/demo/ico.lisp b/demo/ico.lisp index 776b18f1c58f2604dc6b6ecef8dbb0202c8de63e..fb629410b2d1a4c42239b2a17a438e4b3ecb4f24 100644 --- a/demo/ico.lisp +++ b/demo/ico.lisp @@ -1,10 +1,25 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/ico.lisp,v 1.25 1998/05/19 18:50:50 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: ico.lisp,v 1.26 1998/08/06 23:16:27 layer Exp $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. -;;; Portions (c) 1992 Franz Inc. ;;; Algorithm pretty much lifted from X11 demo program. ;;; diff --git a/demo/japanese-graphics-editor.lisp b/demo/japanese-graphics-editor.lisp index b005a63d40b64f6ec6fc0ada8a6bbdae2731b683..71aee12180b8c99df0a09377023012ccf3d353e4 100644 --- a/demo/japanese-graphics-editor.lisp +++ b/demo/japanese-graphics-editor.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: JAPANESE-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/japanese-graphics-editor.lisp,v 1.6 1998/05/19 18:50:50 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: japanese-graphics-editor.lisp,v 1.7 1998/08/06 23:16:27 layer Exp $ (in-package :japanese-graphics-editor) -"Copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." #-ics (eval-when (compile) diff --git a/demo/listener.lisp b/demo/listener.lisp index f5d19f9d323c59e4429276a253a9494300a8583e..e5506c4910ac361cf3ceb99481d9e05689de1698 100644 --- a/demo/listener.lisp +++ b/demo/listener.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/listener.lisp,v 1.36 1998/05/19 18:50:51 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: listener.lisp,v 1.37 1998/08/06 23:16:28 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (define-application-frame lisp-listener () () diff --git a/demo/navdata.lisp b/demo/navdata.lisp index 3cb8dc5cf47c83e2c96b22bf12628df44a3c7056..a5b7fdea2fe50c3b03e9d3f3b4682a297c3ea47b 100644 --- a/demo/navdata.lisp +++ b/demo/navdata.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/navdata.lisp,v 1.8 1998/05/19 18:50:51 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: navdata.lisp,v 1.9 1998/08/06 23:16:28 layer Exp $ (in-package :clim-demo) diff --git a/demo/navfun.lisp b/demo/navfun.lisp index d41b70f96ecf0d3638a10173037d237a5fec3450..f4e0c37d16c2e737e2a2e8a4761a664b48965105 100644 --- a/demo/navfun.lisp +++ b/demo/navfun.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/navfun.lisp,v 1.30 1998/05/19 18:50:51 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: navfun.lisp,v 1.31 1998/08/06 23:16:28 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Database support diff --git a/demo/output-record.lisp b/demo/output-record.lisp index 502d8280bc02f1f9740796d691f02d31a3182509..fc31bb2f3ac8cf7a78c8bfbf82c9396f17992cb4 100644 --- a/demo/output-record.lisp +++ b/demo/output-record.lisp @@ -1,8 +1,25 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: output-record.lisp,v 1.6 1998/08/06 23:16:28 layer Exp $ ;;; Hacks for efficiently drawing really big scientific graphs. ;;; Needs to be clim2.0 ified. -;;; $Header: /repo/cvs.copy/clim2/demo/output-record.lisp,v 1.5 1998/05/19 18:50:51 layer Exp $ (in-package :clim) ;;; Vendors have started locking this package, so we shouldn't be using it. diff --git a/demo/packages.lisp b/demo/packages.lisp index d625f93a2e3478cf8f82f6f279058986ba2eeae7..7cfc0d3bc2dc1492110a0eb3cacc5be4efb33d7a 100644 --- a/demo/packages.lisp +++ b/demo/packages.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/packages.lisp,v 1.15 1998/05/19 18:50:51 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: packages.lisp,v 1.16 1998/08/06 23:16:29 layer Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (#-ansi-90 clim-lisp::defpackage #+ansi-90 defpackage clim-demo (:use clim-lisp clim) diff --git a/demo/palette.lisp b/demo/palette.lisp index 352923bd15fbfc2b50072640e82e0f86bd34cbd8..a11b675e034fa86d02319507f76eb1d6c9164338 100644 --- a/demo/palette.lisp +++ b/demo/palette.lisp @@ -1,5 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/demo/palette.lisp,v 1.8 1998/05/19 18:50:51 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: palette.lisp,v 1.9 1998/08/06 23:16:29 layer Exp $ (in-package :clim-demo) diff --git a/demo/peek-frame.lisp b/demo/peek-frame.lisp index f0f5d4184b2ad6c583f0f82d554fe8715b93bc04..d23238eafcf10e0161083fa69dbb3c0c5b4312d4 100644 --- a/demo/peek-frame.lisp +++ b/demo/peek-frame.lisp @@ -1,6 +1,23 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: peek-frame.lisp,v 1.9 1998/08/06 23:16:29 layer Exp $ -;; $Header: /repo/cvs.copy/clim2/demo/peek-frame.lisp,v 1.8 1998/05/19 18:50:52 layer Exp $ (in-package :clim-user) diff --git a/demo/plot.lisp b/demo/plot.lisp index a053e25610745a82e3345a974e9044a7103d8238..42d5d865c28a588a1f6cc2c3064d859dcafb7b48 100644 --- a/demo/plot.lisp +++ b/demo/plot.lisp @@ -1,5 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/demo/plot.lisp,v 1.34 1998/05/19 18:50:52 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: plot.lisp,v 1.35 1998/08/06 23:16:30 layer Exp $ (in-package :clim-demo) diff --git a/demo/printer.lisp b/demo/printer.lisp index 377e229befc4a7c3242aaadac22237d9ca178e0c..eefb727e885e488470a3c9dd57ac05a32d376663 100644 --- a/demo/printer.lisp +++ b/demo/printer.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: printer.lisp,v 1.2 1998/08/06 23:16:30 layer Exp $ + (in-package :clim-user) (defun get-printer-options (&key (printer :lw) diff --git a/demo/process-browser.lisp b/demo/process-browser.lisp index 8a683fa08bcbb56c0707001b340bc5d2ba436c99..646e7ba544461f0036448d1e3a4ec215ea755766 100644 --- a/demo/process-browser.lisp +++ b/demo/process-browser.lisp @@ -1,5 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/demo/process-browser.lisp,v 1.12 1998/03/17 23:32:03 duane Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: process-browser.lisp,v 1.13 1998/08/06 23:16:30 layer Exp $ (in-package :clim-demo) diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp index c6fbef7dfcf583fcc9d67975f2e386e2d6f5601a..42bb8ba31ebe87950b06015b5cf8dd55d19bfff6 100644 --- a/demo/puzzle.lisp +++ b/demo/puzzle.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/puzzle.lisp,v 1.26 1998/05/19 18:50:53 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: puzzle.lisp,v 1.27 1998/08/06 23:16:30 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (define-application-frame puzzle () ((puzzle :initform (make-array '(4 4)) diff --git a/demo/sysdcl-pc.lisp b/demo/sysdcl-pc.lisp index e251672c218b3053df6c90d4faaf690d7b427bee..36dacde31d9c552fe2c69506583d74c9556154c5 100644 --- a/demo/sysdcl-pc.lisp +++ b/demo/sysdcl-pc.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/sysdcl-pc.lisp,v 1.4 1998/05/19 18:50:53 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl-pc.lisp,v 1.5 1998/08/06 23:16:30 layer Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." #+aclpc (clim-defsys:defsystem clim-demo diff --git a/demo/sysdcl.lisp b/demo/sysdcl.lisp index febae2942b2dc4ed5c935bf62d7a50870d23cdd4..a619610c1cbafd14308644459b1e495287f299f4 100644 --- a/demo/sysdcl.lisp +++ b/demo/sysdcl.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/sysdcl.lisp,v 1.29 1998/05/19 18:50:54 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl.lisp,v 1.30 1998/08/06 23:16:30 layer Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;; see sys/sysdcl.lisp for the package-module defn (cim 2/28/96) diff --git a/demo/thinkadot.lisp b/demo/thinkadot.lisp index 3ee2da78a02248d11bda9c0e245c2ddec9e2e805..e2f7d132b85f2a2383e15dac2e68b927deee4b66 100644 --- a/demo/thinkadot.lisp +++ b/demo/thinkadot.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/demo/thinkadot.lisp,v 1.17 1998/05/19 18:50:54 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: thinkadot.lisp,v 1.18 1998/08/06 23:16:30 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Simulates a mechanical toy finite-state-machine called "Thinkadot". diff --git a/demo/winlisp.lisp b/demo/winlisp.lisp index cd0377f501e2c73eb55143997695d501a50f233d..89505559149307a497702570e49ba18feecb7db3 100644 --- a/demo/winlisp.lisp +++ b/demo/winlisp.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- - -;; $fiHeader: winlisp.lisp,v 1.30 1993/07/22 15:38:29 cer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: winlisp.lisp,v 1.4 1998/08/06 23:16:31 layer Exp $ (in-package :clim-demo) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (define-command-table wlistener-file diff --git a/genera/genera-activities.lisp b/genera/genera-activities.lisp index e887478ff07bc984377b8f6eea2dd9cb8349984f..f46f09a2cc27f526fbb2550515643237d5022c41 100644 --- a/genera/genera-activities.lisp +++ b/genera/genera-activities.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-activities.lisp,v 1.12 1997/02/05 01:48:07 tomj Exp $ +;; $Id: genera-activities.lisp,v 1.13 1998/08/06 23:16:33 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-fast.lisp b/genera/genera-fast.lisp index 2668224fe85f1277dc42f353827d9721019138b6..dc7370159655ef1312e06f22f62775214cf4717b 100644 --- a/genera/genera-fast.lisp +++ b/genera/genera-fast.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-fast.lisp,v 1.3 1997/02/05 01:48:09 tomj Exp $ +;; $Id: genera-fast.lisp,v 1.4 1998/08/06 23:16:33 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-frames.lisp b/genera/genera-frames.lisp index f56a0fe21b3e7a10e256405d16aade47843d2336..4f2e5d47e4b62b40d0a3a2dfe9d5f064bf7f883b 100644 --- a/genera/genera-frames.lisp +++ b/genera/genera-frames.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-frames.lisp,v 1.17 1997/02/05 01:48:10 tomj Exp $ +;; $Id: genera-frames.lisp,v 1.18 1998/08/06 23:16:33 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-gadgets.lisp b/genera/genera-gadgets.lisp index ca85da82b7060e01d0100ff417e16088cf4ad574..5edf4f99de954b7d2fdfb6acd4a0f50923798182 100644 --- a/genera/genera-gadgets.lisp +++ b/genera/genera-gadgets.lisp @@ -1,2 +1,2 @@ -;; $Header: /repo/cvs.copy/clim2/genera/genera-gadgets.lisp,v 1.8 1997/02/05 01:48:12 tomj Exp $ +;; $Id: genera-gadgets.lisp,v 1.9 1998/08/06 23:16:33 layer Exp $ ;; The contents of this file have been moves into silica/framem.lisp diff --git a/genera/genera-medium.lisp b/genera/genera-medium.lisp index c6d9497883671ebed8d9c463caa9080c982908c8..8cda5a986dca7db99d47b3e9efe4174e01fcf6eb 100644 --- a/genera/genera-medium.lisp +++ b/genera/genera-medium.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-medium.lisp,v 1.18 1997/02/05 01:48:14 tomj Exp $ +;; $Id: genera-medium.lisp,v 1.19 1998/08/06 23:16:34 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-mirror.lisp b/genera/genera-mirror.lisp index eb9243a5a3da5665d93aba4af134202b822d508d..ecc9cb4f1e0e7ab3702f59172eb412980349cbfe 100644 --- a/genera/genera-mirror.lisp +++ b/genera/genera-mirror.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-mirror.lisp,v 1.18 1997/02/05 01:48:16 tomj Exp $ +;; $Id: genera-mirror.lisp,v 1.19 1998/08/06 23:16:34 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-pixmaps.lisp b/genera/genera-pixmaps.lisp index 679efdcc2c0dda09f19b95f72c25229059d3c59b..25e5be549dbf48be069f06621c1652af942444e0 100644 --- a/genera/genera-pixmaps.lisp +++ b/genera/genera-pixmaps.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-pixmaps.lisp,v 1.10 1997/02/05 01:48:17 tomj Exp $ +;; $Id: genera-pixmaps.lisp,v 1.11 1998/08/06 23:16:34 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-port.lisp b/genera/genera-port.lisp index 277a7429a81a988b95b8dcda4e2c8f847f3945d7..82b2347a9697d755d2b86003e8681d4b80a65bb9 100644 --- a/genera/genera-port.lisp +++ b/genera/genera-port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-port.lisp,v 1.19 1997/02/05 01:48:19 tomj Exp $ +;; $Id: genera-port.lisp,v 1.20 1998/08/06 23:16:34 layer Exp $ (in-package :genera-clim) diff --git a/genera/genera-prefill.lisp b/genera/genera-prefill.lisp index ec005fe086be57d7eeda127b285012c3c9ec8a56..c02384d13834e61d9e25ca3b845441aad2136e19 100644 --- a/genera/genera-prefill.lisp +++ b/genera/genera-prefill.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/genera-prefill.lisp,v 1.9 1997/02/05 01:48:21 tomj Exp $ +;; $Id: genera-prefill.lisp,v 1.10 1998/08/06 23:16:34 layer Exp $ (in-package :clim-internals) diff --git a/genera/old-genera-implementation.lisp b/genera/old-genera-implementation.lisp index c8804282674e8bce69a3a1f2357c7ce0d03ca798..516b0f861bf832f8ce2da2f21b5e132b53565613 100644 --- a/genera/old-genera-implementation.lisp +++ b/genera/old-genera-implementation.lisp @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: GENERA-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/old-genera-implementation.lisp,v 1.7 1997/02/05 01:48:23 tomj Exp $ +;; $Id: old-genera-implementation.lisp,v 1.8 1998/08/06 23:16:35 layer Exp $ ;;--- We really need to handle this for all the ports (defmethod window-visibility ((stream sheet-implementation-mixin)) diff --git a/genera/pkgdcl.lisp b/genera/pkgdcl.lisp index 577bd32613cf1d3306b2a898db6636b7fefda3fb..3a5835e6696ad9fd4f599e85950cde8a0be31782 100644 --- a/genera/pkgdcl.lisp +++ b/genera/pkgdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/pkgdcl.lisp,v 1.5 1997/02/05 01:48:24 tomj Exp $ +;; $Id: pkgdcl.lisp,v 1.6 1998/08/06 23:16:35 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) diff --git a/genera/sysdcl.lisp b/genera/sysdcl.lisp index a38e4c591cd3877c574ce123df447b65447892b0..f010f285a112d18819d42506b97a6c71c8ff1bd1 100644 --- a/genera/sysdcl.lisp +++ b/genera/sysdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/genera/sysdcl.lisp,v 1.6 1997/02/05 01:48:25 tomj Exp $ +;; $Id: sysdcl.lisp,v 1.7 1998/08/06 23:16:35 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/homegrown/db-button.lisp b/homegrown/db-button.lisp index d2620ee673bdc1809456b926c559fee6b6c0e889..4d60c2734b6e1c3e06995f373afd741100a82686 100644 --- a/homegrown/db-button.lisp +++ b/homegrown/db-button.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/db-button.lisp,v 1.2 1997/02/05 01:48:32 tomj Exp $ +;; $Id: db-button.lisp,v 1.3 1998/08/06 23:16:37 layer Exp $ "Copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved. Portions copyright (c) 1990, 1991 International Lisp Associates." diff --git a/homegrown/db-label.lisp b/homegrown/db-label.lisp index 9ec98313169d808ed6a1ea73ed9bccd9bee13250..e164241a374092a0c03f174e1e0d636267aade4a 100644 --- a/homegrown/db-label.lisp +++ b/homegrown/db-label.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: silica -*- ;; -;; -[Thu Jul 22 17:16:08 1993 by colin]- +;; -[Mon Jul 6 15:36:42 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/homegrown/db-label.lisp,v 1.3 1997/02/05 01:48:34 tomj Exp $ +;; $Id: db-label.lisp,v 1.4 1998/08/06 23:16:37 layer Exp $ (in-package :silica) diff --git a/homegrown/db-list.lisp b/homegrown/db-list.lisp index eccce30a2eef1429e45af3ea4f7c75d300b1b3b5..1dfa594d0fb7cb3bcd31918866ec31798f78c974 100644 --- a/homegrown/db-list.lisp +++ b/homegrown/db-list.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/db-list.lisp,v 1.2 1997/02/05 01:48:36 tomj Exp $ +;; $Id: db-list.lisp,v 1.3 1998/08/06 23:16:37 layer Exp $ "Copyright (c) 1992 by Symbolics, Inc. All rights reserved." diff --git a/homegrown/db-menu.lisp b/homegrown/db-menu.lisp index 374202f673b7fdc3bdf942b336e4889a4ab46b0c..d5d062b5ef6cd707efa2a8485f711b9b54819052 100644 --- a/homegrown/db-menu.lisp +++ b/homegrown/db-menu.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/db-menu.lisp,v 1.2 1997/02/05 01:48:38 tomj Exp $ +;; $Id: db-menu.lisp,v 1.3 1998/08/06 23:16:37 layer Exp $ "Copyright (c) 1992 by Symbolics, Inc. All rights reserved." @@ -280,35 +280,38 @@ ;;--- What about when the command menu tick changes? ;;--- What about graying of disabled commands? (defun compute-menu-bar-pane (frame command-table) - (let* ((text-style (and (listp command-table) - (getf (cdr command-table) :text-style) - `(:text-style ,(getf (cdr command-table) :text-style)))) - (command-table (if (listp command-table) (car command-table) command-table))) + (let* ((text-style + (and (listp command-table) + (getf (cdr command-table) :text-style) + `(:text-style ,(getf (cdr command-table) :text-style)))) + (command-table + (if (listp command-table) (car command-table) command-table))) (when (eq command-table 't) (setq command-table (frame-command-table frame))) (with-look-and-feel-realization ((frame-manager frame) frame) (labels - ((make-command-table-buttons (command-table top-level) - (let ((buttons nil)) - (map-over-command-table-menu-items - #'(lambda (menu keystroke item) - (let ((type (command-menu-item-type item)) - (value (command-menu-item-value item))) - (case type - (:command + ((make-command-table-buttons (command-table top-level) + (let ((buttons nil)) + (map-over-command-table-menu-items + #'(lambda (menu keystroke item) + (declare (ignore keystroke)) + (let ((type (command-menu-item-type item)) + (value (command-menu-item-value item))) + (case type + (:command (push (apply #'make-pane (if top-level 'push-button 'pull-down-menu-button) :label menu :activate-callback - #'(lambda (button) - (menu-bar-command-callback - button command-table value)) + #'(lambda (button) + (menu-bar-command-callback + button command-table value)) text-style) buttons)) - (:function + (:function ;;--- Do something about this ) - (:menu + (:menu (push (apply #'make-pane (if top-level 'menu-bar-button 'pull-down-menu-button) :label menu @@ -316,17 +319,17 @@ :activate-callback nil text-style) buttons)) - (:divider + (:divider (unless top-level ;;--- Do something about this ))))) - command-table) - (nreverse buttons))) - (make-command-table-menu (command-table top-level) - (let ((buttons (make-command-table-buttons command-table top-level))) - (if top-level - (outlining () - (make-pane 'hbox-pane :contents buttons)) + command-table) + (nreverse buttons))) + (make-command-table-menu (command-table top-level) + (let ((buttons (make-command-table-buttons command-table top-level))) + (if top-level + (outlining () + (make-pane 'hbox-pane :contents buttons)) (let ((menu (make-pull-down-menu :port (port frame)))) (initialize-pull-down-menu menu buttons) menu))))) diff --git a/homegrown/db-slider.lisp b/homegrown/db-slider.lisp index aa5f86bba5ec473a554278c9c47ab0fd934e1d63..8715cae5e587e1b7b3103fabca576e04d358286e 100644 --- a/homegrown/db-slider.lisp +++ b/homegrown/db-slider.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/db-slider.lisp,v 1.2 1997/02/05 01:48:39 tomj Exp $ +;; $Id: db-slider.lisp,v 1.3 1998/08/06 23:16:38 layer Exp $ "Copyright (c) 1992 by Symbolics, Inc. All rights reserved." diff --git a/homegrown/db-text.lisp b/homegrown/db-text.lisp index 814c1b08eec4a423d0e4b436403451e6a7d9f00e..3ab5bbfbe066cb0a27c8c1fce021144592058a20 100644 --- a/homegrown/db-text.lisp +++ b/homegrown/db-text.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/db-text.lisp,v 1.2 1997/02/05 01:48:41 tomj Exp $ +;; $Id: db-text.lisp,v 1.3 1998/08/06 23:16:38 layer Exp $ "Copyright (c) 1992 by Symbolics, Inc. All rights reserved." diff --git a/homegrown/last.lisp b/homegrown/last.lisp index 65b189a65acd8f0be85ba52680746cddcf24f5b6..519c8711dfcc3c34486ded01f00ad94d990f0b78 100644 --- a/homegrown/last.lisp +++ b/homegrown/last.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: silica -*- ;; -;; -[Thu Jul 22 17:16:08 1993 by colin]- +;; -[Mon Jul 6 15:36:41 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/homegrown/last.lisp,v 1.3 1997/02/05 01:48:43 tomj Exp $ +;; $Id: last.lisp,v 1.4 1998/08/06 23:16:38 layer Exp $ (in-package :silica) diff --git a/homegrown/scroll-pane.lisp b/homegrown/scroll-pane.lisp index 362b9a7feb455dad79a4e7deac9893b427e12e0e..245b859394915dc3dc1a2f4d34286395bc2d62b7 100644 --- a/homegrown/scroll-pane.lisp +++ b/homegrown/scroll-pane.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/homegrown/scroll-pane.lisp,v 1.2 1997/02/05 01:48:44 tomj Exp $ +;; $Id: scroll-pane.lisp,v 1.3 1998/08/06 23:16:38 layer Exp $ "Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. Portions copyright(c) 1991, 1992 International Lisp Associates. diff --git a/hpgl/hpgl-medium.lisp b/hpgl/hpgl-medium.lisp index 24b4d81a687b38c116559da3f7ad6ca69b970225..430eb5a4954dffd226ec76f3e2f26fb146b6ad82 100644 --- a/hpgl/hpgl-medium.lisp +++ b/hpgl/hpgl-medium.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: hpgl-clim; Base: 10; Lowercase: Yes -*- -;;; $Header: /repo/cvs.copy/clim2/hpgl/hpgl-medium.lisp,v 1.4 1997/10/20 23:11:04 layer Exp $ +;;; $Id: hpgl-medium.lisp,v 1.5 1998/08/06 23:16:40 layer Exp $ "Copyright (c) 1991 by International Lisp Associates. All rights reserved." "Portions copyright (c) 1992 Franz Inc. All rights reserved" @@ -621,6 +621,9 @@ a point. Hence we have 72dpi resolution printer. (convert-to-hpgl-coordinates transform x y) (lineto printer-stream x y)))))) +(defun nyi () + (error "This HPGL CLIM operation is NYI (Not Yet Implemented).")) + (defmethod medium-draw-ellipse* ((medium hpgl-medium) center-x center-y radius-1-dx radius-1-dy radius-2-dx radius-2-dy @@ -669,33 +672,34 @@ a point. Hence we have 72dpi resolution printer. ;;; Text stuff (defmacro with-hpgl-port-glyph-for-character ((port) &body body) - `(macrolet ((port-glyph-for-character (port character style &optional our-font) - `(multiple-value-bind (character-set index) - (char-character-set-and-index ,character) - (let* (;; For now we are asserting that each string - ;; passed to WRITE-STRING will have no style - ;; changes within it. This is what our-font - ;; is all about. - (pfd (or ,our-font - (text-style-mapping ,',port ,style character-set))) - (pface (pfd-face pfd)) - (point-size (pfd-point-size pfd)) - (height (* point-size (pface-height pface))) - (ascent (* (pface-ascent pface) height)) - (cwt (pface-width-table pface)) - (relwidth (if (numberp cwt) - cwt - (aref cwt index))) - (escapement-x (* height relwidth)) - (escapement-y 0) - (origin-x 0) - (origin-y ascent) - (bb-x ;; really ought know real dope, but not avl yet. - escapement-x) - (bb-y height)) - (values index pfd escapement-x escapement-y origin-x origin-y - bb-x bb-y (numberp cwt)))))) - ,@body)) + `(excl:without-package-locks + (macrolet ((port-glyph-for-character (port character style &optional our-font) + `(multiple-value-bind (character-set index) + (char-character-set-and-index ,character) + (let* (;; For now we are asserting that each string + ;; passed to WRITE-STRING will have no style + ;; changes within it. This is what our-font + ;; is all about. + (pfd (or ,our-font + (text-style-mapping ,',port ,style character-set))) + (pface (pfd-face pfd)) + (point-size (pfd-point-size pfd)) + (height (* point-size (pface-height pface))) + (ascent (* (pface-ascent pface) height)) + (cwt (pface-width-table pface)) + (relwidth (if (numberp cwt) + cwt + (aref cwt index))) + (escapement-x (* height relwidth)) + (escapement-y 0) + (origin-x 0) + (origin-y ascent) + (bb-x ;; really ought know real dope, but not avl yet. + escapement-x) + (bb-y height)) + (values index pfd escapement-x escapement-y origin-x origin-y + bb-x bb-y (numberp cwt)))))) + ,@body))) (defmethod port-glyph-for-character ((port hpgl-port) character appearance &optional our-font) @@ -715,15 +719,16 @@ a point. Hence we have 72dpi resolution printer. ;;; methods from the code; we could get rid of all the CLIM-xxx-STUFF ;;; files that way. +#+ignore ;; stream-scan-string-for-writing-1 is undefined! (defmethod stream-scan-string-for-writing (stream (medium hpgl-medium) string start end style cursor-x max-x &optional glyph-buffer) - #+Genera (declare - (values write-char next-char-index new-cursor-x new-baseline new-height font)) + #+Genera (declare (values write-char next-char-index new-cursor-x + new-baseline new-height font)) ;;(declare (ignore stream)) - (let ((port (port medium))) + (let (#+ignore (port (port medium))) (with-hpgl-port-glyph-for-character (port) (stream-scan-string-for-writing-1 stream medium string start end style cursor-x max-x glyph-buffer)))) diff --git a/hpgl/hpgl-port.lisp b/hpgl/hpgl-port.lisp index 3ba78380aa7d44118548286127f6a6b5374e9d0e..e29672ca839dffa2700a91d9e7c1412f76a57afd 100644 --- a/hpgl/hpgl-port.lisp +++ b/hpgl/hpgl-port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: hpgl-clim; Base: 10; Lowercase: Yes -*- -;;; $Header: /repo/cvs.copy/clim2/hpgl/hpgl-port.lisp,v 1.6 1997/02/05 01:48:51 tomj Exp $ +;;; $Id: hpgl-port.lisp,v 1.7 1998/08/06 23:16:41 layer Exp $ "Copyright (c) 1991 by International Lisp Associates. All rights reserved." "Portions copyright (c) 1992 Franz Inc. All rights reserved" @@ -463,6 +463,10 @@ (read-hpgl-font-width-table (pfd-face pfd))) pfd)) +(defun read-hpgl-font-width-table (x) + (declare (ignore x)) + (nyi)) + (defmethod text-style-mapping-exists-p :around ((device hpgl-port) text-style &optional (character-set *standard-character-set*) window) diff --git a/hpgl/pkg.lisp b/hpgl/pkg.lisp index 29b1523c95519faa71c1c08a016db30bba8d4f4a..ef2fd5b7f869a1fac0d17a6de78ed7b8ba03d6b7 100644 --- a/hpgl/pkg.lisp +++ b/hpgl/pkg.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/hpgl/pkg.lisp,v 1.5 1997/02/05 01:48:53 tomj Exp $ +;; $Id: pkg.lisp,v 1.6 1998/08/06 23:16:41 layer Exp $ "Copyright (c) 1991 by International Lisp Associates. All rights reserved." "Portions copyright (c) 1992 Franz Inc. All rights reserved" diff --git a/hpgl/sysdcl.lisp b/hpgl/sysdcl.lisp index 96ac096d46ab1a4b0708eaaa2d7000f06d7f76de..81d106006168b69efc327d2624e9980cb5b10456 100644 --- a/hpgl/sysdcl.lisp +++ b/hpgl/sysdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/hpgl/sysdcl.lisp,v 1.4 1997/02/05 01:48:55 tomj Exp $ +;; $Id: sysdcl.lisp,v 1.5 1998/08/06 23:16:41 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/instclimol.lisp b/instclimol.lisp index 4c18ae508941ce8dd66d5fa754bbc9aa39960b00..864714c4a9f3a06a8e459a485b1dd96f2f922ae7 100644 --- a/instclimol.lisp +++ b/instclimol.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: system -*- ;; -;; -[Fri Apr 16 11:55:09 1993 by layer]- +;; -[Mon Jul 6 15:37:15 1998 by layer]- ;; ;; copyright (c) 1991 Franz Inc, Berkeley, CA All rights reserved. ;; @@ -19,7 +19,7 @@ ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/Attic/instclimol.lisp,v 1.10 1997/02/05 01:42:20 tomj Exp $ +;; $Id: instclimol.lisp,v 1.11 1998/08/06 23:15:36 layer Exp $ ;; ;; Load the OpenLook version of CLIM diff --git a/instclimxm.lisp b/instclimxm.lisp index 03d166193efdbe2da9344a6df10f8604f9638beb..d60adc60e126adf2ac90195a334930599c457d48 100644 --- a/instclimxm.lisp +++ b/instclimxm.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: system -*- ;; -;; -[Sun Jun 5 10:03:07 1994 by duane]- +;; -[Mon Jul 6 15:37:15 1998 by layer]- ;; ;; copyright (c) 1991 Franz Inc, Berkeley, CA All rights reserved. ;; @@ -19,7 +19,7 @@ ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/instclimxm.lisp,v 1.13 1997/02/05 01:42:22 tomj Exp $ +;; $Id: instclimxm.lisp,v 1.14 1998/08/06 23:15:36 layer Exp $ ;; ;; Load the Motif version of CLIM diff --git a/makedist.sh b/makedist.sh new file mode 100644 index 0000000000000000000000000000000000000000..9d259e54b1c7ad93ff82f2dc5d3883cbf906dde5 --- /dev/null +++ b/makedist.sh @@ -0,0 +1,23 @@ + +set -xe + +make clean +make RECORD_XREF_INFO=nil RECORD_SOURCE_FILE_INFO=nil CL=../src/lisp + +rm -fr dist temp.zip temp.exe +mkdir dist dist/code dist/src dist/src/clim dist/src/clim/demo +cp -p climnt.fasl climps.fasl climdemo.fasl climg.fasl dist/code +cp -p readme.win32 dist/clim221.txt +cp -p demo/*.lisp dist/src/clim/demo +cp -p buildclim.cl dist + +# next 2 for beta only: +cp -p ../src/winapi/winapi.fasl dist/code +cp -p ../src/winapi/winapi-dev.fasl dist/code + +/winzip/winzip32 -min -a -r -sclim.me -ex temp.zip dist +/winzipse/wzipse32 temp.zip -y -3 -win32 -le \ + -d "c:\Program Files\acl50b" -c notepad clim221.txt + +mv temp.zip clim221.zip +mv temp.exe clim221.exe diff --git a/misc/MyDrawingA.c b/misc/MyDrawingA.c index fdb618c0587c396270ffd3e7976302eb0cef8001..daaaf6ed2d2f63858fafc7f803b84873692c177f 100644 --- a/misc/MyDrawingA.c +++ b/misc/MyDrawingA.c @@ -1,4 +1,4 @@ -/* -[Thu Dec 7 14:48:54 1995 by duane]- +/* -[Sat May 30 09:25:34 1998 by layer]- * * copyright (c) 1992 Franz Inc, Berkeley, CA All rights reserved. * @@ -16,7 +16,7 @@ * Commercial Software developed at private expense as specified in * DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. * - * $Header: /repo/cvs.copy/clim2/misc/MyDrawingA.c,v 1.9 1997/02/05 01:48:59 tomj Exp $ + * $Header: /repo/cvs.copy/clim2/misc/MyDrawingA.c,v 1.10 1998/08/06 23:16:43 layer Exp $ */ #if defined(__alpha) @@ -45,7 +45,7 @@ static QueryGeometry (da, intended, desired) } InitializeMyDrawingAreaQueryGeometry(fn) -char *fn; + int (*fn)(); { querygeometryfunction = fn; } diff --git a/misc/compile-1.lisp b/misc/compile-1.lisp index a6dbf4eda84ef748a2b4e83021e1daa321fb8a3a..70f66a1c5e969e6bfee5d960c226640b3a812e20 100644 --- a/misc/compile-1.lisp +++ b/misc/compile-1.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- ;; -;; -[Tue Apr 14 15:22:38 1998 by layer]- +;; -[Thu Aug 6 14:41:46 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/misc/compile-1.lisp,v 1.34 1998/05/19 18:50:57 layer Exp $ +;; $Id: compile-1.lisp,v 1.35 1998/08/06 23:16:43 layer Exp $ (in-package :user) @@ -46,56 +46,47 @@ (setf (sys:gsgc-parameter :print) t) -;(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 (excl:find-system 'sys)) - (load "clim2:;sys;sysdcl")) - (excl:compile-system sys :include-components t) - (tenuring - (excl:load-system sys)) - - (progn - (excl:compile-system 'wnn :include-components t) - (excl:load-system 'wnn)) - - (excl:compile-system 'clim-homegrown) - - (load "clim2:;postscript;sysdcl") - (excl:compile-system 'postscript-clim :include-components t) - (excl:load-system 'postscript-clim) - - (compile-file-if-needed "clim2:;test;test-suite") + (with-compilation-unit () + (let ((excl::*update-entry-points* nil)) + (unless (ignore-errors (excl:find-system 'sys)) + (load "clim2:;sys;sysdcl")) + (excl:compile-system sys :include-components t) + (tenuring + (excl:load-system sys)) - (load "clim2:;test;test-suite") + (progn + (excl:compile-system 'wnn :include-components t) + (excl:load-system 'wnn)) - (load "clim2:;demo;sysdcl") - (excl:compile-system 'clim-demo :include-components t) - (excl:load-system 'clim-demo) + ;;(excl:compile-system 'clim-homegrown) - (progn - (load "clim2:;test;testdcl") - (tenuring - (excl:compile-system 'testing) - (excl:load-system 'testing))) + (load "clim2:;postscript;sysdcl") + (excl:compile-system 'postscript-clim :include-components t) + (excl:load-system 'postscript-clim) - (when (probe-file "clim2:;climtoys;sysdcl.lisp") - (load "clim2:;climtoys;sysdcl.lisp") - (excl:compile-system 'clim-toys)) + (compile-file-if-needed "clim2:;test;test-suite") - #+ignore (load "compatibility/sysdcl.lisp") - #+ignore (excl:compile-system 'clim-compatibility :include-components t) + (load "clim2:;test;test-suite") - (load "clim2:;hpgl;sysdcl") - (excl:compile-system 'hpgl-clim :include-components t) - (excl:load-system 'hpgl-clim) + (load "clim2:;demo;sysdcl") + (excl:compile-system 'clim-demo :include-components t) + (excl:load-system 'clim-demo) - )) + (progn + (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)) +;;; (load "compatibility/sysdcl.lisp") +;;; (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)))) diff --git a/misc/dev-load-1.lisp b/misc/dev-load-1.lisp index d24e2c2db3508edbbdf8905abcd3a1b2195dbc8a..d59a6a58167a5ecab9cede6a2fcd4171bb6e189b 100644 --- a/misc/dev-load-1.lisp +++ b/misc/dev-load-1.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- ;; -;; -[Thu Nov 10 11:24:22 1994 by smh]- +;; -[Mon Jul 6 15:36:40 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/misc/dev-load-1.lisp,v 1.39 1997/02/05 01:49:07 tomj Exp $ +;; $Id: dev-load-1.lisp,v 1.40 1998/08/06 23:16:43 layer Exp $ ;;;; This should not matter ;;;; (setq *ignore-package-name-case* t) @@ -33,8 +33,6 @@ (let ((*load-source-file-info* t) (*record-source-file-info* t) (*load-xref-info* nil)) - #+never (let ((*enable-package-locked-errors* nil)) - (load "sys/defsystem")) (load "clim2:;sys;sysdcl"))) (defun load-it (sys &key load-composer) diff --git a/misc/dump.lisp b/misc/dump.lisp index f9b0b2b510af74256ad8d2b145f2e9e48aa741cf..9231ecb4ed098d61da7553836e01e795b8ba9863 100644 --- a/misc/dump.lisp +++ b/misc/dump.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- ;; -;; -[Wed Oct 15 21:07:19 1997 by layer]- +;; -[Mon Jul 6 15:36:40 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/misc/dump.lisp,v 1.10 1997/10/20 23:11:06 layer Exp $ +;; $Id: dump.lisp,v 1.11 1998/08/06 23:16:43 layer Exp $ ;; Assuming CLIM is loaded, dump it into /usr/tmp/clim.temp_$USER. (room t) diff --git a/misc/pixmaps.lisp b/misc/pixmaps.lisp index 6d38bde5dcc48326a79cf95f92a08bfe847dc2f1..0dc52c7a79c62fc3cd096310c1c944ac3759e039 100644 --- a/misc/pixmaps.lisp +++ b/misc/pixmaps.lisp @@ -65,7 +65,7 @@ ;;; FEP 127, FEP0:>V127-lisp.flod(64), FEP0:>V127-loaders.flod(64), ;;; FEP0:>V127-info.flod(64), FEP0:>V127-debug.flod(38), 1067x752 B&W Screen, ;;; Machine serial number 10129, -;; $Header: /repo/cvs.copy/clim2/misc/pixmaps.lisp,v 1.5 1997/02/05 01:49:15 tomj Exp $ +;; $Id: pixmaps.lisp,v 1.6 1998/08/06 23:16:43 layer Exp $ #+Genera diff --git a/misc/train.lisp b/misc/train.lisp index 69c36c3a7654781ac629ab7a2c49f30f7011ce75..60d1ccce370dfe1826cd2ba4dda1782d6d2fd9e1 100644 --- a/misc/train.lisp +++ b/misc/train.lisp @@ -1,6 +1,6 @@ ; -*- mode: common-lisp; package: user -*- ;; -;; -[Thu Sep 2 10:17:42 1993 by layer]- +;; -[Mon Jul 6 15:36:39 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/misc/train.lisp,v 1.23 1997/02/05 01:49:17 tomj Exp $ +;; $Id: train.lisp,v 1.24 1998/08/06 23:16:44 layer Exp $ (defun train-clim (&key (train-times 2) (psview nil) diff --git a/postscript/laserwriter-metrics.lisp b/postscript/laserwriter-metrics.lisp index be303745f752a0ace46aeaaee07ef6a20c916add..79baf19adf6d73dc0ec42959cb56c838274306d2 100644 --- a/postscript/laserwriter-metrics.lisp +++ b/postscript/laserwriter-metrics.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/laserwriter-metrics.lisp,v 1.5 1997/02/05 01:49:32 tomj Exp $ +;; $Id: laserwriter-metrics.lisp,v 1.6 1998/08/06 23:16:46 layer Exp $ (in-package :postscript-clim) diff --git a/postscript/pkgdcl.lisp b/postscript/pkgdcl.lisp index b4038cf3bccb5c9b5908d8b87d773f2a75c8161c..884c6531f6540bbb3e87814851b31b3db573c69b 100644 --- a/postscript/pkgdcl.lisp +++ b/postscript/pkgdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/pkgdcl.lisp,v 1.9 1997/02/05 01:49:34 tomj Exp $ +;; $Id: pkgdcl.lisp,v 1.10 1998/08/06 23:16:47 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp index 7cefc3e243dc8cc8a37fb2ff2f430cdcafeca499..baa1be2060ccec9409f55a363b69587960d43c2a 100644 --- a/postscript/postscript-medium.lisp +++ b/postscript/postscript-medium.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/postscript-medium.lisp,v 1.21 1998/05/19 18:50:58 layer Exp $ +;; $Id: postscript-medium.lisp,v 1.22 1998/08/06 23:16:47 layer Exp $ (in-package :postscript-clim) @@ -290,7 +290,10 @@ (ps-pos-op medium "lineto" ex ey))))) (annotating-postscript (medium printer-stream) (format printer-stream " (medium-draw-polygon* ~A ...)" - position-seq))))) + position-seq))))) + +(defun nyi () + (error "This postscript operation is NYI (Not Yet Implemented).")) (defmethod medium-draw-ellipse* ((medium postscript-medium) center-x center-y diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp index d66cd70f1be4ee6cfb3ddecd9e633188376df39b..8242bff3f9e09b8b107231009e46bdae413a15b1 100644 --- a/postscript/postscript-port.lisp +++ b/postscript/postscript-port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/postscript-port.lisp,v 1.28 1998/03/21 01:55:02 smh Exp $ +;; $Id: postscript-port.lisp,v 1.29 1998/08/06 23:16:47 layer Exp $ (provide :climps) diff --git a/postscript/postscript-prefill.lisp b/postscript/postscript-prefill.lisp index 5d126ccd5a97ed731e8d278db48e67dfc6ab69c1..d0c7d3e8d7af1c126b9bbc166eb01c40ed3f944e 100644 --- a/postscript/postscript-prefill.lisp +++ b/postscript/postscript-prefill.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/postscript-prefill.lisp,v 1.5 1997/02/05 01:49:40 tomj Exp $ +;; $Id: postscript-prefill.lisp,v 1.6 1998/08/06 23:16:47 layer Exp $ (in-package :clim-postscript) diff --git a/postscript/postscript-s.lisp b/postscript/postscript-s.lisp index 77b29283b068075cc3ef64e19c3795f1c18180d4..ecb2b9b37f10ac03bbc7e7ddf4c05b35cb510c33 100644 --- a/postscript/postscript-s.lisp +++ b/postscript/postscript-s.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: postscript-clim -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:37 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/postscript/postscript-s.lisp,v 1.4 1997/02/05 01:49:41 tomj Exp $ +;; $Id: postscript-s.lisp,v 1.5 1998/08/06 23:16:47 layer Exp $ (in-package :postscript-clim) diff --git a/postscript/read-afm.lisp b/postscript/read-afm.lisp index 45657665697a456556e92c67b0f6824964706ba2..8e480a77f5acd26f3b9c771c876030342aab91f9 100644 --- a/postscript/read-afm.lisp +++ b/postscript/read-afm.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: postscript-clim -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:37 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/postscript/read-afm.lisp,v 1.4 1997/02/05 01:49:43 tomj Exp $ +;; $Id: read-afm.lisp,v 1.5 1998/08/06 23:16:47 layer Exp $ (in-package :postscript-clim) diff --git a/postscript/sysdcl-pc.lisp b/postscript/sysdcl-pc.lisp index c3ff8ff53e6667c52f6edc016f638932eb740ab7..eea35e1fa8b7a48c954da791f7d4a3efe796f1bb 100644 --- a/postscript/sysdcl-pc.lisp +++ b/postscript/sysdcl-pc.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/sysdcl-pc.lisp,v 1.2 1997/05/24 03:52:43 tomj Exp $ +;; $Id: sysdcl-pc.lisp,v 1.3 1998/08/06 23:16:48 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/postscript/sysdcl.lisp b/postscript/sysdcl.lisp index ba6944bfe528adc1a62d8f287be1e5743ff382c2..382e78ffa33294c096576cc40a30e15f6d173914 100644 --- a/postscript/sysdcl.lisp +++ b/postscript/sysdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/postscript/sysdcl.lisp,v 1.13 1998/05/19 18:50:58 layer Exp $ +;; $Id: sysdcl.lisp,v 1.14 1998/08/06 23:16:48 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/pre-silica/cloe-applications.lisp b/pre-silica/cloe-applications.lisp index c9c2328441e8c92be2c9ca1f421abb52091d84e6..b1eae21b7a29e8963429ad0586b0362a3cbdc679 100644 --- a/pre-silica/cloe-applications.lisp +++ b/pre-silica/cloe-applications.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/cloe-applications.lisp,v 1.6 1997/02/05 01:49:51 tomj Exp $ +;; $Id: cloe-applications.lisp,v 1.7 1998/08/06 23:16:50 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/cloe-events.lisp b/pre-silica/cloe-events.lisp index 49b2d9e158c69689cbec229e70580fe9ead8749c..a122ed0945c34de2aa2941dbaea8b7eb59b4c76c 100644 --- a/pre-silica/cloe-events.lisp +++ b/pre-silica/cloe-events.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/cloe-events.lisp,v 1.7 1997/02/05 01:49:53 tomj Exp $ +;; $Id: cloe-events.lisp,v 1.8 1998/08/06 23:16:50 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/cloe-implementation.lisp b/pre-silica/cloe-implementation.lisp index 6308b8d0cfd8e29a27ea8f8f2fc0ddeeaeede752..adfb2d2df0be6110f40f660c0aac34d2de86ef4f 100644 --- a/pre-silica/cloe-implementation.lisp +++ b/pre-silica/cloe-implementation.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/cloe-implementation.lisp,v 1.9 1997/02/05 01:49:54 tomj Exp $ +;; $Id: cloe-implementation.lisp,v 1.10 1998/08/06 23:16:50 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/clx-implementation.lisp b/pre-silica/clx-implementation.lisp index 50c7cd755a0d56320158bb5c79721b4c410d2c45..72b6cf7c649977ee14ba0b41859e9a99da01bcf7 100644 --- a/pre-silica/clx-implementation.lisp +++ b/pre-silica/clx-implementation.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/clx-implementation.lisp,v 1.10 1997/02/05 01:49:57 tomj Exp $ +;; $Id: clx-implementation.lisp,v 1.11 1998/08/06 23:16:51 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/default-application.lisp b/pre-silica/default-application.lisp index 670761b0b169cfd37921a3ac49a8dc77ce2c5664..ce985076cb6189cd11be86fd345b74591a51b4d7 100644 --- a/pre-silica/default-application.lisp +++ b/pre-silica/default-application.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/default-application.lisp,v 1.10 1997/02/05 01:49:59 tomj Exp $ +;; $Id: default-application.lisp,v 1.11 1998/08/06 23:16:51 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/define-application.lisp b/pre-silica/define-application.lisp index 4bd5377d827495e28ae13cf9d7406e6df4b17fd4..481df23ad89ebb34fcaa776f2c5a04276841dc92 100644 --- a/pre-silica/define-application.lisp +++ b/pre-silica/define-application.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/define-application.lisp,v 1.8 1997/02/05 01:50:01 tomj Exp $ +;; $Id: define-application.lisp,v 1.9 1998/08/06 23:16:51 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/defs-graphics-generics.lisp b/pre-silica/defs-graphics-generics.lisp index 75b26d763ab2e8f7ee78f1c7192e03145143be51..d4e792e6a06572529f75ef91faa68513493cd525 100644 --- a/pre-silica/defs-graphics-generics.lisp +++ b/pre-silica/defs-graphics-generics.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/defs-graphics-generics.lisp,v 1.9 1997/02/05 01:50:03 tomj Exp $ +;; $Id: defs-graphics-generics.lisp,v 1.10 1998/08/06 23:16:51 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/drawing-state-mixin.lisp b/pre-silica/drawing-state-mixin.lisp index 2530bba3e03c2b220b93f567901bed6c12dd05fc..cc93c0faf0ad1f8e58c0b350fe2e380a0af94722 100644 --- a/pre-silica/drawing-state-mixin.lisp +++ b/pre-silica/drawing-state-mixin.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/drawing-state-mixin.lisp,v 1.8 1997/02/05 01:50:05 tomj Exp $ +;; $Id: drawing-state-mixin.lisp,v 1.9 1998/08/06 23:16:51 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/genera-implementation.lisp b/pre-silica/genera-implementation.lisp index 32f36272afb39b5da9fe41ddbeb2e614e81bced9..b89fd1877bc8c8f33921480433775b9af1eec681 100644 --- a/pre-silica/genera-implementation.lisp +++ b/pre-silica/genera-implementation.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/genera-implementation.lisp,v 1.9 1997/02/05 01:50:07 tomj Exp $ +;; $Id: genera-implementation.lisp,v 1.10 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/graphics-generics.lisp b/pre-silica/graphics-generics.lisp index 50bd3fd6622514c686d0e15eee7010d8e03fd036..472c21fc11738aa8efb17d22744aa58b613e1a22 100644 --- a/pre-silica/graphics-generics.lisp +++ b/pre-silica/graphics-generics.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/graphics-generics.lisp,v 1.7 1997/02/05 01:50:09 tomj Exp $ +;; $Id: graphics-generics.lisp,v 1.8 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/graphics-internals.lisp b/pre-silica/graphics-internals.lisp index 30ccee5976ff87acc2d348987103da05b892cba3..939e8e9177d7a7903eff595e67147c2ab78c4e08 100644 --- a/pre-silica/graphics-internals.lisp +++ b/pre-silica/graphics-internals.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/graphics-internals.lisp,v 1.8 1997/02/05 01:50:11 tomj Exp $ +;; $Id: graphics-internals.lisp,v 1.9 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/laserwriter-metrics.lisp b/pre-silica/laserwriter-metrics.lisp index 206ec9dac53a18cf16ad3056b08f57705488f9cc..84c8da0f471d7b3590b545e584294095b53ddd07 100644 --- a/pre-silica/laserwriter-metrics.lisp +++ b/pre-silica/laserwriter-metrics.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/laserwriter-metrics.lisp,v 1.6 1997/02/05 01:50:13 tomj Exp $ +;; $Id: laserwriter-metrics.lisp,v 1.7 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/postscript-implementation.lisp b/pre-silica/postscript-implementation.lisp index be2d2d202c0d311a1d33d063f3c693ad165a74a8..23fbe77188a52930b6003229056bed75ebece44b 100644 --- a/pre-silica/postscript-implementation.lisp +++ b/pre-silica/postscript-implementation.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/postscript-implementation.lisp,v 1.8 1997/02/05 01:50:15 tomj Exp $ +;; $Id: postscript-implementation.lisp,v 1.9 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/protocol-intermediaries.lisp b/pre-silica/protocol-intermediaries.lisp index 0a2636f900801a9fd16a8a86e914cccdd02a24dc..727427f44747d3059478237163d44ef543751ff5 100644 --- a/pre-silica/protocol-intermediaries.lisp +++ b/pre-silica/protocol-intermediaries.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/protocol-intermediaries.lisp,v 1.7 1997/02/05 01:50:17 tomj Exp $ +;; $Id: protocol-intermediaries.lisp,v 1.8 1998/08/06 23:16:52 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/vertical-string.lisp b/pre-silica/vertical-string.lisp index b8963a62702d2e74fc6a223a6650f818d729b2ae..0c97768bc9f5df98cf520c4e56195a14dc61c6b6 100644 --- a/pre-silica/vertical-string.lisp +++ b/pre-silica/vertical-string.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/vertical-string.lisp,v 1.6 1997/02/05 01:50:19 tomj Exp $ +;; $Id: vertical-string.lisp,v 1.7 1998/08/06 23:16:53 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/wheader.lisp b/pre-silica/wheader.lisp index ca74c627b02e0d7a0d7dbc02cd0ea1c74b56e8c1..4fdc2654d22d5c8cad5f61af972dffa985506c52 100644 --- a/pre-silica/wheader.lisp +++ b/pre-silica/wheader.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/wheader.lisp,v 1.6 1997/02/05 01:50:21 tomj Exp $ +;; $Id: wheader.lisp,v 1.7 1998/08/06 23:16:53 layer Exp $ ;;; "Translated" from \sys\include\windows.h diff --git a/pre-silica/window-protocol.lisp b/pre-silica/window-protocol.lisp index e7143d2459821a4a0c57cf23e355d2d4b3da067f..ec64a39246cac11d1e92373c8fdc1d5931306982 100644 --- a/pre-silica/window-protocol.lisp +++ b/pre-silica/window-protocol.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/window-protocol.lisp,v 1.10 1997/02/05 01:50:23 tomj Exp $ +;; $Id: window-protocol.lisp,v 1.11 1998/08/06 23:16:53 layer Exp $ (in-package :clim-internals) diff --git a/pre-silica/windows.lisp b/pre-silica/windows.lisp index d008418d71124a327b17a47ec7c166215e695f29..3b49a796656b7f1169930d64fe8bff129e4134dc 100644 --- a/pre-silica/windows.lisp +++ b/pre-silica/windows.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/pre-silica/windows.lisp,v 1.6 1997/02/05 01:50:25 tomj Exp $ +;; $Id: windows.lisp,v 1.7 1998/08/06 23:16:53 layer Exp $ (in-package :win) diff --git a/readme.win32 b/readme.win32 new file mode 100644 index 0000000000000000000000000000000000000000..0b1e8003957a69be8c3d8cb54cd1cd2ec46bbff5 --- /dev/null +++ b/readme.win32 @@ -0,0 +1,76 @@ + CLIM 2.2.1 for ACL 5.0.beta + Windows 95 and NT 4.0 + +Files in this release: + +clim221.txt + This file. +code/climnt.fasl +code/climg.fasl +code/climps.fasl +code/climdemo.fasl + The above are the fasl files making up the product. +code/winapi.fasl +code/winapi-dev.fasl + The above are updated fasl with respect to 5.0.beta. +src/clim/demo/ + The source files to the CLIM demos. + +To use CLIM on Windows evaluate this form: + (require :climnt) + +To run the CLIM demos, evaluate these forms: + (require :climdemo) + (clim-demo:start-demo) + +There are several known problems with the current release. + +1. This version of CLIM only works in a case insensitive Lisp. We + hope to fix this for the final release. + +2. In this version, you must call run-frame-top-level in the same + thread or Lisp "process" that you call + make-application-frame. This is a limitation imposed by Windows + and is related to the way that SendMessage() must work. Windows + wants a window to be closely linked to the thread that created it. + This limitation is not present in UNIX versions of CLIM, and as a + result UNIX clim code may not run without some modification. An + error will be signalled if this constraint is violated. This + limitation was not present in the alpha release of CLIM for NT + because all Lisp "processes" ran in a single operating system + thread. + + For example, you must replace this: + (let ((frame (make-application-frame 'mine))) + (mp:process-run-function #'run-frame-top-level frame)) + + with something like this: + (mp:process-run-function + #'(lambda () + (run-frame-top-level (make-application-frame 'mine)))) + +Changes since the alpha release of CLIM: + +1. CLIM is not distributed as a Lisp image file anymore. It is + distributed as a set of fasl files. You can build a clim.dxl by + loading <acl dir>/buildclim.cl. It will create a clim.exe and + clim.dxl. You can then run CLIM by executing clim.exe. + + You can also build applications using generate-application and + putting the appropriate require's (of :climnt) in your sources. + +2. Windows 95 is supported. + +3. CLIM applications are about 10 megabytes smaller. + +4. CLIM follows more of the Windows User Interface guidelines. This + includes windows that are LtGray, dialog boxes that are + application-modal, and menus that are "native." + +5. select-file now uses the familiar windows dialog boxes via calls + to GetOpenFileName() and GetSaveFileName(). Use the keyword + :DIALOG-TYPE with a value of either :OPEN or :SAVE to control + which one you want. + +6. notify-user now uses the familiar windows dialog boxes via calls + to MessageBox(). diff --git a/silica/classes.lisp b/silica/classes.lisp index 0d19f1e5ca045fa7082dbcf9a582f07d872bc4a1..bfc5ac283a5cd0732486ec6d37310ab77b267b24 100644 --- a/silica/classes.lisp +++ b/silica/classes.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/classes.lisp,v 1.40 1998/05/19 18:51:00 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: classes.lisp,v 1.41 1998/08/06 23:16:56 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." (define-protocol-class port ()) @@ -98,16 +114,19 @@ (define-protocol-class medium ()) -(locally -(declare (special *default-text-style*)) +(locally (declare (special *default-text-style* + *default-pane-foreground* + *default-pane-background*)) ;; This is called BASIC-MEDIUM rather than STANDARD-MEDIUM because the class ;; cannot be used as-is. It has to be specialized for each implementation. (defclass basic-medium (medium) ((port :initarg :port :reader port) (sheet :initarg :sheet :initform nil :accessor medium-sheet) - (foreground :initform +black+ :accessor medium-foreground) - (background :initform +white+ :accessor medium-background) + (foreground :initform *default-pane-background* + :accessor medium-foreground) + (background :initform *default-pane-foreground* + :accessor medium-background) (ink :initform +foreground-ink+ :accessor medium-ink) (text-style :initform nil :accessor medium-text-style) (default-text-style :initform *default-text-style* diff --git a/silica/clim.lisp b/silica/clim.lisp index 07324d5db3c6145e6ff3722b185c319f1b4ca3df..66d96d7dbcc6180a42185320f898e0f918b8afcd 100644 --- a/silica/clim.lisp +++ b/silica/clim.lisp @@ -1,7 +1,6 @@ ;; -*- mode: common-lisp; package: silica -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/silica/clim.lisp,v 1.7 1998/05/19 18:51:00 layer Exp $ +;; $Id: clim.lisp,v 1.8 1998/08/06 23:16:56 layer Exp $ (in-package :silica) diff --git a/silica/db-border.lisp b/silica/db-border.lisp index 09272e238596fedac18890f844f247485ce36070..fb17e868a7e575ea1160963424e599950ed56851 100644 --- a/silica/db-border.lisp +++ b/silica/db-border.lisp @@ -1,9 +1,25 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-border.lisp,v 1.25 1998/05/19 18:51:01 layer Exp $ - -"Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. - Portions copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-border.lisp,v 1.26 1998/08/06 23:16:56 layer Exp $ + +;;;"Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. +;;; Portions copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved." (in-package :silica) @@ -45,19 +61,17 @@ (defun repaint-border-pane (pane) (with-sheet-medium (medium pane) (with-bounding-rectangle* (left top right bottom) - (sheet-region pane) + (sheet-region pane) (let* ((thickness (slot-value pane 'thickness)) - ;; this used to be ceiling but it sometimes caused - ;; borders to overwrite the child pane - which played - ;; havoc with the flipping-ink mechanism used to draw the - ;; cursor (cim 9/14/95) + ;; this used to be ceiling but it sometimes caused + ;; borders to overwrite the child pane - which played + ;; havoc with the flipping-ink mechanism used to draw the + ;; cursor (cim 9/14/95) (ht (floor thickness 2))) - (when #-(or aclpc acl86win32) t - #+(or aclpc acl86win32) (> thickness 1) - (incf left ht) - (incf top ht) - (decf right ht) - (decf bottom ht)) + (incf left ht) + (incf top ht) + (decf right ht) + (decf bottom ht) (draw-rectangle* medium left top right bottom :line-thickness thickness :filled nil :ink (border-color pane)))))) @@ -133,14 +147,14 @@ ,(if (constantp label-alignment #+(or Genera Minima) env) (ecase (eval label-alignment #+(or Genera Minima-Developer) env) (:bottom - `(vertically () ,cvar #+acl86win32 :fill ,lvar)) + `(vertically () ,cvar ,lvar)) (:top - `(vertically () ,lvar #+acl86win32 :fill ,cvar))) + `(vertically () ,lvar ,cvar))) `(ecase ,label-alignment (:bottom - (vertically () ,cvar #+acl86win32 :fill ,lvar)) + (vertically () ,cvar ,lvar)) (:top - (vertically () ,lvar #+acl86win32 :fill ,cvar))))))) + (vertically () ,lvar ,cvar))))))) diff --git a/silica/db-box.lisp b/silica/db-box.lisp index 5d2ba78218729fc44e32d8bc1c3deb94757868ca..618ca95b54bb59ec13b86c7bca6bf1d770574691 100644 --- a/silica/db-box.lisp +++ b/silica/db-box.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-box.lisp,v 1.29 1998/05/19 18:51:02 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-box.lisp,v 1.30 1998/08/06 23:16:56 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." ;;; diff --git a/silica/db-button.lisp b/silica/db-button.lisp index 8c517f83f8554cea8fa09ec15abd3636104a5f1e..e504f4585d3839cbfce7351950cde57d6ee93144 100644 --- a/silica/db-button.lisp +++ b/silica/db-button.lisp @@ -1,9 +1,25 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-button.lisp,v 1.23 1998/05/19 18:51:02 layer Exp $ - -"Copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved. - Portions copyright (c) 1990, 1991 International Lisp Associates." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-button.lisp,v 1.24 1998/08/06 23:16:57 layer Exp $ + +;;;"Copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1990, 1991 International Lisp Associates." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends diff --git a/silica/db-label.lisp b/silica/db-label.lisp index 2528d35af63af60ff71123dd1fc7e50bc6085b43..4a099262906690b3cdbbdaceeaf102ff94ad4a9b 100644 --- a/silica/db-label.lisp +++ b/silica/db-label.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: silica -*- -;; -;; -[Thu Jul 22 17:16:08 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -16,11 +13,10 @@ ;; Use, duplication, and disclosure of the software, data and information ;; contained herein by any agency, department or entity of the U.S. ;; Government are subject to restrictions of Restricted Rights for -;; Commercial Software developed at private expense as specified in FAR -;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as -;; applicable. +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/silica/db-label.lisp,v 1.5 1998/05/19 18:51:02 layer Exp $ +;; $Id: db-label.lisp,v 1.6 1998/08/06 23:16:57 layer Exp $ ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends @@ -48,6 +44,7 @@ (defmethod handle-repaint ((pane generic-label-pane) region) (declare (ignore region)) ;not worth checking (with-sheet-medium (medium pane) + (window-clear medium) (with-bounding-rectangle* (left top right bottom) (sheet-region pane) (declare (ignore bottom)) ;; fixed bug when :align-x not :left (cim 10/14/96) diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp index 798807eceecfc292c3b514a04ce96f9c6738973e..b3260928639e35dc624f05c70a0c90f44cc791e2 100644 --- a/silica/db-layout.lisp +++ b/silica/db-layout.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-layout.lisp,v 1.39 1998/05/19 18:51:03 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-layout.lisp,v 1.40 1998/08/06 23:16:57 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." ;;; diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp index c7da6d5321085213e02ce34eba4700800650d004..2b30669a5fb67a54436fa5c30064a7a7def6d9b3 100644 --- a/silica/db-scroll.lisp +++ b/silica/db-scroll.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-scroll.lisp,v 1.58 1998/05/19 18:51:04 layer Exp $ - -"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. - Portions copyright(c) 1991, 1992 International Lisp Associates. - Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-scroll.lisp,v 1.59 1998/08/06 23:16:57 layer Exp $ + +;;;"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. +;;; Portions copyright(c) 1991, 1992 International Lisp Associates. +;;; Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." (in-package :silica) @@ -84,83 +100,48 @@ (when viewport (update-scroll-bars viewport))))) -;;;#+(or aclpc acl86win32) -;;;(eval-when (compile load eval) -;;; ;;mm: 11Jan95 - this is defined later in ??? -;;; (unless (ignore-errors (find-class 'generic-scroller-pane)) -;;; (defclass generic-scroller-pane () ()))) - - (defun update-scroll-bars (viewport) (unless *inhibit-updating-scroll-bars* ;;--- This is not the most efficient thing in the world (let ((scroller (viewport-scroller-pane viewport)) (contents (viewport-contents-extent viewport))) - - #+ignore - (multiple-value-bind (changedp - hscroll-bar hscroll-bar-enabled-p - vscroll-bar vscroll-bar-enabled-p) - (compute-dynamic-scroll-bar-values scroller) - (update-dynamic-scroll-bars - scroller changedp - hscroll-bar hscroll-bar-enabled-p - vscroll-bar vscroll-bar-enabled-p t)) - ;;--- next bit new [tjm 15Mar97] otherwise buffered ;;--- text-output-record not considered [spr15933] (with-bounding-rectangle* (left top right bottom) contents (when (output-recording-stream-p contents) - (let ((pending-text (slot-value contents 'clim-internals::text-output-record))) + (let ((pending-text + (slot-value contents 'clim-internals::text-output-record))) (when pending-text - (with-bounding-rectangle* (tleft ttop tright tbottom) pending-text + (with-bounding-rectangle* (tleft ttop tright tbottom) + pending-text (declare (ignore tleft ttop)) (maxf right tright) (maxf bottom tbottom))))) (with-bounding-rectangle* (vleft vtop vright vbottom) (viewport-viewport-region viewport) - (let* ((vertical-scroll-bar (scroller-pane-vertical-scroll-bar scroller)) - (horizontal-scroll-bar (scroller-pane-horizontal-scroll-bar scroller))) - (if (progn - #+(or aclpc acl86win32) - ;; Not normally defined, because none of the files in - ;; homegrown are loaded on Windows. - (ignore-errors - (typep scroller 'silica::generic-scroller-pane)) - #-(or aclpc acl86win32) t) - (progn - (minf left vleft) - (minf top vtop) - (maxf right vright) - (maxf bottom vbottom) - (when vertical-scroll-bar - (update-scroll-bar vertical-scroll-bar - top bottom - vtop vbottom - :vertical)) - (when horizontal-scroll-bar - (update-scroll-bar horizontal-scroll-bar - left right - vleft vright - :horizontal))) - #+(or aclpc acl86win32) - (progn - (when vertical-scroll-bar - (update-mswin-sbar vertical-scroll-bar - top bottom - vtop vbottom - :vertical)) - (when horizontal-scroll-bar - (update-mswin-sbar horizontal-scroll-bar - left right - vleft vright - :horizontal))) - ))))))) + (let* ((vertical-scroll-bar + (scroller-pane-vertical-scroll-bar scroller)) + (horizontal-scroll-bar + (scroller-pane-horizontal-scroll-bar scroller))) + (minf left vleft) + (minf top vtop) + (maxf right vright) + (maxf bottom vbottom) + (when vertical-scroll-bar + (update-scroll-bar vertical-scroll-bar + top bottom + vtop vbottom + :vertical)) + (when horizontal-scroll-bar + (update-scroll-bar horizontal-scroll-bar + left right + vleft vright + :horizontal)))))))) ;;--- In the case where the viewport is bigger than the window this ;;--- code gets things wrong. Check out the thinkadot demo. It's ;;--- because (- (--) (- vmin)) is negative. -(defun update-scroll-bar (scroll-bar min max vmin vmax orientation) +(defmethod update-scroll-bar (scroll-bar min max vmin vmax orientation) (declare (optimize (safety 0) (speed 3))) ;;-- Is this really the right thing to do? ;;-- If in an interactor some draws at -ve coordinates but the diff --git a/silica/db-slider.lisp b/silica/db-slider.lisp index b3fb6aed9f92083682586619bf65b4757c686389..623904861fb901a14d3affe4616a7d5ce4474a2b 100644 --- a/silica/db-slider.lisp +++ b/silica/db-slider.lisp @@ -1,8 +1,24 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-slider.lisp,v 1.21 1998/08/06 23:16:58 layer Exp $ -;; $Header: /repo/cvs.copy/clim2/silica/db-slider.lisp,v 1.20 1998/05/19 18:51:04 layer Exp $ - -"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 by Symbolics, Inc. All rights reserved." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends diff --git a/silica/db-table.lisp b/silica/db-table.lisp index 77fdd7cbd370a5c454b5a8ab2682670d51bbe217..e4a0600802fc77fe7a4bc9ba070040d5fbd306d9 100644 --- a/silica/db-table.lisp +++ b/silica/db-table.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/db-table.lisp,v 1.20 1998/05/19 18:51:04 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: db-table.lisp,v 1.21 1998/08/06 23:16:58 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." ;;; diff --git a/silica/event.lisp b/silica/event.lisp index d7d25d3c9cbc152e97da489b52ec9c5bd344387c..356731c40f9a580185358dc380657414899d4e59 100644 --- a/silica/event.lisp +++ b/silica/event.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/event.lisp,v 1.43 1998/05/19 18:51:04 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: event.lisp,v 1.44 1998/08/06 23:16:58 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." (defgeneric process-next-event (port &key wait-function timeout)) diff --git a/silica/framem.lisp b/silica/framem.lisp index 9edd5fe369142f4caaa89f973cb70271cb42eb34..eaaac45c4f2a7875ed06e11a66c22973ae4e8c8c 100644 --- a/silica/framem.lisp +++ b/silica/framem.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/framem.lisp,v 1.35 1998/05/19 18:51:04 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: framem.lisp,v 1.36 1998/08/06 23:16:58 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." (define-protocol-class frame-manager ()) diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index 0d5678ad3c5a3aec561b8bc09189c586f0f696c7..faecd89d4ce947142adae43a2eab4a136ff73b70 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -1,9 +1,25 @@ ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/gadgets.lisp,v 1.66 1998/05/19 18:51:05 layer Exp $ - -"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. - Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: gadgets.lisp,v 1.67 1998/08/06 23:16:58 layer Exp $ + +;;;"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." (in-package :silica) diff --git a/silica/graphics.lisp b/silica/graphics.lisp index 300ff088678986335d54b1cd4e027427222f2bc4..448bac3f46244afc60e16c23e113ec5d528fb897 100644 --- a/silica/graphics.lisp +++ b/silica/graphics.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/graphics.lisp,v 1.33 1998/05/19 18:51:05 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: graphics.lisp,v 1.34 1998/08/06 23:16:59 layer Exp $ (in-package :silica) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." (eval-when (compile load eval) diff --git a/silica/layout.lisp b/silica/layout.lisp index 07a38e50de029eb42f68567963ab6d5122dc4dbe..bd0e93097dde30e408ef855e16866e5d32c0cc0a 100644 --- a/silica/layout.lisp +++ b/silica/layout.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/layout.lisp,v 1.36 1998/05/19 18:51:05 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: layout.lisp,v 1.37 1998/08/06 23:16:59 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 Xerox Corp. All rights reserved." (define-protocol-class space-requirement ()) diff --git a/silica/macros.lisp b/silica/macros.lisp index 8ec5b9ecdc5405dea4899a9730805cb75f97fbe0..065bead81fbb4d93d3cd0db7ac33c1f3c101c959 100644 --- a/silica/macros.lisp +++ b/silica/macros.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/macros.lisp,v 1.17 1998/05/19 18:51:05 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: macros.lisp,v 1.18 1998/08/06 23:16:59 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." (defmacro with-sheet-medium ((medium sheet) &body body) diff --git a/silica/medium.lisp b/silica/medium.lisp index f7dfb9c4d4a648a0f26c47f5bb67006eab4213d7..891e225ddb0c7083f87a0ad5f99970b2f89fd308 100644 --- a/silica/medium.lisp +++ b/silica/medium.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/medium.lisp,v 1.43 1998/05/19 18:51:05 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: medium.lisp,v 1.44 1998/08/06 23:16:59 layer Exp $ (in-package :silica) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." (defgeneric medium-drawable (medium)) diff --git a/silica/mirror.lisp b/silica/mirror.lisp index 1139c3c8dd281fda0acdc170518bc9339ffc9484..41c05ef4781bcd9167ee8e7b9d582b8ffdbc4c87 100644 --- a/silica/mirror.lisp +++ b/silica/mirror.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/silica/mirror.lisp,v 1.37 1998/05/19 18:51:06 layer Exp $ - +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: mirror.lisp,v 1.38 1998/08/06 23:17:00 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; WARNING: DON'T LOAD THIS INTO THE ACLPC/ACLNT VERSION AS IT ;;; REDEFINES SOMETHING WHICH CAUSES CLIM TO BREAK IF IT'S NOT LOADED diff --git a/silica/pixmaps.lisp b/silica/pixmaps.lisp index 37b4dab5833353e8e0b5068202d45ec0f11bf3cf..d4a408e8348d9ceabfb40143653cd129c00a8334 100644 --- a/silica/pixmaps.lisp +++ b/silica/pixmaps.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/pixmaps.lisp,v 1.21 1998/05/19 18:51:07 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: pixmaps.lisp,v 1.22 1998/08/06 23:17:00 layer Exp $ (in-package :silica) -"Copyright (c) 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." ;;; Pixmaps diff --git a/silica/port.lisp b/silica/port.lisp index fc27b41df88321bb7f5413fe1594fbe8197adbe6..51f5d064264c21d61fc3a74fde82046adc2d2915 100644 --- a/silica/port.lisp +++ b/silica/port.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/port.lisp,v 1.39 1998/05/19 18:51:07 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: port.lisp,v 1.40 1998/08/06 23:17:00 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." ;; Ports and grafts diff --git a/silica/protocols.lisp b/silica/protocols.lisp index 78eedaa15eec374a009fd76e0c81671b99aa5202..257caad271cf4260c582ebcdc348ce4ed19edb40 100644 --- a/silica/protocols.lisp +++ b/silica/protocols.lisp @@ -1,7 +1,6 @@ ;;; -*- Mode: Lisp; Package: CLIM-UTILS; Base: 10.; Syntax: Common-Lisp -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,10 +16,11 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; +;; $Id: protocols.lisp,v 1.8 1998/08/06 23:17:00 layer Exp $ + ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. ;;; -;; $Header: /repo/cvs.copy/clim2/silica/protocols.lisp,v 1.7 1998/05/19 18:51:07 layer Exp $ (in-package :clim-utils) diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp index a18d4da8630c4e7b17ef958570c14e627e331bdf..552a4cd916ebbd3e9c99745864421a4650f3810a 100644 --- a/silica/scroll-pane.lisp +++ b/silica/scroll-pane.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/scroll-pane.lisp,v 1.9 1998/05/19 18:51:07 layer Exp $ - -"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. - Portions copyright(c) 1991, 1992 International Lisp Associates. - Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: scroll-pane.lisp,v 1.10 1998/08/06 23:17:02 layer Exp $ + +;;;"Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. +;;; Portions copyright(c) 1991, 1992 International Lisp Associates. +;;; Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." ;;; This file also exists in clim2/homegrown. The homegrown directory ;;; contains files to implement CLIM's generic gadgets. Native backends diff --git a/silica/sheet.lisp b/silica/sheet.lisp index f788937135065c2223f1851f1876fb99e5a66f0a..0201a2a717a7ef46602647d679b6cf1852eaceb2 100644 --- a/silica/sheet.lisp +++ b/silica/sheet.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/sheet.lisp,v 1.43 1998/05/19 18:51:08 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sheet.lisp,v 1.44 1998/08/06 23:17:02 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Symbolics, Inc. All rights reserved." (defgeneric sheet-parent (sheet)) diff --git a/silica/std-sheet.lisp b/silica/std-sheet.lisp index f914b60378717519f5ee0403382e3b0b33183d1f..3b77df7adfb8c15182229395ce1e02bc790e379b 100644 --- a/silica/std-sheet.lisp +++ b/silica/std-sheet.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/std-sheet.lisp,v 1.13 1998/05/19 18:51:08 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: std-sheet.lisp,v 1.14 1998/08/06 23:17:02 layer Exp $ (in-package :silica) -"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Franz, Inc. All rights reserved." (defclass standard-sheet diff --git a/silica/text-style.lisp b/silica/text-style.lisp index ef1e99aefb6d63e21c2a18e0cbc60c1e02c0c32c..65a7ebcd12e4b75e502e5944b7108f5377e4039a 100644 --- a/silica/text-style.lisp +++ b/silica/text-style.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/silica/text-style.lisp,v 1.28 1998/05/19 18:51:08 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: text-style.lisp,v 1.29 1998/08/06 23:17:02 layer Exp $ (in-package :silica) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; To consider: how to merge Genera styles with styles. diff --git a/sys/compile.lisp b/sys/compile.lisp index 01e1b4d4d7c40d0c23f76fdbe04a5deaed851910..adcd54821020ff9dd2cfc2fe8fb9e9d790fc797c 100644 --- a/sys/compile.lisp +++ b/sys/compile.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: compile.lisp,v 1.7 1998/08/06 23:17:05 layer Exp $ + (in-package :user) #+allegro @@ -109,7 +128,8 @@ "aclpc/acl-pixmaps.fasl" "aclpc/acl-frames.fasl" "aclpc/acl-widget.fasl" - "aclpc/acl-scroll.fasl") + "aclpc/acl-scroll.fasl" + "utils/last.fasl") "climnt.fasl") (append-files '("postscript/postscript-port.fasl" "postscript/postscript-medium.fasl" diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp index 0496a809f4e356c9e9f188640339f4d0aa62b3d1..fb4baae2f4563946237bb74c82f1ef296166850a 100644 --- a/sys/defsystem.lisp +++ b/sys/defsystem.lisp @@ -1,4 +1,22 @@ ;;; -*-Mode: Lisp; Syntax: ANSI-Common-lisp; Package: CLIM-DEFSYSTEM; Base: 10; Lowercase: Yes -*- +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defsystem.lisp,v 1.23 1998/08/06 23:17:05 layer Exp $ ;;; ;;; DEFSYSTEM Utility @@ -27,8 +45,6 @@ ;;; ;;;----------------------------------------------------------- -;; $Header: /repo/cvs.copy/clim2/sys/defsystem.lisp,v 1.22 1997/02/05 01:51:38 tomj Exp $ - ;; Add a feature for ANSI-adhering Lisps. So far, only Apple's ;; version 2.0 tries to do adhere to the ANSI spec instead of CLtL rev 1. ;; Yes, I know it's not yet an ANSI spec. That's why this is called diff --git a/sys/distribution-script.lisp b/sys/distribution-script.lisp index 653769c285bbf1620c49fc6bdf17974682466967..85610b58d86b568b876743669921da1ba81216af 100644 --- a/sys/distribution-script.lisp +++ b/sys/distribution-script.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/sys/distribution-script.lisp,v 1.8 1997/02/05 01:51:40 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: distribution-script.lisp,v 1.9 1998/08/06 23:17:05 layer Exp $ #| :Distribute Systems CLIM-BINARIES Latest :Distribute Patch Sources No :Include Patches Yes :Query Confirm-Only :Machine Types Imach :File Types Binaries diff --git a/sys/do.lisp b/sys/do.lisp index 46bc6ee00673e14a9318a6560e93d20f50adf405..fef149722c0999a439b36306a9f2be248703a762 100644 --- a/sys/do.lisp +++ b/sys/do.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: do.lisp,v 1.4 1998/08/06 23:17:06 layer Exp $ + (in-package :user) ;;; In order to build and load versions of clim, changes in diff --git a/sys/fids-pre.lisp b/sys/fids-pre.lisp index 5d321e7cdcc3f4d38f263577bf509c0cd5664615..20545a2e31010f1c7d1e27434ea17ad372eaada7 100644 --- a/sys/fids-pre.lisp +++ b/sys/fids-pre.lisp @@ -1,3 +1,21 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: fids-pre.lisp,v 1.2 1998/08/06 23:17:06 layer Exp $ (defpackage "SYSTEM" diff --git a/sys/load-clim2.lisp b/sys/load-clim2.lisp index 7f34eafe2aa27509e3cedaf74592fe2c2ed1d099..ae28095e48fbee12b2b1ee4ab8fb9b117355aaa5 100644 --- a/sys/load-clim2.lisp +++ b/sys/load-clim2.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/sys/load-clim2.lisp,v 1.6 1997/02/05 01:51:44 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: load-clim2.lisp,v 1.7 1998/08/06 23:17:06 layer Exp $ (defun flush-clim () (when (find-package 'clim-defsys) diff --git a/sys/load.lisp b/sys/load.lisp index 67713070a09ee2fba37f6481ff0b35f4ef70a1dc..3d0d8b76d72ca9537ae1dfadcb1f5b4a1fb92334 100644 --- a/sys/load.lisp +++ b/sys/load.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: load.lisp,v 1.9 1998/08/06 23:17:06 layer Exp $ + (in-package :user) #+(and Allegro (or microsoft-32 mswindows)) diff --git a/sys/loaddemo.lisp b/sys/loaddemo.lisp index ab9f0dff42929edcc8422e184776b0e76bb1de3e..9dbda4d9c580030efeed4c662f985859a3323fe4 100644 --- a/sys/loaddemo.lisp +++ b/sys/loaddemo.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: loaddemo.lisp,v 1.4 1998/08/06 23:17:06 layer Exp $ + (in-package :user) #+aclpc (load (climpath "demo\\test-suite.fsl")) diff --git a/sys/loadnd.lisp b/sys/loadnd.lisp index 308399a8653385a7084bb6fc4a752837bde0b0c8..c4504e100c37544929a0f0b1a9d829cb6d38f6c5 100644 --- a/sys/loadnd.lisp +++ b/sys/loadnd.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: loadnd.lisp,v 1.3 1998/08/06 23:17:06 layer Exp $ + (in-package :user) #+aclpc (load (climpath "sys\\defsyste.fsl")) diff --git a/sys/odrawpat.lisp b/sys/odrawpat.lisp index 79432aa316b7294157389b37ec2846a3f94cc863..077795d49b78efc712693754e10fdffe46e6ef8d 100644 --- a/sys/odrawpat.lisp +++ b/sys/odrawpat.lisp @@ -1,3 +1,21 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: odrawpat.lisp,v 1.2 1998/08/06 23:17:06 layer Exp $ (in-package :acl-clim) diff --git a/sys/recompile.lisp b/sys/recompile.lisp index 1406b3cf50b795e752522aff21970a3ad2074276..0897975f98eac675bcf343d71fc1af669c96bbbb 100644 --- a/sys/recompile.lisp +++ b/sys/recompile.lisp @@ -1,3 +1,22 @@ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: recompile.lisp,v 1.4 1998/08/06 23:17:06 layer Exp $ + ;; this file is way out of date -- it needs to be recoded using ;; compile.lisp as a model. -tjm 23May97 diff --git a/sys/sysdcl-pc.lisp b/sys/sysdcl-pc.lisp index 6975f2b888f55f6b60c6a27e6d58a398b1c79922..dca3b51e9acc9ef830db6e6c7ddaa1587d8892c2 100644 --- a/sys/sysdcl-pc.lisp +++ b/sys/sysdcl-pc.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/sys/sysdcl-pc.lisp,v 1.4 1997/05/31 01:00:38 tomj Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl-pc.lisp,v 1.5 1998/08/06 23:17:07 layer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :cl-user) diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp index e8a19641bb53580237191c7d877548ab0988eecb..9febc9434a609e9aa34d9d880ac9360389360481 100644 --- a/sys/sysdcl.lisp +++ b/sys/sysdcl.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/sys/sysdcl.lisp,v 1.56 1997/10/13 20:29:35 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: sysdcl.lisp,v 1.57 1998/08/06 23:17:07 layer Exp $ (in-package :cl-user) @@ -277,7 +293,7 @@ ("panes" (:load-before-compile "frames")) ("default-frame" (:load-before-compile "frames")) ("activities" (:load-before-compile "frames")) - #+acl86win32 ("db-menu" (:load-before-compile "frames")) + ("db-menu" (:load-before-compile "frames")) #+acl86win32 ("db-list" (:load-before-compile "db-menu")) #+acl86win32 ("db-text" (:load-before-compile "frames")) ("noting-progress" (:load-before-compile "frames")) @@ -383,6 +399,10 @@ ("ol-callbacks") ("make-widget"))) +#+allegro +(defsystem last (:default-pathname "clim2:;utils;") + (:serial ("last"))) + #+(and Allegro (not acl86win32)) (defsystem motif-clim (:default-pathname "clim2:;tk-silica;") @@ -402,7 +422,7 @@ ("xm-gadgets") ("xt-pixmaps") ("gc-cursor") - ("last"))) + last)) #+(and Allegro (not acl86win32)) (defsystem openlook-clim @@ -423,7 +443,7 @@ ("ol-gadgets") ("xt-pixmaps") ("gc-cursor") - ("last"))) + last)) #+aclpc ;; keep in mind that for now, aclpc loads sysdcl-pc, not this file. -tjm 23May97 (defun frob-pathname (subdir diff --git a/test/chess.lisp b/test/chess.lisp index 6549a2649f8774ee9645825db96bdc05e9bc14e0..4da24154691e5c43cd7e2d80f0a5e45db7d1fc9b 100644 --- a/test/chess.lisp +++ b/test/chess.lisp @@ -1,7 +1,7 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:03 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -20,7 +20,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/chess.lisp,v 1.13 1997/02/05 01:51:59 tomj Exp $ +;; $Id: chess.lisp,v 1.14 1998/08/06 23:17:09 layer Exp $ (in-package :clim-user) diff --git a/test/color-ed.lisp b/test/color-ed.lisp index 0f4d47f2b719e61c8f86ff62d6e95310f5dd376a..d841bf50479c3feb1d3bb95efc9ccc1f92d80e2e 100644 --- a/test/color-ed.lisp +++ b/test/color-ed.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:03 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/color-ed.lisp,v 1.9 1997/02/05 01:52:01 tomj Exp $ +;; $Id: color-ed.lisp,v 1.10 1998/08/06 23:17:09 layer Exp $ (in-package :clim-user) diff --git a/test/hpgl-tests.lisp b/test/hpgl-tests.lisp index 605feab26bbf18792c93a9f3c811bd776c5ef190..ea8b89bcc5f405654b14916f20a8bb046f0ee752 100644 --- a/test/hpgl-tests.lisp +++ b/test/hpgl-tests.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: hpgl-clim; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/hpgl-tests.lisp,v 1.3 1997/02/05 01:52:03 tomj Exp $ +;; $Id: hpgl-tests.lisp,v 1.4 1998/08/06 23:17:09 layer Exp $ (in-package :clim-user) diff --git a/test/postscript-tests.lisp b/test/postscript-tests.lisp index 4b96bff84559f0f767873eb0f46724b20e3e1b9b..b0efb30c612b2c48e4d317746fd607dedf13f46e 100644 --- a/test/postscript-tests.lisp +++ b/test/postscript-tests.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/postscript-tests.lisp,v 1.10 1997/02/05 01:52:05 tomj Exp $ +;; $Id: postscript-tests.lisp,v 1.11 1998/08/06 23:17:09 layer Exp $ (in-package :clim-user) diff --git a/test/simple-test.lisp b/test/simple-test.lisp index 8d6d14c654e3cea0355fac80ad8cb6e5e793bf61..cbc5c71bde9f36c8a49cc153cd573266139c4956 100644 --- a/test/simple-test.lisp +++ b/test/simple-test.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:02 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/simple-test.lisp,v 1.12 1997/02/05 01:52:06 tomj Exp $ +;; $Id: simple-test.lisp,v 1.13 1998/08/06 23:17:10 layer Exp $ #-acl86win32 (defpackage :clim-user (:use :clim-silica)) diff --git a/test/test-buttons.lisp b/test/test-buttons.lisp index d7f184ed877e5036c85a06bedf5302adc0cd967b..505e43a3b7fce9d1c5efc6d5de6c8585a65d737a 100644 --- a/test/test-buttons.lisp +++ b/test/test-buttons.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/test-buttons.lisp,v 1.6 1997/02/05 01:52:09 tomj Exp $ +;; $Id: test-buttons.lisp,v 1.7 1998/08/06 23:17:10 layer Exp $ (in-package :clim-user) diff --git a/test/test-clim-tests.lisp b/test/test-clim-tests.lisp index dbf4ea9cbb43adf9342afac5dbb609ce0824df2b..59159d7025d1171d6136801230eec46c8360af55 100644 --- a/test/test-clim-tests.lisp +++ b/test/test-clim-tests.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: clim-user -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:02 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/test-clim-tests.lisp,v 1.6 1997/02/05 01:52:10 tomj Exp $ +;; $Id: test-clim-tests.lisp,v 1.7 1998/08/06 23:17:10 layer Exp $ (in-package :clim-user) diff --git a/test/test-clim.lisp b/test/test-clim.lisp index 24bf7ce3a809d351b0227a2950ad1592ef925590..300ac67a37e9466c9c32a175b1fa21fcc7fb9ac8 100644 --- a/test/test-clim.lisp +++ b/test/test-clim.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: clim-user -*- ;; -;; -[]- +;; -[Mon Jul 6 15:36:01 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -19,7 +19,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/test-clim.lisp,v 1.18 1997/02/05 01:52:12 tomj Exp $ +;; $Id: test-clim.lisp,v 1.19 1998/08/06 23:17:10 layer Exp $ (in-package :clim-user) diff --git a/test/test-demos.lisp b/test/test-demos.lisp index 45aa6721c6d7797038513dab152ebfe02f7c02fb..b51714a80c8c4f6364a70fcd014dbf6223deaa80 100644 --- a/test/test-demos.lisp +++ b/test/test-demos.lisp @@ -1,6 +1,6 @@ (in-package :clim-user) -;; $Header: /repo/cvs.copy/clim2/test/test-demos.lisp,v 1.11 1997/02/05 01:52:13 tomj Exp $ +;; $Id: test-demos.lisp,v 1.12 1998/08/06 23:17:10 layer Exp $ diff --git a/test/test-sliders.lisp b/test/test-sliders.lisp index 0045b9760b657463d26f4e58595a7188290f3f16..9987e3fb0802cc07b73b574761f58e78cba4e8ed 100644 --- a/test/test-sliders.lisp +++ b/test/test-sliders.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/test-sliders.lisp,v 1.6 1997/02/05 01:52:17 tomj Exp $ +;; $Id: test-sliders.lisp,v 1.7 1998/08/06 23:17:10 layer Exp $ (in-package :clim-user) diff --git a/test/test-suite.lisp b/test/test-suite.lisp index 9577339f5e9ad73edcc1822787fd63380855fe1c..9ed60511dc7ab05164c6149c80c79eaeeff0321e 100644 --- a/test/test-suite.lisp +++ b/test/test-suite.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/test-suite.lisp,v 1.82 1997/09/03 04:03:41 tomj Exp $ +;; $Id: test-suite.lisp,v 1.83 1998/08/06 23:17:11 layer Exp $ (in-package :clim-user) diff --git a/test/test.lisp b/test/test.lisp index 6f27e370e41d683d685fcd159953434e2129886d..8a3e74f65ef31e53bcde68999eda80a6b3537cca 100644 --- a/test/test.lisp +++ b/test/test.lisp @@ -18,7 +18,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/test/test.lisp,v 1.56 1997/02/05 01:52:24 tomj Exp $ +;; $Id: test.lisp,v 1.57 1998/08/06 23:17:11 layer Exp $ (in-package :clim-user) diff --git a/test/testdcl.lisp b/test/testdcl.lisp index 22482e5be5925677248690f8954022557d5a8372..3a83e4b0b687e1edf17ac9c7892bf6a40217c0b4 100644 --- a/test/testdcl.lisp +++ b/test/testdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/test/testdcl.lisp,v 1.6 1997/02/05 01:52:26 tomj Exp $ +;; $Id: testdcl.lisp,v 1.7 1998/08/06 23:17:12 layer Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) diff --git a/tk-silica/gc-cursor.lisp b/tk-silica/gc-cursor.lisp index 536ab7c01a2c065b3e449540280c11cd96a8137d..7a8a89f8f18f01879d096729236b8b42744e0b3d 100644 --- a/tk-silica/gc-cursor.lisp +++ b/tk-silica/gc-cursor.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Mon Feb 23 12:17:13 1998 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/gc-cursor.lisp,v 1.8 1998/03/02 23:17:04 duane Exp $ - +;; $Id: gc-cursor.lisp,v 1.9 1998/08/06 23:17:24 layer Exp $ (in-package :xm-silica) @@ -28,24 +23,20 @@ (defvar *gc-before* nil) (defvar *gc-after* nil) -(defun init-gc-cursor (frame) +(defun init-gc-cursor (frame &optional force) (when *use-clim-gc-cursor* - (unless *gc-before* ; Do just once. - (let ((vec (if* (fboundp 'excl::gc-before-c-hooks) ;; The new style - then (make-array 2 :element-type '(unsigned-byte 32)) - else (vector nil nil)))) + (when (or force (null *gc-before*)) + (let ((vec (make-array 2 :element-type '(unsigned-byte 32)))) (tk::init_clim_gc_cursor_stuff vec) - (setq *gc-before* (svref vec 0) - *gc-after* (svref vec 1)) - (if* (fboundp 'excl::gc-before-c-hooks) - then (pushnew (make-array 1 :element-type '(unsigned-byte 32) - :initial-element *gc-before*) - (excl:gc-before-c-hooks)) - (pushnew (make-array 1 :element-type '(unsigned-byte 32) - :initial-element *gc-after*) - (excl:gc-after-c-hooks)) - else (pushnew *gc-before* (excl::gc-before-hooks)) - (pushnew *gc-after* (excl::gc-after-hooks))))) + (setq *gc-before* (aref vec 0) + *gc-after* (aref vec 1)) + (pushnew (make-array 1 :element-type '(unsigned-byte 32) + :initial-element *gc-before*) + (excl:gc-before-c-hooks)) + + (pushnew (make-array 1 :element-type '(unsigned-byte 32) + :initial-element *gc-after*) + (excl:gc-after-c-hooks)))) (let* ((sheet (frame-top-level-sheet frame)) (mirror (and sheet (sheet-direct-mirror sheet)))) (if mirror @@ -56,6 +47,14 @@ (sheet-pointer-cursor sheet))) (tk::set_clim_gc_cursor_widget 0 0))))) +(defun reinitialize-gc-cursor () + ;; Force init-gc-cursor to go through its initialization + ;; code the next time it is called. + (setq *gc-before* nil) + (setq *gc-after* nil)) + +(pushnew 'reinitialize-gc-cursor excl::*restart-actions*) + (defmethod (setf sheet-pointer-cursor) :after (cursor (sheet xt-top-level-sheet)) (declare (ignore cursor)) (init-gc-cursor (pane-frame sheet))) diff --git a/tk-silica/image.lisp b/tk-silica/image.lisp index 5e69a59171f8b69f21fa80c3cac3358c7b134572..5e5129a05d24a2f8860ef46be28519301915240a 100644 --- a/tk-silica/image.lisp +++ b/tk-silica/image.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Mon Aug 2 10:00:30 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/image.lisp,v 1.24 1998/05/19 18:51:15 layer Exp $ +;; $Id: image.lisp,v 1.25 1998/08/06 23:17:24 layer Exp $ (in-package :xm-silica) @@ -443,7 +439,7 @@ (unless (eql (setq c (peek-char t stream)) #\newline) (return c)))))) - (let (name width height ncolors pixels colors cpp) + (let (#+ignore name width height ncolors pixels colors cpp) (assert (eql #\/ (skip-whitespace)) () "File must begin with a comment") @@ -454,6 +450,7 @@ () "Expected char keyword" ) (ensure-next-char #\*) + #+ignore (setq name (read-a-token #'(lambda (c) (or (alphanumericp c) (eql c #\_))))) (ensure-next-char #\[) diff --git a/tk-silica/ol-frames.lisp b/tk-silica/ol-frames.lisp index 4066e019baaf6a3d4dca989c5c4ea50ec570842d..e2d74bb1f6d30f810bdacf31d982d8fdf59bcb37 100644 --- a/tk-silica/ol-frames.lisp +++ b/tk-silica/ol-frames.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Tue Jul 27 13:40:13 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/ol-frames.lisp,v 1.32 1998/05/19 18:51:15 layer Exp $ - +;; $Id: ol-frames.lisp,v 1.33 1998/08/06 23:17:24 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp index e710c634c6b0882bd658d4b3bc8b5f1f1cd6fd89..c4c728bb2038406c6b02a8e715f6e156338c8589 100644 --- a/tk-silica/ol-gadgets.lisp +++ b/tk-silica/ol-gadgets.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Fri Jul 30 16:12:45 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/ol-gadgets.lisp,v 1.70 1998/05/19 18:51:15 layer Exp $ - +;; $Id: ol-gadgets.lisp,v 1.71 1998/08/06 23:17:24 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp index 0bfe16ba04f24e981e62d03a06f2994d53bd2f24..50323dc9cbb7c5db5be2959e406b817ebfc18a1b 100644 --- a/tk-silica/ol-silica.lisp +++ b/tk-silica/ol-silica.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/ol-silica.lisp,v 1.27 1998/05/19 18:51:17 layer Exp $ +;; $Id: ol-silica.lisp,v 1.28 1998/08/06 23:17:25 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/pkg.lisp b/tk-silica/pkg.lisp index 912db41dddd1d013c6dc598487cb66ecf26e7a1a..d8c1e810b6bfc260af51e623cc1a12dc591f72f4 100644 --- a/tk-silica/pkg.lisp +++ b/tk-silica/pkg.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: cl-user -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/pkg.lisp,v 1.18 1998/05/19 18:51:17 layer Exp $ +;; $Id: pkg.lisp,v 1.19 1998/08/06 23:17:25 layer Exp $ ;;; --- the motif v openlook definitions should be in separate package ;;; definition files diff --git a/tk-silica/xm-dialogs.lisp b/tk-silica/xm-dialogs.lisp index 92bdfbb021f26f9bd8571715b02c55287bc1a5e3..73124912302580db31a73a2f7f7dfe9e4b36ee86 100644 --- a/tk-silica/xm-dialogs.lisp +++ b/tk-silica/xm-dialogs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: clim-internals -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xm-dialogs.lisp,v 1.14 1998/05/19 18:51:17 layer Exp $ +;; $Id: xm-dialogs.lisp,v 1.15 1998/08/06 23:17:25 layer Exp $ (in-package :clim-internals) diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp index 5e3aafc40cda1d9fb0aa33fa5d2249ec14df9f3c..5ea2618e9b18d1b8231bc95b66106ae91c1c6366 100644 --- a/tk-silica/xm-frames.lisp +++ b/tk-silica/xm-frames.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xm-frames.lisp,v 1.76 1998/05/19 18:51:18 layer Exp $ +;; $Id: xm-frames.lisp,v 1.77 1998/08/06 23:17:25 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp index 0f8af362fa68da3f746b9f39f0262f5b9bc30065..42979bb8902f36dd5235011ac22ffc78424b3e8d 100644 --- a/tk-silica/xm-gadgets.lisp +++ b/tk-silica/xm-gadgets.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xm-gadgets.lisp,v 1.98 1998/05/19 18:51:18 layer Exp $ +;; $Id: xm-gadgets.lisp,v 1.99 1998/08/06 23:17:26 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp index 040e99f0b2718c68dd6a8050b152beaa3997d8bb..33de5a93956c8442f9caf5e9cb4d964e184e3c3b 100644 --- a/tk-silica/xm-silica.lisp +++ b/tk-silica/xm-silica.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xm-silica.lisp,v 1.49 1998/05/19 18:51:18 layer Exp $ +;; $Id: xm-silica.lisp,v 1.50 1998/08/06 23:17:26 layer Exp $ (in-package :xm-silica) @@ -162,7 +160,11 @@ (plist (and cursor (slot-value cursor 'clim-internals::plist))) (input-widget (getf plist :input-widget))) - (when input-widget + (when (and input-widget + ;; JPM 7/98: Don't destroy something already destroyed. + ;; spr17831 and spr17939. Apparently the motif-top-level-sheet + ;; may have already destroyed it. + (tk::find-object-from-address (ff:foreign-pointer-address input-widget) nil)) (tk::destroy-widget input-widget)))) (defmethod port-note-cursor-change :after diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp index 695af086623834ff3b1ec1fa5f9f4945cc8b0fdb..7202474df464ba57999064e1685054055dd75992 100644 --- a/tk-silica/xt-frames.lisp +++ b/tk-silica/xt-frames.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Wed Sep 8 11:40:41 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xt-frames.lisp,v 1.48 1998/05/19 18:51:20 layer Exp $ - +;; $Id: xt-frames.lisp,v 1.49 1998/08/06 23:17:26 layer Exp $ (in-package :xm-silica) @@ -214,14 +209,18 @@ (defmethod frame-manager-default-exit-boxes ((framem xt-frame-manager)) '((:exit) (:abort))) +(defvar *suppress-xevents* nil) + (defmethod note-frame-iconified ((framem xt-frame-manager) frame) - (let ((display (port-display (port framem)))) - (x11:xiconifywindow display (tk::widget-window (frame-shell frame)) - (xt::display-screen-number display)))) + (unless *suppress-xevents* + (let ((display (port-display (port framem)))) + (x11:xiconifywindow display (tk::widget-window (frame-shell frame)) + (xt::display-screen-number display))))) (defmethod note-frame-deiconified ((framem xt-frame-manager) frame) - (x11:xmapwindow (port-display (port framem)) - (tk::widget-window (frame-shell frame)))) + (unless *suppress-xevents* + (x11:xmapwindow (port-display (port framem)) + (tk::widget-window (frame-shell frame))))) ;;; diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp index 7c74d1ca6a9042e928fa83677e30bf7b312c652f..46fc90fd702de0cb722fa557597be9b539c47c0a 100644 --- a/tk-silica/xt-gadgets.lisp +++ b/tk-silica/xt-gadgets.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Thu Aug 19 15:39:02 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xt-gadgets.lisp,v 1.47 1998/05/19 18:51:20 layer Exp $ +;; $Id: xt-gadgets.lisp,v 1.48 1998/08/06 23:17:26 layer Exp $ (in-package :xm-silica) @@ -330,7 +326,7 @@ ;; Patched from spr17194 to make backspace and arrow keys work ;; as accelerators. -(setq xm-silica::*funny-accelerator-characters* +(defparameter xm-silica::*funny-accelerator-characters* '( ((#\\ :\\) "backslash") ((#\space :\ ) "space") diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index ff3b6b7556e8b9cb8d3d30663a02e099f26e987e..4accb06f2a5aea5b792daa3ee170e218733b9e54 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk-silica -*- -;; -;; -[Thu Dec 28 00:27:15 1995 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xt-graphics.lisp,v 1.95 1998/03/21 01:55:08 smh Exp $ +;; $Id: xt-graphics.lisp,v 1.96 1998/08/06 23:17:27 layer Exp $ (in-package :tk-silica) @@ -1605,7 +1601,8 @@ align-y text-style towards-x towards-y transform-glyphs transformation) - (declare (ignore string start end towards-x towards-y align-x align-y transform-glyphs transformation)) + (declare (ignore string start end towards-x towards-y align-x align-y + transform-glyphs transformation text-style x y)) (multiple-value-bind (left top right bottom cx cy towards-x towards-y) (call-next-method) (if (and towards-y towards-x) diff --git a/tk-silica/xt-pixmaps.lisp b/tk-silica/xt-pixmaps.lisp index 73d89f754507b2412b8a846c6e4b0e87b3cd4273..d8c3f9dd5fda9abb662fb7239f6ce4bacc47cef5 100644 --- a/tk-silica/xt-pixmaps.lisp +++ b/tk-silica/xt-pixmaps.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xt-pixmaps.lisp,v 1.25 1998/05/19 18:51:20 layer Exp $ - +;; $Id: xt-pixmaps.lisp,v 1.26 1998/08/06 23:17:28 layer Exp $ (in-package :xm-silica) diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index 59a335569b2a5efdee9ef9a1b803d94996e37667..480482e54950100f0d5eaf0fb220d722818f667e 100644 --- a/tk-silica/xt-silica.lisp +++ b/tk-silica/xt-silica.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[Thu Dec 14 20:13:58 1995 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk-silica/xt-silica.lisp,v 1.109 1998/05/19 18:51:20 layer Exp $ +;; $Id: xt-silica.lisp,v 1.110 1998/08/06 23:17:28 layer Exp $ (in-package :xm-silica) @@ -89,21 +85,17 @@ (defmethod restart-port ((port xt-port)) - (flet ((cleanup-port-after-dumplisp (process) - (mp::process-kill process))) - (let ((process (port-process port))) - (when process - (clim-sys:destroy-process process)) - (setq process - (mp:process-run-function - (list :name (format nil "CLIM Event Dispatcher for ~A" - (port-server-path port)) - :priority 1000) - #'port-event-loop port)) - (setf (getf (mp:process-property-list process) :survive-dumplisp) - #'cleanup-port-after-dumplisp) - (setf (getf (mp:process-property-list process) :no-interrupts) t) - (setf (port-process port) process)))) + (let ((process (port-process port))) + (when process + (clim-sys:destroy-process process)) + (setq process + (mp:process-run-function + (list :name (format nil "CLIM Event Dispatcher for ~A" + (port-server-path port)) + :priority 1000) + #'port-event-loop port)) + (setf (getf (mp:process-property-list process) :no-interrupts) t) + (setf (port-process port) process))) (defparameter *use-color* t) ; For debugging monochrome @@ -639,18 +631,25 @@ (defmethod sheet-mirror-map-callback (event sheet) (let ((frame (pane-frame sheet))) (when frame - (let ((state (frame-state frame))) + (let ((state (frame-state frame)) + ;; Inform lisp but don't feed event back to X. + (*suppress-xevents* t)) + (declare (special *suppress-xevents*)) (case (tk::event-type event) (:map-notify (when (eq state :shrunk) - (setf (frame-state frame) :enabled) - #+ignore - (note-frame-deiconified (frame-manager frame) frame))) + (setf (frame-state frame) :enabled))) (:unmap-notify + ;; spr17465 + ;; On Sparc in CDE (common desktop environment), + ;; switching out of a workspace will send an UnmapNotify + ;; message. Iconifying a window also sends an UnmapNotify + ;; message. There is apparently no way to tell the difference. + ;; The right thing to do is to stop calling XIconifyWindow in + ;; response, since it is not only unnecessary, it is detrimental. + ;; That is the purpose of *suppress-xevents*. (when (eq state :enabled) - (setf (frame-state frame) :shrunk) - #+ignore - (note-frame-iconified (frame-manager frame) frame)))))))) + (setf (frame-state frame) :shrunk)))))))) (defmethod find-widget-class-and-name-for-sheet ((port xt-port) (parent t) (sheet basic-sheet)) @@ -1411,6 +1410,7 @@ (and style `(:text-style ,style))))))))) (defun convert-text-style (port display text-style) + (declare (ignore display)) (ignore-errors (let ((spec (read-from-string text-style))) (if (consp spec) @@ -1758,12 +1758,14 @@ the geometry of the children. Instead the parent has control. ")) cursor) (defmethod realize-cursor :around ((port xt-port) sheet cursor) + (declare (ignore sheet)) (with-slots (cursor-cache) port (or (getf cursor-cache cursor) (setf (getf cursor-cache cursor) (call-next-method))))) (defmethod realize-cursor ((port xt-port) sheet (cursor null)) + (declare (ignore sheet)) x11:none) (defmethod realize-cursor ((port xt-port) sheet (cursor symbol)) diff --git a/tk-silica/xt-stipples.lisp b/tk-silica/xt-stipples.lisp index a6abb125600cbe4cc545789c883ef9c77ba32142..6e01f34b66c47a633e3b847e7bd2ca5689fb6c7a 100644 --- a/tk-silica/xt-stipples.lisp +++ b/tk-silica/xt-stipples.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xm-silica -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,6 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; +;; $Id: xt-stipples.lisp,v 1.4 1998/08/06 23:17:29 layer Exp $ ;;; stipples are bitmaps used for monochrome half-toning and to ;;; implement opacities. diff --git a/tk/callbacks.lisp b/tk/callbacks.lisp index 541051ed74bbdfb34306fa4d94f35a74da25ea4a..fa965397077634915481d77616434b91097e3b26 100644 --- a/tk/callbacks.lisp +++ b/tk/callbacks.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/callbacks.lisp,v 1.29 1998/05/19 18:51:12 layer Exp $ +;; $Id: callbacks.lisp,v 1.30 1998/08/06 23:17:14 layer Exp $ (in-package :tk) @@ -31,8 +28,8 @@ (call-data :unsigned-long)) (callback-handler-1 widget client-data call-data)) -(defun callback-handler-1 (widget client-data call-data) - (let* ((widget (find-object-from-address widget)) +(defun callback-handler-1 (address client-data call-data) + (let* ((widget (find-object-from-address address)) (callback-info (or (assoc client-data (widget-callback-data widget)) (error "Cannot find callback info ~S,~S" widget client-data)))) diff --git a/tk/convenience.lisp b/tk/convenience.lisp index 0242b9cafd77b9b0086e37e1502cd27449a47bac..051ecbc1f89fbbec6f8bbc91e60cff48531b56d7 100644 --- a/tk/convenience.lisp +++ b/tk/convenience.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/convenience.lisp,v 1.20 1997/02/05 01:52:35 tomj Exp $ +;; $Id: convenience.lisp,v 1.21 1998/08/06 23:17:14 layer Exp $ (in-package :tk) diff --git a/tk/event.lisp b/tk/event.lisp index ff011e98b8c1d36d5bfe16bf6ec9d01511a29012..a87ae3c9a060f429702eccef1cc6ac92b4e78750 100644 --- a/tk/event.lisp +++ b/tk/event.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Fri Aug 20 18:53:50 1993 by layer]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/event.lisp,v 1.28 1998/05/19 18:51:12 layer Exp $ +;; $Id: event.lisp,v 1.29 1998/08/06 23:17:14 layer Exp $ (in-package :tk) diff --git a/tk/examples.lisp b/tk/examples.lisp index d25b91b9163920d1ff9a35159244b7f9c2567676..2d89b08a705445c74e1a87af773de454988a0940 100644 --- a/tk/examples.lisp +++ b/tk/examples.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/examples.lisp,v 1.10 1997/02/05 01:52:39 tomj Exp $ +;; $Id: examples.lisp,v 1.11 1998/08/06 23:17:15 layer Exp $ (in-package :tk) diff --git a/tk/font.lisp b/tk/font.lisp index cf6b95321f248818ccbcf655231498f1d82673af..1fdc1d63e1cdd0d5c0b580838a83cb80104798de 100644 --- a/tk/font.lisp +++ b/tk/font.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Sat Mar 23 17:50:57 1996 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/font.lisp,v 1.21 1997/02/05 01:52:40 tomj Exp $ +;; $Id: font.lisp,v 1.22 1998/08/06 23:17:15 layer Exp $ (in-package :tk) @@ -134,7 +131,7 @@ (setf (elt seq i) (char*-to-string (xfontname-list names i)))) (x11::xfreefontnames names))))) - +#+broken (defun list-font-names-with-info (display pattern &key (max-fonts 65535) (result-type 'list)) (with-ref-par ((n 0 :int) (fonts 0 *)) diff --git a/tk/foreign-obj.lisp b/tk/foreign-obj.lisp index 12e2e6590a912d1dd1377981bc64ad1cc9e747aa..c84a81b3d73e5a2325c96914e12c6aab99a523b3 100644 --- a/tk/foreign-obj.lisp +++ b/tk/foreign-obj.lisp @@ -1,9 +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. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/foreign-obj.lisp,v 1.17 1997/02/05 01:52:42 tomj Exp $ +;; $Id: foreign-obj.lisp,v 1.18 1998/08/06 23:17:15 layer Exp $ (in-package :tk) diff --git a/tk/foreign.lisp b/tk/foreign.lisp index c0b40843850cbee200ff30c25a3bd3a64160e1ae..77d5d414b264795b276199053c5d9cecd5af520e 100644 --- a/tk/foreign.lisp +++ b/tk/foreign.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,16 +16,12 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/foreign.lisp,v 1.23 1998/05/19 18:51:12 layer Exp $ +;; $Id: foreign.lisp,v 1.24 1998/08/06 23:17:15 layer Exp $ (in-package :tk) ;;; We have to interface to various foreign functions in the toolkit -;; - - - (defclass application-context (ff:foreign-pointer) ((displays :initform nil :accessor application-context-displays))) diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp index fa07d6970315761db1db73aa0366117483d72a9c..580a949034272dc1a309ef865a804a3cf985c1cd 100644 --- a/tk/gcontext.lisp +++ b/tk/gcontext.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Thu Dec 28 00:25:24 1995 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/gcontext.lisp,v 1.32 1997/05/31 01:00:42 tomj Exp $ +;; $Id: gcontext.lisp,v 1.33 1998/08/06 23:17:15 layer Exp $ (in-package :tk) @@ -133,7 +130,9 @@ function plane-mask foreground background line-width line-style cap-style join-style fill-style fill-rule - arc-mode tile stipple ts-x ts-y + arc-mode tile stipple + #+broken ts-x + #+broken ts-y font subwindow-mode graphics-exposures clip-x-origin clip-y-origin clip-mask clip-ordering @@ -163,7 +162,9 @@ (when arc-mode (setf (gcontext-arc-mode gcontext) arc-mode)) (when tile (setf (gcontext-tile gcontext) tile)) (when stipple (setf (gcontext-stipple gcontext) stipple)) + #+broken (when ts-x (setf (gcontext-ts-x gcontext) ts-x)) + #+broken (when ts-y (setf (gcontext-ts-y gcontext) ts-y)) (when font (setf (gcontext-font gcontext) font)) (when subwindow-mode (setf (gcontext-subwindow-mode gcontext) subwindow-mode)) @@ -265,8 +266,12 @@ (define-gc-reader font decode-font) (define-gc-writer-function font x11:xsetfont encode-font) +#+broken (define-gc-accessor cap-style (encode-cap-style decode-cap-style)) +#-broken +(define-gc-writer cap-style encode-cap-style) + (defun encode-cap-style (gc x) (declare (optimize (speed 3) (safety 0)) (ignore gc)) @@ -276,8 +281,12 @@ (:round 2) (:projecting 3))) +#+broken (define-gc-accessor join-style (encode-join-style decode-join-style)) +#-broken +(define-gc-writer join-style encode-join-style) + (defun encode-join-style (gc x) (declare (optimize (speed 3) (safety 0)) (ignore gc)) @@ -423,7 +432,10 @@ (call-next-method) (setf cached-clip-mask nv)))) +#+broken (define-gc-accessor line-style (encode-line-style decode-style)) +#-broken +(define-gc-writer line-style encode-line-style) (defun encode-line-style (gc x) (declare (optimize (speed 3) (safety 0)) diff --git a/tk/graphics.lisp b/tk/graphics.lisp index c0a62f13e86603da95240659e6a5eacb41b56480..81f1dc0969e0aa64013d4a82b00b7998e1f0d5d2 100644 --- a/tk/graphics.lisp +++ b/tk/graphics.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/graphics.lisp,v 1.22 1997/02/05 01:52:46 tomj Exp $ +;; $Id: graphics.lisp,v 1.23 1998/08/06 23:17:15 layer Exp $ (in-package :tk) diff --git a/tk/load-ol.lisp b/tk/load-ol.lisp index ec797a1c59b0279fb68d214c19d534211ef35f98..be6d31cf84f7841c5102712598c76723030c4f2d 100644 --- a/tk/load-ol.lisp +++ b/tk/load-ol.lisp @@ -1,7 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1993 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/load-ol.lisp,v 1.30 1997/05/05 22:35:17 layer Exp $ +;; $Id: load-ol.lisp,v 1.31 1998/08/06 23:17:16 layer Exp $ (in-package :user) diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp index a7a855daf72b85d95377dce7e26e97bb87369328..c2c2907fad35a5bc732bdbd8b6dc4d8dad471591 100644 --- a/tk/load-xm.lisp +++ b/tk/load-xm.lisp @@ -1,7 +1,6 @@ ;; -*- mode: common-lisp; package: user -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1993 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/load-xm.lisp,v 1.43 1998/03/18 20:27:53 layer Exp $ +;; $Id: load-xm.lisp,v 1.44 1998/08/06 23:17:16 layer Exp $ (in-package :user) diff --git a/tk/macros.lisp b/tk/macros.lisp index 87cc2d73c346bde86abc831e8e2735f9ae40c83b..c180d66b2ae73b827a76681e54c9325be999d6ce 100644 --- a/tk/macros.lisp +++ b/tk/macros.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/macros.lisp,v 1.21 1998/05/19 18:51:12 layer Exp $ +;; $Id: macros.lisp,v 1.22 1998/08/06 23:17:16 layer Exp $ (in-package :tk) diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp index 049ac4943e54a419c1cb5e73cd762e484a008b7f..e91dbf7f5529c8145d83a037dc1a443c5a9509be 100644 --- a/tk/make-classes.lisp +++ b/tk/make-classes.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Fri Dec 5 15:13:12 1997 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/make-classes.lisp,v 1.46 1997/12/23 22:44:53 duane Exp $ +;; $Id: make-classes.lisp,v 1.47 1998/08/06 23:17:16 layer Exp $ (in-package :tk) diff --git a/tk/make-widget.lisp b/tk/make-widget.lisp index 9d325e8aaa40357c82751a2eda63160105d19b88..970069d7bf97975a4aef1faea81692290495df15 100644 --- a/tk/make-widget.lisp +++ b/tk/make-widget.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/make-widget.lisp,v 1.12 1997/02/05 01:52:53 tomj Exp $ +;; $Id: make-widget.lisp,v 1.13 1998/08/06 23:17:16 layer Exp $ (in-package :tk) diff --git a/tk/meta-tk.lisp b/tk/meta-tk.lisp index aa1977b90bbeaad94ec26567aafaf31784ea8ce6..2ad07dca65e89d60d12c26397ab0b11538d01e29 100644 --- a/tk/meta-tk.lisp +++ b/tk/meta-tk.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/meta-tk.lisp,v 1.14 1997/02/05 01:52:55 tomj Exp $ +;; $Id: meta-tk.lisp,v 1.15 1998/08/06 23:17:16 layer Exp $ (in-package :tk) diff --git a/tk/ol-callbacks.lisp b/tk/ol-callbacks.lisp index 050c2198473b48899bb983d8de2fbe86a36fdb61..4358fc190e03851369819135caa5a31382a36b24 100644 --- a/tk/ol-callbacks.lisp +++ b/tk/ol-callbacks.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-callbacks.lisp,v 1.14 1998/05/19 18:51:12 layer Exp $ +;; $Id: ol-callbacks.lisp,v 1.15 1998/08/06 23:17:16 layer Exp $ (in-package :tk) diff --git a/tk/ol-classes.lisp b/tk/ol-classes.lisp index 4ba2b0fc48435b628a4a63e1f7cb330536cb0580..c7bb466b3f6e24cbdf3cd320436b4079e5f3e433 100644 --- a/tk/ol-classes.lisp +++ b/tk/ol-classes.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-classes.lisp,v 1.12 1997/02/05 01:52:58 tomj Exp $ +;; $Id: ol-classes.lisp,v 1.13 1998/08/06 23:17:17 layer Exp $ (in-package :tk) diff --git a/tk/ol-defs.lisp b/tk/ol-defs.lisp index 19e0725401d4d559d012d0fbf7521805783d5e65..a679f2cc84a9ac39fcfe86a55a6c4845f2f3e40b 100644 --- a/tk/ol-defs.lisp +++ b/tk/ol-defs.lisp @@ -1,9 +1,6 @@ ;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-defs.lisp,v 1.10 1997/02/05 01:52:59 tomj Exp $ +;; $Id: ol-defs.lisp,v 1.11 1998/08/06 23:17:17 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/ol-examples.lisp b/tk/ol-examples.lisp index bbf5a85b19d2b6f4fe42d4a3cc8e3bb70d9a58db..c580a10c2ec4f9b0023ddcd3f8c941dcfec5de57 100644 --- a/tk/ol-examples.lisp +++ b/tk/ol-examples.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-examples.lisp,v 1.10 1997/02/05 01:53:00 tomj Exp $ +;; $Id: ol-examples.lisp,v 1.11 1998/08/06 23:17:17 layer Exp $ (in-package :tk) diff --git a/tk/ol-funs.lisp b/tk/ol-funs.lisp index f33b4477c11a2d439b16a2b67683dad0cc10451c..74025f7a1a0e8093bd9c864e6a8e2837bc1efce6 100644 --- a/tk/ol-funs.lisp +++ b/tk/ol-funs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-funs.lisp,v 1.14 1997/02/05 01:53:02 tomj Exp $ +;; $Id: ol-funs.lisp,v 1.15 1998/08/06 23:17:17 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/ol-init.lisp b/tk/ol-init.lisp index 04614084a8140d5ba5d3bd65ef63fb2bcbb20e76..46a4a075140fdbef3924a33258a3336c91ab69dd 100644 --- a/tk/ol-init.lisp +++ b/tk/ol-init.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-init.lisp,v 1.24 1997/02/05 01:53:04 tomj Exp $ +;; $Id: ol-init.lisp,v 1.25 1998/08/06 23:17:17 layer Exp $ (in-package :tk) diff --git a/tk/ol-widgets.lisp b/tk/ol-widgets.lisp index 5855ede7c09a6ddd1238ba58ae61df97490f0f06..e37c0383205379ff6e57f65c36dde34aad72e166 100644 --- a/tk/ol-widgets.lisp +++ b/tk/ol-widgets.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xt -*- -;; -;; -[Wed Jul 28 14:04:19 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/ol-widgets.lisp,v 1.10 1997/02/05 01:53:06 tomj Exp $ +;; $Id: ol-widgets.lisp,v 1.11 1998/08/06 23:17:18 layer Exp $ (in-package :xt) diff --git a/tk/pkg.lisp b/tk/pkg.lisp index 938f679bb4d1900d4568e3a6a9a717328502c21b..09b47ce731ca8e2a0e500665dcb018fa6ce84e2b 100644 --- a/tk/pkg.lisp +++ b/tk/pkg.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: cl-user -*- -;; -;; -[Thu Oct 9 13:16:25 1997 by layer]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/pkg.lisp,v 1.20 1997/10/13 20:29:38 layer Exp $ +;; $Id: pkg.lisp,v 1.21 1998/08/06 23:17:19 layer Exp $ (defpackage :tk ;;-- No we really need diff --git a/tk/resources.lisp b/tk/resources.lisp index 3be8c1e7d8e50ff09697d285d3ef37f3c1b6d8b5..2458cc0d7a135b172ad660de084861970b102ebe 100644 --- a/tk/resources.lisp +++ b/tk/resources.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Fri Jul 30 16:14:28 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/resources.lisp,v 1.60 1997/09/03 04:03:43 tomj Exp $ - +;; $Id: resources.lisp,v 1.61 1998/08/06 23:17:19 layer Exp $ (in-package :tk) @@ -583,6 +578,7 @@ (convert-pixmap-out parent value)) (defmethod convert-pixmap-out (parent (value pixmap)) + (declare (ignore parent)) value) (defmethod convert-resource-out ((parent t) (type (eql 'boolean)) value) diff --git a/tk/widget.lisp b/tk/widget.lisp index 757a1bd3f0d4c099a718b269d8a1dd6991adea2e..7bf9d4e500e4ff573e21b132c1de6c56b90990f5 100644 --- a/tk/widget.lisp +++ b/tk/widget.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Mon Jul 19 18:51:48 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/widget.lisp,v 1.44 1997/10/04 00:56:32 tomj Exp $ +;; $Id: widget.lisp,v 1.45 1998/08/06 23:17:19 layer Exp $ (in-package :tk) @@ -97,7 +93,7 @@ (defun manage-children (children) (let ((n (length children)) - (i 0)) + #+ignore (i 0)) (with-*-array (v n) (dotimes (i n) (setf (*-array v i) @@ -106,7 +102,7 @@ (defun unmanage-children (children) (let ((n (length children)) - (i 0)) + #+ignore (i 0)) (with-*-array (v n) (dotimes (i n) (setf (*-array v i) diff --git a/tk/xlib.lisp b/tk/xlib.lisp index f36e243593e8e44521632a8a7c7234f88392f94c..c3b8c4b92a1f234422e1db3f6683658e66e4bb7b 100644 --- a/tk/xlib.lisp +++ b/tk/xlib.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[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. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xlib.lisp,v 1.60 1998/05/19 18:51:13 layer Exp $ +;; $Id: xlib.lisp,v 1.61 1998/08/06 23:17:19 layer Exp $ (in-package :tk) @@ -131,6 +127,7 @@ (define-window-reader depth) (define-window-reader map-state decode-window-map-state) +#+obsolete (define-window-accessor cursor nil) (defun decode-window-map-state (x) @@ -682,7 +679,7 @@ (padded-bits-per-line (* bitmap-pad (ceiling bits-per-line bitmap-pad))) (bytes-per-line (/ padded-bits-per-line 8)) - (v (excl::malloc (* bytes-per-line height))) + (v (x11::system-malloc (* bytes-per-line height))) (visual (x11:screen-root-visual (x11:xdefaultscreenofdisplay display))) (offset 0) @@ -801,7 +798,7 @@ (length string))) (defun get-cut-buffer (display) - (let ((string (make-string 1024))) + (let (#+ignore (string (make-string 1024))) (with-ref-par ((actual-type 0 :unsigned-long) (actual-format 0 :int) diff --git a/tk/xm-callbacks.lisp b/tk/xm-callbacks.lisp index e93e45e3f5f3d08f5715c6364c8e95f322314c6a..54db82824ce1c430015c9d25c975665031b351e8 100644 --- a/tk/xm-callbacks.lisp +++ b/tk/xm-callbacks.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-callbacks.lisp,v 1.8 1997/02/05 01:53:15 tomj Exp $ - +;; $Id: xm-callbacks.lisp,v 1.9 1998/08/06 23:17:19 layer Exp $ (in-package :tk) diff --git a/tk/xm-classes.lisp b/tk/xm-classes.lisp index cea49527d32ca36fb5ee2b68b7ce14707c7367b5..386782882594f35075d2681aad42b536acee7737 100644 --- a/tk/xm-classes.lisp +++ b/tk/xm-classes.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-classes.lisp,v 1.11 1997/02/05 01:53:16 tomj Exp $ - +;; $Id: xm-classes.lisp,v 1.12 1998/08/06 23:17:19 layer Exp $ (in-package :tk) diff --git a/tk/xm-defs.lisp b/tk/xm-defs.lisp index b7d3d99103835d9d7130ae8542d69d295eabedaa..afbfb274dee074d8ae81460e2f19c648f30844ec 100644 --- a/tk/xm-defs.lisp +++ b/tk/xm-defs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-defs.lisp,v 1.15 1997/02/05 01:53:17 tomj Exp $ +;; $Id: xm-defs.lisp,v 1.16 1998/08/06 23:17:20 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/xm-font-list.lisp b/tk/xm-font-list.lisp index 5093d0f222626dcaa8cc4b029a8696736398281d..c1ff7968a926a38e1f2967c94ab274b26f11689c 100644 --- a/tk/xm-font-list.lisp +++ b/tk/xm-font-list.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Fri Dec 16 17:15:52 1994 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-font-list.lisp,v 1.20 1997/02/05 01:53:19 tomj Exp $ +;; $Id: xm-font-list.lisp,v 1.21 1998/08/06 23:17:20 layer Exp $ (in-package :tk) diff --git a/tk/xm-funs.lisp b/tk/xm-funs.lisp index 346a09c898da5457a297c7f2c8b1b12d969ebd19..9bce8caa487bc8106b2dfed97a33191b45686734 100644 --- a/tk/xm-funs.lisp +++ b/tk/xm-funs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Thu Jul 22 17:17:07 1993 by colin]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-funs.lisp,v 1.20 1997/02/05 01:53:20 tomj Exp $ +;; $Id: xm-funs.lisp,v 1.21 1998/08/06 23:17:20 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/xm-init.lisp b/tk/xm-init.lisp index f3d429e54708a225bf6444f1074ed21854b09450..cddfbc96b9572404a327401655ca50714741e64f 100644 --- a/tk/xm-init.lisp +++ b/tk/xm-init.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Tue Mar 24 18:48:58 1998 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-init.lisp,v 1.20 1998/03/25 03:52:27 duane Exp $ +;; $Id: xm-init.lisp,v 1.21 1998/08/06 23:17:20 layer Exp $ (in-package :tk) diff --git a/tk/xm-protocols.lisp b/tk/xm-protocols.lisp index ce6b0f12eae74f92ff263419eef7e82e1ea5529b..f704cc07bd2a17abef96abdfeeff9b80e80c9ae6 100644 --- a/tk/xm-protocols.lisp +++ b/tk/xm-protocols.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-protocols.lisp,v 1.16 1998/05/19 18:51:13 layer Exp $ +;; $Id: xm-protocols.lisp,v 1.17 1998/08/06 23:17:20 layer Exp $ (in-package :tk) diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp index 01859a12833a543e2eeaee963ac6c310ed6c7f65..50bb77b460597e5dd68e5a438afa71c950c850a0 100644 --- a/tk/xm-widgets.lisp +++ b/tk/xm-widgets.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[Tue Oct 14 12:08:52 1997 by layer]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xm-widgets.lisp,v 1.28 1997/10/20 23:11:09 layer Exp $ +;; $Id: xm-widgets.lisp,v 1.29 1998/08/06 23:17:20 layer Exp $ (in-package :tk) @@ -95,6 +91,7 @@ (defmethod convert-resource-in ((parent t) (type (eql 'xm-string-table)) value) value) +#+broken (defun convert-xm-string-table-in (parent table n) (let ((r nil)) (dotimes (i n (nreverse r)) diff --git a/tk/xt-classes.lisp b/tk/xt-classes.lisp index f42f20142a766cc9c10cbfa6397a7ddf34ca7677..bb16748cc5eff5de6ee843bc225d8d27c1a3d668 100644 --- a/tk/xt-classes.lisp +++ b/tk/xt-classes.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xt-classes.lisp,v 1.6 1997/02/05 01:53:26 tomj Exp $ +;; $Id: xt-classes.lisp,v 1.7 1998/08/06 23:17:20 layer Exp $ (in-package :tk) diff --git a/tk/xt-defs.lisp b/tk/xt-defs.lisp index c628a8f3443331c2946277ba6654691b139596e7..25d95e5873f72649433c9e64bf711930cc8548df 100644 --- a/tk/xt-defs.lisp +++ b/tk/xt-defs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xt-defs.lisp,v 1.15 1997/02/05 01:53:27 tomj Exp $ +;; $Id: xt-defs.lisp,v 1.16 1998/08/06 23:17:20 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp index 184afd6ffd9826d86f0c3962093f2438cf122f59..f7d473a61043336ee2e53951ccf39c7eb7197275 100644 --- a/tk/xt-funs.lisp +++ b/tk/xt-funs.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: xt -*- -;; -;; -[Thu Feb 26 15:05:28 1998 by duane]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xt-funs.lisp,v 1.30 1998/03/02 23:17:04 duane Exp $ - +;; $Id: xt-funs.lisp,v 1.31 1998/08/06 23:17:21 layer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. diff --git a/tk/xt-init.lisp b/tk/xt-init.lisp index 68173ba7315b37c93dd4497343a8560965bb3641..fb2f99fff5901e4226c5d572332f04288a004b8a 100644 --- a/tk/xt-init.lisp +++ b/tk/xt-init.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: tk -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/tk/xt-init.lisp,v 1.10 1997/02/05 01:53:30 tomj Exp $ - +;; $Id: xt-init.lisp,v 1.11 1998/08/06 23:17:21 layer Exp $ (in-package :tk) diff --git a/utils/autoconstructor.lisp b/utils/autoconstructor.lisp index 4f7e5e0e641c675a746d4fd058398d2dc77340e5..098e6f30638255dfdf5e08b9f5bafd03025d2c7b 100644 --- a/utils/autoconstructor.lisp +++ b/utils/autoconstructor.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/autoconstructor.lisp,v 1.7 1998/05/19 18:51:23 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: autoconstructor.lisp,v 1.8 1998/08/06 23:17:30 layer Exp $ ;;; ;;; Copyright (c) 1990 by Xerox Corporation. All rights reserved. diff --git a/utils/base-designs.lisp b/utils/base-designs.lisp index ee4eec89b6df80b4db15b61547c122072fa10d44..8bf0ef55ee44202623d1b5bb17eec1f1ef5b58c9 100644 --- a/utils/base-designs.lisp +++ b/utils/base-designs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/base-designs.lisp,v 1.13 1998/05/19 18:51:23 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: base-designs.lisp,v 1.14 1998/08/06 23:17:31 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1992 Franz, Inc. All rights reserved." ;;; Basic designs definitions diff --git a/utils/ccl-streams.lisp b/utils/ccl-streams.lisp index 2683b6e13aa29f18af478e52fe7c5a9f601c4d10..852e22586a18c036a58d938164d6f928cf78a458 100644 --- a/utils/ccl-streams.lisp +++ b/utils/ccl-streams.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/ccl-streams.lisp,v 1.6 1998/05/19 18:51:23 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: ccl-streams.lisp,v 1.7 1998/08/06 23:17:31 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;; If we were really being clever, we could put CCL methods for ;; STREAM-CLOSE and STREAM-ABORT onto FUNDAMENTAL-STREAM here. That diff --git a/utils/cl-stream-classes.lisp b/utils/cl-stream-classes.lisp index feae3aaef5700ec0b7724c3728d8e4b720066e3b..c84dd6f58469b168efa6648c6282f0d72959f3cf 100644 --- a/utils/cl-stream-classes.lisp +++ b/utils/cl-stream-classes.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/cl-stream-classes.lisp,v 1.9 1998/05/19 18:51:23 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: cl-stream-classes.lisp,v 1.10 1998/08/06 23:17:31 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; All of this is taken from the STREAM-DEFINITION-BY-USER proposal to ;;; the X3J13 committee, made by David Gray of TI on 22 March 1989. No diff --git a/utils/cl-stream-functions.lisp b/utils/cl-stream-functions.lisp index 4d399824e8610756e385ef7a77e187de7da8a28f..93fb984a52101f7b7fdd58024faa5924fc7d5bc3 100644 --- a/utils/cl-stream-functions.lisp +++ b/utils/cl-stream-functions.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/cl-stream-functions.lisp,v 1.9 1998/05/19 18:51:23 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: cl-stream-functions.lisp,v 1.10 1998/08/06 23:17:31 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; All of this is taken from the STREAM-DEFINITION-BY-USER proposal to ;;; the X3J13 committee, made by David Gray of TI on 22 March 1989. No diff --git a/utils/cl-streams.lisp b/utils/cl-streams.lisp index ea91d2a9fc6607ad755f45f314b73a5fbc790c5b..3071062611eada7262c48e645a59da030c95e6e8 100644 --- a/utils/cl-streams.lisp +++ b/utils/cl-streams.lisp @@ -1,7 +1,6 @@ ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIM-LISP; Base: 10; Lowercase: Yes -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,14 +16,13 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; - -;; $Header: /repo/cvs.copy/clim2/utils/cl-streams.lisp,v 1.6 1998/05/19 18:51:23 layer Exp $ +;; $Id: cl-streams.lisp,v 1.7 1998/08/06 23:17:31 layer Exp $ (in-package :clim-lisp) -"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. -Copyright (c) 1991, Franz Inc. All rights reserved - Portions copyright (c) 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991 Symbolics, Inc. All rights reserved. +;;;Copyright (c) 1991, Franz Inc. All rights reserved +;;; Portions copyright (c) 1989, 1990 International Lisp Associates." ;;; All of this is taken from the STREAM-DEFINITION-BY-USER proposal to ;;; the X3J13 committee, made by David Gray of TI on 22 March 1989. No diff --git a/utils/clim-macros.lisp b/utils/clim-macros.lisp index 85ad1a7740dabbef4931d38330ab4a7a0c96c8f1..777754b268bb0cca7bd0435a9eeb2a7ebd512344 100644 --- a/utils/clim-macros.lisp +++ b/utils/clim-macros.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/clim-macros.lisp,v 1.8 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clim-macros.lisp,v 1.9 1998/08/06 23:17:31 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." (defmacro default-output-stream (stream &optional must-be-variable-macro-name) `(cond ((member ,stream '(t nil)) diff --git a/utils/clim-streams.lisp b/utils/clim-streams.lisp index d584df17d6331b1a15fad62c0542cdeab17eb19b..1fe92573a3708b04fea64af03193cb7157e41eb9 100644 --- a/utils/clim-streams.lisp +++ b/utils/clim-streams.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/clim-streams.lisp,v 1.13 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clim-streams.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;; STANDARD-ENCAPSULATING-STREAM needs to be defined early on, because many methods are ;; written on this class. diff --git a/utils/clos-patches.lisp b/utils/clos-patches.lisp index 51a28a16533b19c1526e8e55fb149ed4aa18d0f0..98cbc70437ef37155084f1bbc59306b791db0915 100644 --- a/utils/clos-patches.lisp +++ b/utils/clos-patches.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/clos-patches.lisp,v 1.13 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clos-patches.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; This file contains various patches to get around current deficiencies ;;; in various CLOS implementations diff --git a/utils/clos.lisp b/utils/clos.lisp index 35ef28ca8087245b1af8551e2f9ff59225127ceb..296d4b9ef4f7b3e26d5cbd0643b5ecca0c2458f9 100644 --- a/utils/clos.lisp +++ b/utils/clos.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/clos.lisp,v 1.13 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: clos.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. diff --git a/utils/condpat.lisp b/utils/condpat.lisp index bb8c88442d0dedea2efe8626ee5e88dd58550113..c7ce6965dffb64cdfafd9e5538ade1cb89ab69c2 100644 --- a/utils/condpat.lisp +++ b/utils/condpat.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/condpat.lisp,v 1.11 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: condpat.lisp,v 1.12 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1990 International Lisp Associates. All rights reserved." ;;; Lucid and Franz have an old syntax for defining conditions. We define ;;; a macro here which supports [a subset of] the ANSI syntax and which diff --git a/utils/coral-char-bits.lisp b/utils/coral-char-bits.lisp index bae79a926af4363d3c2652857e314de920c1dabf..3d3cf957bc153ba17e2303f0173f020c8c74d358 100644 --- a/utils/coral-char-bits.lisp +++ b/utils/coral-char-bits.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/coral-char-bits.lisp,v 1.9 1998/05/19 18:51:24 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: coral-char-bits.lisp,v 1.10 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1991 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1991 International Lisp Associates. All rights reserved." ;; What a pain. Symbolics wrote the code to deal with CHAR-BITS, but ;; there ain't no such thing in ANSI CL. Here in Coral, at least, we diff --git a/utils/defpackage.lisp b/utils/defpackage.lisp index 194a14ec43000f9859ef66a82fe9f23d2914021e..09b7c470776ca4396a09ebe556745eb71d98366e 100644 --- a/utils/defpackage.lisp +++ b/utils/defpackage.lisp @@ -1,8 +1,24 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: (CLIM-LISP :USE LISP :COLON-MODE :EXTERNAL); Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/defpackage.lisp,v 1.12 1998/05/19 18:51:24 layer Exp $ - -"Copyright (c) 1989, 1990, 1991 by International Lisp Associates. All Rights Reserved." +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defpackage.lisp,v 1.13 1998/08/06 23:17:32 layer Exp $ + +;;;"Copyright (c) 1989, 1990, 1991 by International Lisp Associates. All Rights Reserved." #-aclpc (warn "utils/defpackage should not be used anymore") diff --git a/utils/defun-utilities.lisp b/utils/defun-utilities.lisp index 243c0c04788e4fb16da0910ef902ebba58eab914..bcc6e119e7728fd05d334048968cabb934334e69 100644 --- a/utils/defun-utilities.lisp +++ b/utils/defun-utilities.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;;; $Header: /repo/cvs.copy/clim2/utils/defun-utilities.lisp,v 1.13 1998/05/19 18:51:25 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defun-utilities.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1991 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1991 International Lisp Associates. All rights reserved." ;;; Useful proclamations, very early on diff --git a/utils/defun.lisp b/utils/defun.lisp index 7e18fa0d416fdb68e7aba75bff0434f666b389c6..71b2810270e58858cb8d79c7c7addd58a0c6821d 100644 --- a/utils/defun.lisp +++ b/utils/defun.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/defun.lisp,v 1.13 1998/05/19 18:51:25 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: defun.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1989, 1990 International Lisp Associates. All rights reserved." ;;; ;;; DEFUN and friends which support implementation-specific ways of declaring that @@ -34,7 +50,7 @@ ;;; (declare (dynamic-extent #'continuate)) ;;; (apply continuation args))) ;;;*** The following warning issued only under Genera (for now): -;;; ==> Warning: The rest argument ARGS will be copied at runtime because it is not declared +;;; ==> Warning: The rest argument ARGS will be copied at runtime because it is not declared ;;; to have dynamic extent. ;;; (lisp:defun test (#:ignore-4 #:ignore-5 #:ignore-6 continuation &rest args) ;;; "This is a test of dynamic-extent" ;; [Should we preserve ALL doc strings??] @@ -131,7 +147,7 @@ (dolist (de (rest dcl-form)) (typecase de (symbol (make-dynamic de)) - (list (if (and (null (cddr de)) + (list (if (and (null (cddr de)) (or (eq (first de) *function-symbol*) #+Genera (eq (first de) 'zl:::scl:function))) (progn @@ -167,10 +183,10 @@ ,@(when downward-p (generate-downward-function-declarations)) ,@(when dynamic-extent-functions - (generate-downward-funarg-declarations + (generate-downward-funarg-declarations (nreverse dynamic-extent-functions))) ,@(when dynamic-extent-vars - (generate-downward-rest-declarations + (generate-downward-rest-declarations (nreverse dynamic-extent-vars)))))) (when decl-stuff `((declare ,@decl-stuff)))) @@ -211,7 +227,7 @@ (defmacro with-new-function ((ll-var body-var) (lambda-list orig-body &key environment clos-method-p function-name - downward-p) + downward-p) &body body) #+Genera (declare (zwei:indentation 0 3 1 3 2 1)) `(multiple-value-bind (,ll-var ,body-var) @@ -237,7 +253,7 @@ (setf (get 'defun 'zwei:definition-function-spec-parser) (zl:::scl:function (:property zl:::scl:defun zwei:definition-function-spec-parser))) (setf (get 'defun 'zwei:definition-function-spec-type) 'zl:::scl:defun) - (setf (get 'defun 'gprint::formatter) + (setf (get 'defun 'gprint::formatter) (zl:::scl:function (:property zl:::scl:defun gprint::formatter))) (pushnew 'defun zwei:*irrelevant-functions*) (pushnew 'defun zwei:*irrelevant-defining-forms*)) @@ -344,7 +360,7 @@ `(,*defmethod* ,name ,@qualifiers ,ll ,@b)))) (lisp:defun make-method-name (function-name qualifiers lambda-list) - (let* ((specifier-list + (let* ((specifier-list (do ((ll lambda-list (cdr ll)) (result nil)) ((null ll) (nreverse result)) @@ -359,14 +375,14 @@ #+(and Allegro (not acl86win32) (version>= 4 1)) (eval-when (compile load eval) (cltl1::require :scm)) #+(and Allegro (not acl86win32) (version>= 4 1)) -(scm::define-simple-parser defmethod scm::defmethod-parser) +(excl::define-simple-parser defmethod scm::defmethod-parser) #+Genera (progn (setf (get 'defmethod 'zwei:definition-function-spec-parser) (get *defmethod* 'zwei:definition-function-spec-parser)) #-PCL - (setf (get 'defmethod 'gprint::formatter) + (setf (get 'defmethod 'gprint::formatter) (zl:::scl:function (:property clos:defmethod gprint::formatter))) (setf (get 'defmethod 'zwei:definition-function-spec-type) 'zl:::scl:defun) (pushnew 'defmethod zwei:*irrelevant-functions*) diff --git a/utils/designs.lisp b/utils/designs.lisp index a8686f48acc7ec3872f4d9b16a23814b42528ec6..670d1aed05d41441fc4c51a6ac41c0f0e30f3912 100644 --- a/utils/designs.lisp +++ b/utils/designs.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/designs.lisp,v 1.24 1998/05/19 18:51:25 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: designs.lisp,v 1.25 1998/08/06 23:17:33 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions Copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions Copyright (c) 1992 Franz, Inc. All rights reserved." ;;; Designs diff --git a/utils/excl-streams.lisp b/utils/excl-streams.lisp index c1ecc6be4d901610dd79fd3c96ad6fc22de2eb03..3bbff2ea03d29940d7b767dfe6508cec3dbff754 100644 --- a/utils/excl-streams.lisp +++ b/utils/excl-streams.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/excl-streams.lisp,v 1.6 1998/05/19 18:51:25 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: excl-streams.lisp,v 1.7 1998/08/06 23:17:33 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." #-PCL (defgeneric pathname (stream)) diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp index 2b15abaebac6ac75bb7da4656aff7273adf9635e..63e6999134339ef7964ed728872bc2f604289819 100644 --- a/utils/excl-verification.lisp +++ b/utils/excl-verification.lisp @@ -1,9 +1,5 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SYS; Base: 10; Lowercase: Yes -*- -;; -;; -[Mon Oct 13 12:11:47 1997 by layer]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/utils/excl-verification.lisp,v 1.23 1998/05/19 18:51:25 layer Exp $ +;; $Id: excl-verification.lisp,v 1.24 1998/08/06 23:17:33 layer Exp $ (in-package :sys) diff --git a/utils/extended-regions.lisp b/utils/extended-regions.lisp index 0c5a780b409382d3629f6e20ead52152b0e77b00..93a722dadfe3ebe66125272efeca0214a0352175 100644 --- a/utils/extended-regions.lisp +++ b/utils/extended-regions.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/extended-regions.lisp,v 1.10 1998/05/19 18:51:25 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: extended-regions.lisp,v 1.11 1998/08/06 23:17:33 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Extended regions diff --git a/utils/genera-streams.lisp b/utils/genera-streams.lisp index d707b23cc56e6c8a9e63cc266d839a5175bdf601..280a3f9f165d814f4f167d7304be2683f93f926e 100644 --- a/utils/genera-streams.lisp +++ b/utils/genera-streams.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/genera-streams.lisp,v 1.8 1998/05/19 18:51:26 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: genera-streams.lisp,v 1.9 1998/08/06 23:17:33 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;; Genera doesn't define STREAM-ELEMENT-TYPE as a generic function, so ;; we need to shadow it here. diff --git a/tk-silica/last.lisp b/utils/last.lisp similarity index 65% rename from tk-silica/last.lisp rename to utils/last.lisp index 820204ce56aa5e16bced7edcf72e06ae3ca7a7df..947f8bcbb40b5f6bb8b6467aab16fba6ce440a5c 100644 --- a/tk-silica/last.lisp +++ b/utils/last.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: system -*- -;; -;; -[Mon May 18 17:59:41 1998 by layer]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,17 +15,18 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: last.lisp,v 1.10 1998/05/19 18:51:15 layer Exp $ +;; $Id: last.lisp,v 1.2 1998/08/06 23:17:34 layer Exp $ (in-package :system) -(defvar system::*devel* nil) - -(load-application - (load-patches "patch" "sys:;update-clim2;") - :devel (locally (declare (special system::*devel*)) system::*devel*)) +#-(version>= 5 0 pre-final 16) +(load-patches "patch" "sys:;update-clim;*.fasl") +#+(version>= 5 0 pre-final 16) +(load-patches :product #.*patch-product-code-clim*) (provide + #+mswindows :climnt + #-mswindows (cond ((excl::featurep :clim-motif) :climxm) ((excl::featurep :clim-openlook) :climol) (t (error "Unknown Xt backend")))) diff --git a/utils/lisp-package-fixups.lisp b/utils/lisp-package-fixups.lisp index a61c03bb099c0ce63d179ae39042d73f4e1903a4..5842663db8d17b9aae42232537edb100a51bbc67 100644 --- a/utils/lisp-package-fixups.lisp +++ b/utils/lisp-package-fixups.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10 -*- - -;; $Header: /repo/cvs.copy/clim2/utils/lisp-package-fixups.lisp,v 1.11 1998/05/19 18:51:26 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: lisp-package-fixups.lisp,v 1.12 1998/08/06 23:17:34 layer Exp $ (in-package :cl-user) -"Copyright (c) 1991 by International Lisp Associates. All Rights Reserved." +;;;"Copyright (c) 1991 by International Lisp Associates. All Rights Reserved." #-aclpc (warn "utils/lisp-package-fixups should not be used anymore") diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp index 6f82a8ae125eb590980dab24381aede8909e9bfd..e58171b63c0d52959b30b32e91c8b04925efaea0 100644 --- a/utils/lisp-utilities.lisp +++ b/utils/lisp-utilities.lisp @@ -1,11 +1,27 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/lisp-utilities.lisp,v 1.38 1998/05/19 18:51:26 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: lisp-utilities.lisp,v 1.39 1998/08/06 23:17:34 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates." ;;; Define useful tools that don't exist in vanilla CL. diff --git a/utils/lucid-before.lisp b/utils/lucid-before.lisp index 23389da40236287fd6b8f509af5da791a4982b14..20518c42e499a5b330365ec25cbee58d941a0a85 100644 --- a/utils/lucid-before.lisp +++ b/utils/lucid-before.lisp @@ -21,7 +21,7 @@ (in-package :lucid) -;;; $Header: /repo/cvs.copy/clim2/utils/lucid-before.lisp,v 1.7 1998/05/19 18:51:26 layer Exp $ +;;; $Id: lucid-before.lisp,v 1.8 1998/08/06 23:17:34 layer Exp $ ;;; The advice is preventing the compiler from expanding it at compile time. (remove-advice 'defstruct) diff --git a/utils/lucid-stream-functions.lisp b/utils/lucid-stream-functions.lisp index 0947d362ea8112ca1448b0f717894f5eb7456001..5db0c732cb28c618df1640f97038415166714a11 100644 --- a/utils/lucid-stream-functions.lisp +++ b/utils/lucid-stream-functions.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- -;; $Header: /repo/cvs.copy/clim2/utils/lucid-stream-functions.lisp,v 1.12 1998/05/19 18:51:26 layer Exp $ +;; $Id: lucid-stream-functions.lisp,v 1.13 1998/08/06 23:17:34 layer Exp $ (in-package :clim-utils) diff --git a/utils/minima-stream-classes.lisp b/utils/minima-stream-classes.lisp index 90a403900eea0f0452d7a6e2a3e4cf47593a4276..c0de6e1a625619ab52e6ada77a6980c4a86bbe86 100644 --- a/utils/minima-stream-classes.lisp +++ b/utils/minima-stream-classes.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/minima-stream-classes.lisp,v 1.6 1998/05/19 18:51:27 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: minima-stream-classes.lisp,v 1.7 1998/08/06 23:17:34 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Disgusting but apparently effective... (setf (find-class 'fundamental-stream) diff --git a/utils/packages.lisp b/utils/packages.lisp index ac7003300b991aa9bef4e583be3f7fc8cd422048..94c135122e9b0edec837fa1eeffdb3c2fcaff2d8 100644 --- a/utils/packages.lisp +++ b/utils/packages.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- - -;; $Id: packages.lisp,v 1.85 1998/05/19 18:51:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: packages.lisp,v 1.86 1998/08/06 23:17:35 layer Exp $ (in-package :common-lisp-user) -"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1991, 1992 Symbolics, Inc. All rights reserved." ;; Define the CLIM-LISP package, a package designed to mimic ANSI Common Lisp @@ -3298,8 +3314,8 @@ (cl:defvar *clim-major-version* 2) (cl:defvar *clim-minor-version* 2) -(cl:defvar *clim-generation-version* 1) -(cl:defvar *clim-build-version* 17) +(cl:defvar *clim-generation-version* 2) +(cl:defvar *clim-build-version* 1) (cl:defparameter *clim-version* (cl:format () "~d.~d.~d.~a" diff --git a/utils/processes.lisp b/utils/processes.lisp index a92d1c1eab4e52ccd5cd83fa353058eceab0ee3f..a17ea112bd1285da051d057f73d7a1b761a66f60 100644 --- a/utils/processes.lisp +++ b/utils/processes.lisp @@ -1,12 +1,28 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/processes.lisp,v 1.21 1998/05/19 18:51:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: processes.lisp,v 1.22 1998/08/06 23:17:36 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. - Portions copyright (c) 1988, 1989, 1990 International Lisp Associates. - Portions copyright (c) 1992, 1993 Franz, Inc." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved. +;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates. +;;; Portions copyright (c) 1992, 1993 Franz, Inc." ;;; Locks diff --git a/utils/protocols.lisp b/utils/protocols.lisp index 3de67ef46bfa71c9f50df9eb5c3ff6c24ba20e09..def24a56b3f45d243fceea92978058c9ba41cbc8 100644 --- a/utils/protocols.lisp +++ b/utils/protocols.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/protocols.lisp,v 1.9 1998/05/19 18:51:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: protocols.lisp,v 1.10 1998/08/06 23:17:36 layer Exp $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. diff --git a/utils/queue.lisp b/utils/queue.lisp index 6342d878cda9925ca80a6efab60beaf922599676..5556178867b934833e8a0e1267c1955cebb18109 100644 --- a/utils/queue.lisp +++ b/utils/queue.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/queue.lisp,v 1.8 1998/05/19 18:51:28 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: queue.lisp,v 1.9 1998/08/06 23:17:37 layer Exp $ ;;; ;;; Copyright (c) 1989 by Xerox Corporations. All rights reserved. diff --git a/utils/reader.lisp b/utils/reader.lisp index fd9d322f1a5dfaaf3a6547881e95856dfea5a9b4..437044891397fed60ef712359a5638c81de5bc92 100644 --- a/utils/reader.lisp +++ b/utils/reader.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/reader.lisp,v 1.10 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: reader.lisp,v 1.11 1998/08/06 23:17:37 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990 International Lisp Associates. All rights reserved." +;;;"Copyright (c) 1990 International Lisp Associates. All rights reserved." ;;; This is a compile-time tool to make it easier for us to install lisp-system ;;; dependent code. diff --git a/utils/region-arithmetic.lisp b/utils/region-arithmetic.lisp index dfdc3e7f747cf05d69ef5af522ee23609d38b214..eeddcf091083c22676a2874b75f5b758eebdc954 100644 --- a/utils/region-arithmetic.lisp +++ b/utils/region-arithmetic.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/region-arithmetic.lisp,v 1.18 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: region-arithmetic.lisp,v 1.19 1998/08/06 23:17:37 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; General region union diff --git a/utils/regions.lisp b/utils/regions.lisp index 18bcb10fd46a05706488e07525c8fb1421e1e675..5a1c53471768d7ee9254933934ef89cfb4cac000 100644 --- a/utils/regions.lisp +++ b/utils/regions.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/regions.lisp,v 1.22 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: regions.lisp,v 1.23 1998/08/06 23:17:37 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Generic Functions diff --git a/utils/timers.lisp b/utils/timers.lisp index 85f1f1e08e66a7235dc0cafa62d685bf71f02dfd..aa80d6ec09bee74b6e1357a7edfbb009754e66c5 100644 --- a/utils/timers.lisp +++ b/utils/timers.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/timers.lisp,v 1.5 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: timers.lisp,v 1.6 1998/08/06 23:17:37 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1992 Franz, Inc. All rights reserved." +;;;"Copyright (c) 1992 Franz, Inc. All rights reserved." ;;; Implementation of timers ;;; It's lame but it's ugly diff --git a/utils/transformations.lisp b/utils/transformations.lisp index 50acbf474a8c9dc1a506aa2ad7d952d03128f8ff..d7acb030b28b768a39bde9dd4c54adc2f537982f 100644 --- a/utils/transformations.lisp +++ b/utils/transformations.lisp @@ -1,10 +1,26 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/transformations.lisp,v 1.15 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: transformations.lisp,v 1.16 1998/08/06 23:17:37 layer Exp $ (in-package :clim-utils) -"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." ;;; Generic Functions @@ -687,14 +703,33 @@ (declare (type real x y)) (values (coordinate x) (coordinate y))) +;; This macro is specially designed for the transformation functions +;; and shouldn't be applied elsewhere without studying the context +;; of how it is currently used. It gets rid of a few million bytes +;; of garbage without disturbing the status quo too much. JPM 6/98. +(defmacro quickadd (a b) + `(if (typep ,a 'fixnum) + (the fixnum (+ (the fixnum ,a) (the fixnum (round ,b)))) + (the short-float (+ (the short-float (coerce ,a 'short-float)) + (the short-float ,b))))) + (defmethod transform-position ((transform translation-transformation) x y) + #+original (declare (type real x y)) + #+original (let ((x (coordinate x)) (y (coordinate y))) (declare (type coordinate x y)) (with-slots (tx ty) transform (declare (type single-float tx ty)) - (values (coordinate (+ x tx)) (coordinate (+ y ty)))))) + (values (coordinate (+ x tx)) + (coordinate (+ y ty))))) + (declare (type real x y) + (optimize (speed 3) (safety 0))) + (with-slots (tx ty) transform + (declare (type short-float tx ty)) + (values (quickadd x tx) + (quickadd y ty)))) ;; coordinates *would* be single floats if we compiled with feature use-float-coordinates ;; ... why *don't* we? @@ -769,7 +804,8 @@ (coordinate x2) (coordinate y2))) (defmethod transform-rectangle* ((transform translation-transformation) x1 y1 x2 y2) - (declare (type real x1 y1 x2 y2)) + (declare (type real x1 y1 x2 y2) + (optimize (speed 3) (safety 0))) (let ((x1 (coordinate x1)) (y1 (coordinate y1)) (x2 (coordinate x2)) @@ -777,8 +813,13 @@ (declare (type coordinate x1 y1 x2 y2)) (with-slots (tx ty) transform (declare (type single-float tx ty)) + #+original (values (coordinate (+ x1 tx)) (coordinate (+ y1 ty)) - (coordinate (+ x2 tx)) (coordinate (+ y2 ty)))))) + (coordinate (+ x2 tx)) (coordinate (+ y2 ty))) + (values (quickadd x1 tx) + (quickadd y1 ty) + (quickadd x2 tx) + (quickadd y2 ty))))) (defmethod transform-rectangle* ((transform standard-transformation) x1 y1 x2 y2) (declare (type real x1 y1 x2 y2)) diff --git a/utils/utilities.lisp b/utils/utilities.lisp index 81b52e85a6c517255772603613573b34d0bcc731..193127682a713bafd2e693b720f4b77899a96b37 100644 --- a/utils/utilities.lisp +++ b/utils/utilities.lisp @@ -1,6 +1,22 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- - -;; $Header: /repo/cvs.copy/clim2/utils/utilities.lisp,v 1.12 1998/05/19 18:51:29 layer Exp $ +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. +;; +;; The software, data and information contained herein are proprietary +;; to, and comprise valuable trade secrets of, Franz, Inc. They are +;; given in confidence by Franz, Inc. pursuant to a written license +;; agreement, and may be stored and used only in accordance with the terms +;; of such license. +;; +;; Restricted Rights Legend +;; ------------------------ +;; Use, duplication, and disclosure of the software, data and information +;; contained herein by any agency, department or entity of the U.S. +;; Government are subject to restrictions of Restricted Rights for +;; Commercial Software developed at private expense as specified in +;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. +;; +;; $Id: utilities.lisp,v 1.13 1998/08/06 23:17:37 layer Exp $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. diff --git a/wnn/jl-defs.lisp b/wnn/jl-defs.lisp index 705a5e56a5dde5dc830b7e888060ea8aad3bcd6f..17665cd66aea2a02a7edd93d6e670d5177459ad9 100644 --- a/wnn/jl-defs.lisp +++ b/wnn/jl-defs.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: wnn -*- ;; -;; -[Thu Nov 10 19:28:13 1994 by smh]- +;; -[Mon Jul 6 15:35:41 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $Header: /repo/cvs.copy/clim2/wnn/jl-defs.lisp,v 1.2 1997/02/05 01:55:40 tomj Exp $ +;; $Id: jl-defs.lisp,v 1.3 1998/08/06 23:17:41 layer Exp $ (in-package :wnn) diff --git a/wnn/jl-funs.lisp b/wnn/jl-funs.lisp index e36cc6160cea329691a26d8aaaf707e086749bb0..a4a3038bcb903f905ede82c6f0c51ccc2df78189 100644 --- a/wnn/jl-funs.lisp +++ b/wnn/jl-funs.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: wnn -*- ;; -;; -[Thu Nov 10 19:28:13 1994 by smh]- +;; -[Mon Jul 6 15:35:41 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $Header: /repo/cvs.copy/clim2/wnn/jl-funs.lisp,v 1.3 1997/02/05 01:55:41 tomj Exp $ +;; $Id: jl-funs.lisp,v 1.4 1998/08/06 23:17:41 layer Exp $ (in-package :wnn) diff --git a/wnn/jserver.lisp b/wnn/jserver.lisp index 9eeb2264c9adfb672b721b3866692bee7f60d13b..cb2405b337646bdf84cd47cd0d9a4e98874b5eb2 100644 --- a/wnn/jserver.lisp +++ b/wnn/jserver.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: wnn -*- ;; -;; -[Thu Nov 10 19:28:13 1994 by smh]- +;; -[Mon Jul 6 15:35:40 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1992 Franz Inc, Berkeley, CA All rights reserved. @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $Header: /repo/cvs.copy/clim2/wnn/jserver.lisp,v 1.4 1997/02/05 01:55:43 tomj Exp $ +;; $Id: jserver.lisp,v 1.5 1998/08/06 23:17:41 layer Exp $ (in-package :wnn) diff --git a/wnn/load-wnn.lisp b/wnn/load-wnn.lisp index 4dc5af8529681c286e55541006232bb958037e89..0887245972b2e4c85dd2167736f7dc1e99b4aa2b 100644 --- a/wnn/load-wnn.lisp +++ b/wnn/load-wnn.lisp @@ -18,7 +18,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $Header: /repo/cvs.copy/clim2/wnn/load-wnn.lisp,v 1.7 1997/10/13 20:29:42 layer Exp $ +;; $Id: load-wnn.lisp,v 1.8 1998/08/06 23:17:41 layer Exp $ (in-package :user) diff --git a/wnn/pkg.lisp b/wnn/pkg.lisp index d69f8b05ea1c637f4187cdb51aa8f837b15dc0b5..9f0c31d7562fb6943f9bfecdd566431a157b10cf 100644 --- a/wnn/pkg.lisp +++ b/wnn/pkg.lisp @@ -1,6 +1,6 @@ ;; -*- mode: common-lisp; package: cl-user -*- ;; -;; -[Thu Oct 9 14:32:33 1997 by layer]- +;; -[Mon Jul 6 15:35:40 1998 by layer]- ;; ;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. ;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $Header: /repo/cvs.copy/clim2/wnn/pkg.lisp,v 1.3 1997/10/13 20:29:42 layer Exp $ +;; $Id: pkg.lisp,v 1.4 1998/08/06 23:17:41 layer Exp $ (defpackage :wnn (:use :clim-lisp :clim-utils :clim :silica :ff) diff --git a/wnn/strings.c b/wnn/strings.c index 1e6fc83e8067afed152e2d9ff803bef0c977164b..de1a1f19f3a897bbd18ca0a3030b33be698854f3 100644 --- a/wnn/strings.c +++ b/wnn/strings.c @@ -1,5 +1,5 @@ /* - * $Id: strings.c,v 1.1 1996/03/13 09:57:22 colin Exp $ + * $Id: strings.c,v 1.2 1998/08/06 23:17:41 layer Exp $ */ /* * Copyright Kyoto University Research Institute for Mathematical Sciences @@ -55,6 +55,7 @@ #include "commonhd.h" #include "wnn_string.h" +#undef NULL #define NULL 0 #define is_half_width(c) (! is_full_width(c)) diff --git a/xlib/ffi.lisp b/xlib/ffi.lisp index 72012fdc84e2aea989d8dda4c26a12575f3efeb7..a7fabf3bb585c62a3cc769c349e0916cc4ab8dc6 100644 --- a/xlib/ffi.lisp +++ b/xlib/ffi.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/xlib/ffi.lisp,v 1.20 1997/10/13 20:29:44 layer Exp $ +;; $Id: ffi.lisp,v 1.21 1998/08/06 23:17:43 layer Exp $ (in-package :x11) diff --git a/xlib/last.lisp b/xlib/last.lisp index caf813f034acdfcd4504b31f9f6f7e1220c46d20..d005698c08f420dc508c182194636ccc70e7a6f5 100644 --- a/xlib/last.lisp +++ b/xlib/last.lisp @@ -1,9 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;; -;; -[]- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -19,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/xlib/last.lisp,v 1.7 1997/02/05 01:55:59 tomj Exp $ +;; $Id: last.lisp,v 1.8 1998/08/06 23:17:43 layer Exp $ (in-package :x11) diff --git a/xlib/load-xlib.lisp b/xlib/load-xlib.lisp index 0b8cdab2ec2b6caa387d1dd3c101dba75fcb8bb2..e10d54ddf38935e6a902d75d1ac26be2a44e3dc0 100644 --- a/xlib/load-xlib.lisp +++ b/xlib/load-xlib.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved. -;; copyright (c) 1986-1993 Franz Inc, Berkeley, CA All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/xlib/load-xlib.lisp,v 1.18 1997/10/13 20:29:45 layer Exp $ +;; $Id: load-xlib.lisp,v 1.19 1998/08/06 23:17:43 layer Exp $ (in-package :x11) diff --git a/xlib/pkg.lisp b/xlib/pkg.lisp index e1be6971137331db67d905df0e2c598f2af17f64..f148b7d809ac3de89480573b62a81829c2e073b2 100644 --- a/xlib/pkg.lisp +++ b/xlib/pkg.lisp @@ -1,7 +1,5 @@ -;; -*- mode: common-lisp; package: cl-user -*- -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -17,8 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Header: /repo/cvs.copy/clim2/xlib/pkg.lisp,v 1.13 1997/02/05 01:56:02 tomj Exp $ - +;; $Id: pkg.lisp,v 1.14 1998/08/06 23:17:43 layer Exp $ (defpackage :x11 ;; These next two import symbols when loading from clim.fasl. diff --git a/xlib/x11-keysyms.lisp b/xlib/x11-keysyms.lisp index 975be0c1500826ddc9aa75be4f37e28b168bf6ee..99306dcd32e1f892de71c62f2732bad50f9b93d9 100644 --- a/xlib/x11-keysyms.lisp +++ b/xlib/x11-keysyms.lisp @@ -1,8 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -18,7 +15,10 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; +;; $Id: x11-keysyms.lisp,v 1.12 1998/08/06 23:17:43 layer Exp $ +;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. +;; ;; (c) Copyright 1989, 1990, 1991 Sun Microsystems, Inc. Sun design ;; patents pending in the U.S. and foreign countries. OPEN LOOK is a ;; registered trademark of USL. Used by written permission of the owners. @@ -43,8 +43,6 @@ ;; OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION ;; WITH THE USE OR PERFORMANCE OF THIS OBJECT CODE. -;;; $Header: /repo/cvs.copy/clim2/xlib/x11-keysyms.lisp,v 1.11 1997/02/05 01:56:04 tomj Exp $ - ;;;@(#)x11-keysym.lisp 1.3 11/29/90 diff --git a/xlib/xlib-defs.lisp b/xlib/xlib-defs.lisp index 8f0bb7aa9469d1d57aad07b18a3f7f8e9e170bfb..e582df83d45b7113186b3afa4231342625e10b5b 100644 --- a/xlib/xlib-defs.lisp +++ b/xlib/xlib-defs.lisp @@ -1,8 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -18,8 +15,9 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;;; $Header: /repo/cvs.copy/clim2/xlib/xlib-defs.lisp,v 1.13 1997/02/05 01:56:07 tomj Exp $ +;; $Id: xlib-defs.lisp,v 1.14 1998/08/06 23:17:44 layer Exp $ +;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. ;; (c) Copyright 1989, 1990, 1991 Sun Microsystems, Inc. Sun design ;; patents pending in the U.S. and foreign countries. OPEN LOOK is a ;; registered trademark of USL. Used by written permission of the owners. diff --git a/xlib/xlib-funs.lisp b/xlib/xlib-funs.lisp index d5b947157f2a5a03a149e679ca4a22edd6b5b2fb..49a3c3003fa3b5ec53302253bb4e81ea4ccbcb4a 100644 --- a/xlib/xlib-funs.lisp +++ b/xlib/xlib-funs.lisp @@ -1,8 +1,5 @@ -;; -*- mode: common-lisp; package: x11 -*- -;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. -;; -;; copyright (c) 1985, 1986 Franz Inc, Alameda, Ca. All rights reserved. -;; copyright (c) 1986-1991 Franz Inc, Berkeley, Ca. All rights reserved. +;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca. +;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved. ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -18,7 +15,9 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; +;; $Id: xlib-funs.lisp,v 1.21 1998/08/06 23:17:44 layer Exp $ +;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. ;; (c) Copyright 1989, 1990, 1991 Sun Microsystems, Inc. Sun design ;; patents pending in the U.S. and foreign countries. OPEN LOOK is a ;; registered trademark of USL. Used by written permission of the owners. @@ -44,8 +43,6 @@ ;; OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION ;; WITH THE USE OR PERFORMANCE OF THIS OBJECT CODE. -;;; $Header: /repo/cvs.copy/clim2/xlib/xlib-funs.lisp,v 1.20 1997/02/05 01:56:10 tomj Exp $ - (in-package :x11) (def-exported-foreign-function (xalloccolorcells (:return-type int) (:name "XAllocColorCells")) @@ -1580,7 +1577,12 @@ (attributes (:pointer xsetwindowattributes))) (def-exported-foreign-function (xfree (:name "XFree")) - (data (:pointer char))) + (data (:pointer char))) + +(def-exported-foreign-function (system-malloc + (:return-type (:pointer char)) + (:name "malloc")) + (size int)) (def-exported-foreign-function (xcreateimage (:return-type (:pointer ximage)) diff --git a/xlib/xlibsupport.c b/xlib/xlibsupport.c index b1fb3c03f1f2477c1ffef3f0629df4e8edd85c37..d67b35c68b7e391facbe970dbfa5d019f86ed7ac 100644 --- a/xlib/xlibsupport.c +++ b/xlib/xlibsupport.c @@ -1,6 +1,5 @@ -/* -[]- - * - * copyright (c) 1992 Franz Inc, Berkeley, CA All rights reserved. +/* + * copyright (c) 1992-1998 Franz Inc, Berkeley, CA All rights reserved. * * The software, data and information contained herein are proprietary * to, and comprise valuable trade secrets of, Franz, Inc. They are @@ -16,7 +15,7 @@ * Commercial Software developed at private expense as specified in * DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. * - * $Header: /repo/cvs.copy/clim2/xlib/xlibsupport.c,v 1.8 1997/02/05 01:56:12 tomj Exp $ + * $Id: xlibsupport.c,v 1.9 1998/08/06 23:17:44 layer Exp $ */ /************************************************************************/