From 29a1aa488533f7d0524718353d89be00e3bd2bcc Mon Sep 17 00:00:00 2001 From: layer <layer> Date: Thu, 6 Aug 1998 23:17:44 +0000 Subject: [PATCH] join from acl50 branch with tag acl50_merge1 --- .cvsignore | 4 +- ChangeLog.n | 219 ++++++ Makefile | 6 +- Makefile.defs | 21 +- Makefile.generic | 25 +- Makefile.linux | 25 + Makefile.sgi4d-svr4 | 4 +- aclpc/acl-class.lisp | 837 ++++++++++++---------- aclpc/acl-dc.lisp | 340 ++++----- aclpc/acl-frames.lisp | 658 ++++++++++------- aclpc/acl-medium.lisp | 835 +++++++++++---------- aclpc/acl-mirror.lisp | 253 +++---- aclpc/acl-pixmaps.lisp | 102 +-- aclpc/acl-port.lisp | 281 +++++--- aclpc/acl-prel.lisp | 287 +++++--- aclpc/acl-scroll.lisp | 91 ++- aclpc/acl-widget.lisp | 555 ++++++-------- aclpc/climpat.lisp | 19 +- aclpc/pkgdcl.lisp | 26 +- aclpc/sysdcl.lisp | 23 +- aclpc/winwidgh.lisp | 229 ++---- buildclim.cl | 3 +- clim/accept-values.lisp | 26 +- clim/accept.lisp | 22 +- clim/activities.lisp | 24 +- clim/basic-translators.lisp | 22 +- clim/clim-defs.lisp | 24 +- clim/command-processor.lisp | 31 +- clim/command.lisp | 22 +- clim/completer.lisp | 24 +- clim/coordinate-sorted-set.lisp | 24 +- clim/cursor.lisp | 24 +- clim/db-list.lisp | 42 +- clim/db-menu.lisp | 241 ++----- clim/db-stream.lisp | 26 +- clim/db-text.lisp | 24 +- clim/default-frame.lisp | 22 +- clim/defprotocol.lisp | 22 +- clim/defresource.lisp | 22 +- clim/design-recording.lisp | 25 +- clim/drag-and-drop.lisp | 22 +- clim/dragging-output.lisp | 24 +- clim/excl-presentations.lisp | 13 +- clim/formatted-output-defs.lisp | 24 +- clim/frames.lisp | 33 +- clim/gadget-output.lisp | 24 +- clim/gestures.lisp | 24 +- clim/graph-formatting.lisp | 24 +- clim/graphics-recording.lisp | 26 +- clim/histories.lisp | 22 +- clim/incremental-redisplay.lisp | 24 +- clim/input-defs.lisp | 22 +- clim/input-editor-commands.lisp | 22 +- clim/input-protocol.lisp | 24 +- clim/interactive-defs.lisp | 24 +- clim/interactive-protocol.lisp | 24 +- clim/item-list-manager.lisp | 22 +- clim/japanese-input-editor.lisp | 13 +- clim/logical-gestures.lisp | 11 +- clim/lucid-after.lisp | 2 +- clim/menus.lisp | 55 +- clim/noting-progress.lisp | 22 +- clim/output-protocol.lisp | 32 +- clim/panes.lisp | 26 +- clim/pixmap-streams.lisp | 22 +- clim/prefill.lisp | 22 +- clim/present.lisp | 22 +- clim/presentations.lisp | 24 +- clim/ptypes1.lisp | 22 +- clim/ptypes2.lisp | 22 +- clim/r-tree.lisp | 22 +- clim/recording-defs.lisp | 22 +- clim/recording-protocol.lisp | 26 +- clim/standard-types.lisp | 22 +- clim/stream-class-defs.lisp | 22 +- clim/stream-defprotocols.lisp | 24 +- clim/stream-trampolines.lisp | 22 +- clim/surround-output.lisp | 24 +- clim/table-formatting.lisp | 24 +- clim/temp-strings.lisp | 22 +- clim/text-formatting.lisp | 28 +- clim/text-recording.lisp | 24 +- clim/tracking-pointer.lisp | 24 +- clim/translators.lisp | 22 +- clim/view-defs.lisp | 24 +- clim/window-stream.lisp | 24 +- cloe/cloe-activities.lisp | 2 +- cloe/cloe-dc.lisp | 2 +- cloe/cloe-frames.lisp | 2 +- cloe/cloe-gadgets.lisp | 2 +- cloe/cloe-implementation.lisp | 2 +- cloe/cloe-medium.lisp | 2 +- cloe/cloe-menus.lisp | 2 +- cloe/cloe-mirror.lisp | 2 +- cloe/cloe-pixmaps.lisp | 2 +- cloe/cloe-port.lisp | 2 +- cloe/cloe-streams.lisp | 2 +- cloe/patch.lisp | 2 +- cloe/pkgdcl.lisp | 2 +- cloe/sysdcl.lisp | 2 +- cloe/wheader.lisp | 2 +- cloe/windows.lisp | 2 +- clx/clx-fast.lisp | 22 +- clx/clx-frames.lisp | 22 +- clx/clx-gadgets.lisp | 2 +- clx/clx-medium.lisp | 22 +- clx/clx-mirror.lisp | 24 +- clx/clx-pixmaps.lisp | 22 +- clx/clx-port.lisp | 24 +- clx/clx-prefill.lisp | 22 +- clx/old-clx-implementation.lisp | 19 +- clx/pkgdcl.lisp | 22 +- clx/sysdcl.lisp | 22 +- compatibility/clim1-compatibility.lisp | 22 +- compatibility/packages.lisp | 22 +- compatibility/sysdcl.lisp | 22 +- demo/address-book.lisp | 22 +- demo/bitmap-editor.lisp | 19 +- demo/browser.lisp | 22 +- demo/cad-demo.lisp | 24 +- demo/cload-demos.lisp | 9 +- demo/color-editor.lisp | 22 +- demo/custom-records.lisp | 22 +- demo/default-frame-top-level.lisp | 8 +- demo/demo-activity.lisp | 24 +- demo/demo-driver.lisp | 22 +- demo/demo-last.lisp | 10 +- demo/demo-prefill.lisp | 22 +- demo/graphics-demos.lisp | 24 +- demo/graphics-editor.lisp | 22 +- demo/ico.lisp | 21 +- demo/japanese-graphics-editor.lisp | 24 +- demo/listener.lisp | 22 +- demo/navdata.lisp | 20 +- demo/navfun.lisp | 22 +- demo/output-record.lisp | 19 +- demo/packages.lisp | 24 +- demo/palette.lisp | 19 +- demo/peek-frame.lisp | 19 +- demo/plot.lisp | 19 +- demo/printer.lisp | 19 + demo/process-browser.lisp | 19 +- demo/puzzle.lisp | 22 +- demo/sysdcl-pc.lisp | 24 +- demo/sysdcl.lisp | 24 +- demo/thinkadot.lisp | 22 +- demo/winlisp.lisp | 22 +- genera/genera-activities.lisp | 2 +- genera/genera-fast.lisp | 2 +- genera/genera-frames.lisp | 2 +- genera/genera-gadgets.lisp | 2 +- genera/genera-medium.lisp | 2 +- genera/genera-mirror.lisp | 2 +- genera/genera-pixmaps.lisp | 2 +- genera/genera-port.lisp | 2 +- genera/genera-prefill.lisp | 2 +- genera/old-genera-implementation.lisp | 2 +- genera/pkgdcl.lisp | 2 +- genera/sysdcl.lisp | 2 +- homegrown/db-button.lisp | 2 +- homegrown/db-label.lisp | 4 +- homegrown/db-list.lisp | 2 +- homegrown/db-menu.lisp | 55 +- homegrown/db-slider.lisp | 2 +- homegrown/db-text.lisp | 2 +- homegrown/last.lisp | 4 +- homegrown/scroll-pane.lisp | 2 +- hpgl/hpgl-medium.lisp | 67 +- hpgl/hpgl-port.lisp | 6 +- hpgl/pkg.lisp | 2 +- hpgl/sysdcl.lisp | 2 +- instclimol.lisp | 4 +- instclimxm.lisp | 4 +- makedist.sh | 23 + misc/MyDrawingA.c | 6 +- misc/compile-1.lisp | 77 +- misc/dev-load-1.lisp | 6 +- misc/dump.lisp | 4 +- misc/pixmaps.lisp | 2 +- misc/train.lisp | 4 +- postscript/laserwriter-metrics.lisp | 2 +- postscript/pkgdcl.lisp | 2 +- postscript/postscript-medium.lisp | 7 +- postscript/postscript-port.lisp | 2 +- postscript/postscript-prefill.lisp | 2 +- postscript/postscript-s.lisp | 4 +- postscript/read-afm.lisp | 4 +- postscript/sysdcl-pc.lisp | 2 +- postscript/sysdcl.lisp | 2 +- pre-silica/cloe-applications.lisp | 2 +- pre-silica/cloe-events.lisp | 2 +- pre-silica/cloe-implementation.lisp | 2 +- pre-silica/clx-implementation.lisp | 2 +- pre-silica/default-application.lisp | 2 +- pre-silica/define-application.lisp | 2 +- pre-silica/defs-graphics-generics.lisp | 2 +- pre-silica/drawing-state-mixin.lisp | 2 +- pre-silica/genera-implementation.lisp | 2 +- pre-silica/graphics-generics.lisp | 2 +- pre-silica/graphics-internals.lisp | 2 +- pre-silica/laserwriter-metrics.lisp | 2 +- pre-silica/postscript-implementation.lisp | 2 +- pre-silica/protocol-intermediaries.lisp | 2 +- pre-silica/vertical-string.lisp | 2 +- pre-silica/wheader.lisp | 2 +- pre-silica/window-protocol.lisp | 2 +- pre-silica/windows.lisp | 2 +- readme.win32 | 76 ++ silica/classes.lisp | 35 +- silica/clim.lisp | 7 +- silica/db-border.lisp | 54 +- silica/db-box.lisp | 24 +- silica/db-button.lisp | 26 +- silica/db-label.lisp | 15 +- silica/db-layout.lisp | 26 +- silica/db-scroll.lisp | 109 ++- silica/db-slider.lisp | 22 +- silica/db-table.lisp | 24 +- silica/event.lisp | 24 +- silica/framem.lisp | 24 +- silica/gadgets.lisp | 26 +- silica/graphics.lisp | 24 +- silica/layout.lisp | 26 +- silica/macros.lisp | 24 +- silica/medium.lisp | 24 +- silica/mirror.lisp | 24 +- silica/pixmaps.lisp | 24 +- silica/port.lisp | 24 +- silica/protocols.lisp | 8 +- silica/scroll-pane.lisp | 28 +- silica/sheet.lisp | 24 +- silica/std-sheet.lisp | 22 +- silica/text-style.lisp | 26 +- sys/compile.lisp | 22 +- sys/defsystem.lisp | 20 +- sys/distribution-script.lisp | 20 +- sys/do.lisp | 19 + sys/fids-pre.lisp | 18 + sys/load-clim2.lisp | 20 +- sys/load.lisp | 19 + sys/loaddemo.lisp | 19 + sys/loadnd.lisp | 19 + sys/odrawpat.lisp | 18 + sys/recompile.lisp | 19 + sys/sysdcl-pc.lisp | 20 +- sys/sysdcl.lisp | 30 +- test/chess.lisp | 4 +- test/color-ed.lisp | 4 +- test/hpgl-tests.lisp | 2 +- test/postscript-tests.lisp | 2 +- test/simple-test.lisp | 4 +- test/test-buttons.lisp | 2 +- test/test-clim-tests.lisp | 4 +- test/test-clim.lisp | 4 +- test/test-demos.lisp | 2 +- test/test-sliders.lisp | 2 +- test/test-suite.lisp | 2 +- test/test.lisp | 2 +- test/testdcl.lisp | 2 +- tk-silica/gc-cursor.lisp | 47 +- tk-silica/image.lisp | 13 +- tk-silica/ol-frames.lisp | 11 +- tk-silica/ol-gadgets.lisp | 11 +- tk-silica/ol-silica.lisp | 10 +- tk-silica/pkg.lisp | 8 +- tk-silica/xm-dialogs.lisp | 10 +- tk-silica/xm-frames.lisp | 8 +- tk-silica/xm-gadgets.lisp | 8 +- tk-silica/xm-silica.lisp | 14 +- tk-silica/xt-frames.lisp | 25 +- tk-silica/xt-gadgets.lisp | 12 +- tk-silica/xt-graphics.lisp | 13 +- tk-silica/xt-pixmaps.lisp | 11 +- tk-silica/xt-silica.lisp | 60 +- tk-silica/xt-stipples.lisp | 9 +- tk/callbacks.lisp | 13 +- tk/convenience.lisp | 9 +- tk/event.lisp | 9 +- tk/examples.lisp | 9 +- tk/font.lisp | 11 +- tk/foreign-obj.lisp | 9 +- tk/foreign.lisp | 13 +- tk/gcontext.lisp | 26 +- tk/graphics.lisp | 9 +- tk/load-ol.lisp | 7 +- tk/load-xm.lisp | 7 +- tk/macros.lisp | 9 +- tk/make-classes.lisp | 9 +- tk/make-widget.lisp | 9 +- tk/meta-tk.lisp | 9 +- tk/ol-callbacks.lisp | 9 +- tk/ol-classes.lisp | 9 +- tk/ol-defs.lisp | 9 +- tk/ol-examples.lisp | 10 +- tk/ol-funs.lisp | 10 +- tk/ol-init.lisp | 10 +- tk/ol-widgets.lisp | 10 +- tk/pkg.lisp | 10 +- tk/resources.lisp | 12 +- tk/widget.lisp | 14 +- tk/xlib.lisp | 15 +- tk/xm-callbacks.lisp | 11 +- tk/xm-classes.lisp | 11 +- tk/xm-defs.lisp | 10 +- tk/xm-font-list.lisp | 10 +- tk/xm-funs.lisp | 10 +- tk/xm-init.lisp | 10 +- tk/xm-protocols.lisp | 10 +- tk/xm-widgets.lisp | 11 +- tk/xt-classes.lisp | 10 +- tk/xt-defs.lisp | 10 +- tk/xt-funs.lisp | 11 +- tk/xt-init.lisp | 11 +- utils/autoconstructor.lisp | 20 +- utils/base-designs.lisp | 24 +- utils/ccl-streams.lisp | 22 +- utils/cl-stream-classes.lisp | 24 +- utils/cl-stream-functions.lisp | 24 +- utils/cl-streams.lisp | 14 +- utils/clim-macros.lisp | 24 +- utils/clim-streams.lisp | 24 +- utils/clos-patches.lisp | 22 +- utils/clos.lisp | 20 +- utils/condpat.lisp | 22 +- utils/coral-char-bits.lisp | 22 +- utils/defpackage.lisp | 24 +- utils/defun-utilities.lisp | 22 +- utils/defun.lisp | 40 +- utils/designs.lisp | 24 +- utils/excl-streams.lisp | 22 +- utils/excl-verification.lisp | 10 +- utils/extended-regions.lisp | 22 +- utils/genera-streams.lisp | 22 +- {tk-silica => utils}/last.lisp | 21 +- utils/lisp-package-fixups.lisp | 22 +- utils/lisp-utilities.lisp | 24 +- utils/lucid-before.lisp | 2 +- utils/lucid-stream-functions.lisp | 2 +- utils/minima-stream-classes.lisp | 22 +- utils/packages.lisp | 26 +- utils/processes.lisp | 26 +- utils/protocols.lisp | 20 +- utils/queue.lisp | 20 +- utils/reader.lisp | 22 +- utils/region-arithmetic.lisp | 22 +- utils/regions.lisp | 22 +- utils/timers.lisp | 22 +- utils/transformations.lisp | 53 +- utils/utilities.lisp | 20 +- wnn/jl-defs.lisp | 4 +- wnn/jl-funs.lisp | 4 +- wnn/jserver.lisp | 4 +- wnn/load-wnn.lisp | 2 +- wnn/pkg.lisp | 4 +- wnn/strings.c | 3 +- xlib/ffi.lisp | 8 +- xlib/last.lisp | 10 +- xlib/load-xlib.lisp | 8 +- xlib/pkg.lisp | 9 +- xlib/x11-keysyms.lisp | 12 +- xlib/xlib-defs.lisp | 10 +- xlib/xlib-funs.lisp | 18 +- xlib/xlibsupport.c | 7 +- 363 files changed, 6791 insertions(+), 3746 deletions(-) create mode 100644 Makefile.linux create mode 100644 makedist.sh create mode 100644 readme.win32 rename {tk-silica => utils}/last.lisp (65%) diff --git a/.cvsignore b/.cvsignore index 61eaed77..a5af7908 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 007351e3..d85f0af9 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 71c4c134..559ae200 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 bd38b87d..893edd94 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 e237f1b2..8d3b8877 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 00000000..a0049a55 --- /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 9d602a3e..dac56933 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 eea0641c..0930217e 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 e6f21039..a14f76fe 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 2ea0ad46..8aa16e10 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 267c3c11..449b3c5e 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 4a44e3f7..7670d29b 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 d5d04372..29945c8a 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 f9f14045..5c4a63df 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 113d4781..0584cba6 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 f2361e1e..8b7bdc59 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 d65e6dcc..c9ae0754 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 2d50a012..fffc1188 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 78a4b924..06037ae6 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 a4755e6c..67225508 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 c3964439..f54bb02c 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 c15ad892..3a820839 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 e7fc73bc..5d97c613 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 832bc23a..bb89c684 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 e9cf034b..64a3b379 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 7a18e6ba..19b81e03 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 3a5f1776..1de87f60 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 ad50c5af..0ede9fb1 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 56716716..2c514bad 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 61e730f6..232ca576 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 dfcfa23d..c3c2306c 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 fca62b55..073e0422 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 acdf5d8d..e43fb1db 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 9bb4ac17..47127383 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 8877a75f..6234ce18 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 71ca47da..e6719174 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 4d33d591..64b2bee8 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 ebc9c0d1..aeab4749 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 54997329..7f4dc991 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 a99147c8..2ceaaac3 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 75a58106..765f0734 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 9cdaf770..4ebe4543 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 da4ff33b..647ddea2 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 b9dde53a..40a33792 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 84294977..fdcd4583 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 648958d6..a3a2ca2e 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 fba436da..b9aefd3c 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 7838ba52..dcb9cf32 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 39874b65..909bd395 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 0ddc691b..ad42fef0 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 bb353dc4..6cb251cf 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 4a990c44..c82a3279 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 048815d7..6e0ea638 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 2cd094ab..04e956b2 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 e6164a59..9ce74255 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 451ea430..1f328e74 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 220bb2ae..dfaa46b5 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 83b8db9d..0d6cdb5f 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 eb75e6bb..475631a6 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 545e1f2d..2c1f6da4 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 1d2bf3a7..727da227 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 d1d0ff13..f6b70921 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 bd9bd2be..0c2b4620 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 02644039..89c692fe 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 960c39d0..b57f0b45 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 4bef5354..8b78f232 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 425262ba..c89c2320 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 06bf4571..5c11c120 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 7bc6cad9..13983592 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 bd056cd0..8637057b 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 1fdad4a6..ae229bd4 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 9cc5e387..23c7fb2e 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 641155f2..257ec704 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 c5a8382e..7d48b7a6 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 657dd6d3..486bb42b 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 534d7811..69c456b3 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 2c64060b..3b239fa4 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 e7a0615a..ef1bb54c 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 0fe16da9..56c0d805 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 febcc4be..05875aac 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 cc985e7d..0843da52 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 b813692e..043e6e3b 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 c1bccc92..1d373c97 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 0f739dbf..6b5dc184 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 0c180f1d..d009bf35 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 8f893727..59ba7864 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 d4559645..1a644453 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 cabfe11a..3aed9c00 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 cce3a560..a332d309 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 b7867777..6bbfe522 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 1927c530..988a81ce 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 6d788ea6..d9cf3915 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 e20ed051..95b3783e 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 94eb1425..f0df8673 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 b7d5d558..9f53ee25 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 5e1ecec0..c0219e94 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 d0628d9f..dfacb89f 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 c41f0377..5ae2ee89 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 1cf48029..e7299cdc 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 03855b7c..9c51c709 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 c44c5398..8f28e4dc 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 c613ddcb..edc7dc39 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 3823163c..e1ac7045 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 fbefca0b..23293ef3 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 0f9b2f58..e2ae6148 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 311f740b..8e9a4785 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 08201d09..035a6c00 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 224cada4..4459f6f7 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 e3657d7a..3edf6178 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 7cf4be4c..8c6ba823 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 d061d652..35fcdf48 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 7b54c15a..f66267a6 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 f9000c29..00dc3731 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 7228a9ad..7e2b53d9 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 e25f3566..91049694 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 9ff6b409..29d2d2ce 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 e2f80de1..f3e4e28e 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 23df9829..53b736bd 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 edf77e7f..3d45d61e 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 465c63d6..3ffd3a3e 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 afe58218..4544f754 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 9f4f5fa2..59544e1e 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 ecac6818..d7f48d2e 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 99586cbe..9b8ec367 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 f6b39ec0..b56cd3e2 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 776e1f97..a7a2482f 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 1e559479..a8511a9d 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 712e7c80..37a1042f 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 e35d0757..7b8a583c 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 ff31863f..9fbab128 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 776b18f1..fb629410 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 b005a63d..71aee121 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 f5d19f9d..e5506c49 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 3cb8dc5c..a5b7fdea 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 d41b70f9..f4e0c37d 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 502d8280..fc31bb2f 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 d625f93a..7cfc0d3b 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 352923bd..a11b675e 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 f0f5d418..d23238ea 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 a053e256..42d5d865 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 377e229b..eefb727e 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 8a683fa0..646e7ba5 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 c6fbef7d..42bb8ba3 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 e251672c..36dacde3 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 febae294..a619610c 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 3ee2da78..e2f7d132 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 cd0377f5..89505559 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 e887478f..f46f09a2 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 2668224f..dc737015 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 f56a0fe2..4f2e5d47 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 ca85da82..5edf4f99 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 c6d94978..8cda5a98 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 eb9243a5..ecc9cb4f 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 679efdcc..25e5be54 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 277a7429..82b2347a 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 ec005fe0..c02384d1 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 c8804282..516b0f86 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 577bd326..3a5835e6 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 a38e4c59..f010f285 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 d2620ee6..4d60c273 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 9ec98313..e164241a 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 eccce30a..1dfa594d 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 374202f6..d5d062b5 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 aa5f86bb..8715cae5 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 814c1b08..3ab5bbfb 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 65b189a6..519c8711 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 362b9a7f..245b8593 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 24b4d81a..430eb5a4 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 3ba78380..e29672ca 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 29b1523c..ef2fd5b7 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 96ac096d..81d10600 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 4c18ae50..864714c4 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 03d16619..d60adc60 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 00000000..9d259e54 --- /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 fdb618c0..daaaf6ed 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 a6dbf4ed..70f66a1c 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 d24e2c2d..d59a6a58 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 f9b0b2b5..9231ecb4 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 6d38bde5..0dc52c7a 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 69c36c3a..60d1ccce 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 be303745..79baf19a 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 b4038cf3..884c6531 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 7cefc3e2..baa1be20 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 d66cd70f..8242bff3 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 5d126ccd..d0c7d3e8 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 77b29283..ecb2b9b3 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 45657665..8e480a77 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 c3ff8ff5..eea35e1f 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 ba6944bf..382e78ff 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 c9c23284..b1eae21b 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 49b2d9e1..a122ed09 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 6308b8d0..adfb2d2d 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 50c7cd75..72b6cf7c 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 670761b0..ce985076 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 4bd5377d..481df23a 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 75b26d76..d4e792e6 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 2530bba3..cc93c0fa 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 32f36272..b89fd187 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 50bd3fd6..472c21fc 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 30ccee59..939e8e91 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 206ec9da..84c8da0f 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 be2d2d20..23fbe771 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 0a2636f9..727427f4 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 b8963a62..0c97768b 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 ca74c627..4fdc2654 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 e7143d24..ec64a392 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 d008418d..3b49a796 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 00000000..0b1e8003 --- /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 0d19f1e5..bfc5ac28 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 07324d5d..66d96d7d 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 09272e23..fb17e868 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 5d2ba782..618ca95b 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 8c517f83..e504f458 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 2528d35a..4a099262 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 798807ec..b3260928 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 c7da6d53..2b30669a 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 b3fb6aed..62390486 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 77fdd7cb..e4a06008 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 d7d25d3c..356731c4 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 9edd5fe3..eaaac45c 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 0d5678ad..faecd89d 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 300ff088..448bac3f 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 07a38e50..bd0e9309 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 8ec5b9ec..065bead8 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 f7dfb9c4..891e225d 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 1139c3c8..41c05ef4 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 37b4dab5..d4a408e8 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 fc27b41d..51f5d064 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 78eedaa1..257caad2 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 a18d4da8..552a4cd9 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 f7889371..0201a2a7 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 f914b603..3b77df7a 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 ef1e99ae..65a7ebcd 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 01e1b4d4..adcd5482 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 0496a809..fb4baae2 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 653769c2..85610b58 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 46bc6ee0..fef14972 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 5d321e7c..20545a2e 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 7f34eafe..ae28095e 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 67713070..3d0d8b76 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 ab9f0dff..9dbda4d9 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 308399a8..c4504e10 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 79432aa3..077795d4 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 1406b3cf..0897975f 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 6975f2b8..dca3b51e 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 e8a19641..9febc943 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 6549a264..4da24154 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 0f4d47f2..d841bf50 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 605feab2..ea8b89bc 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 4b96bff8..b0efb30c 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 8d6d14c6..cbc5c71b 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 d7f184ed..505e43a3 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 dbf4ea9c..59159d70 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 24bf7ce3..300ac67a 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 45aa6721..b51714a8 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 0045b976..9987e3fb 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 9577339f..9ed60511 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 6f27e370..8a3e74f6 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 22482e5b..3a83e4b0 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 536ab7c0..7a8a89f8 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 5e69a591..5e5129a0 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 4066e019..e2d74bb1 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 e710c634..c4c728bb 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 0bfe16ba..50323dc9 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 912db41d..d8c1e810 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 92bdfbb0..73124912 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 5e3aafc4..5ea2618e 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 0f8af362..42979bb8 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 040e99f0..33de5a93 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 695af086..7202474d 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 7c74d1ca..46fc90fd 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 ff3b6b75..4accb06f 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 73d89f75..d8c3f9dd 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 59a33556..480482e5 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 a6abb125..6e01f34b 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 541051ed..fa965397 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 0242b9ca..051ecbc1 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 ff011e98..a87ae3c9 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 d25b91b9..2d89b08a 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 cf6b9532..1fdc1d63 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 12e2e659..c84a81b3 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 c0b40843..77d5d414 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 fa07d697..580a9490 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 c0a62f13..81f1dc09 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 ec797a1c..be6d31cf 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 a7a855da..c2c2907f 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 87cc2d73..c180d66b 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 049ac494..e91dbf7f 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 9d325e8a..970069d7 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 aa1977b9..2ad07dca 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 050c2198..4358fc19 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 4ba2b0fc..c7bb466b 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 19e07254..a679f2cc 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 bbf5a85b..c580a10c 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 f33b4477..74025f7a 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 04614084..46a4a075 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 5855ede7..e37c0383 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 938f679b..09b47ce7 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 3be8c1e7..2458cc0d 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 757a1bd3..7bf9d4e5 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 f36e2435..c3b8c4b9 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 e93e45e3..54db8282 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 cea49527..38678288 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 b7d3d991..afbfb274 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 5093d0f2..c1ff7968 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 346a09c8..9bce8caa 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 f3d429e5..cddfbc96 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 ce6b0f12..f704cc07 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 01859a12..50bb77b4 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 f42f2014..bb16748c 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 c628a8f3..25d95e58 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 184afd6f..f7d473a6 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 68173ba7..fb2f99ff 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 4f7e5e0e..098e6f30 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 ee4eec89..8bf0ef55 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 2683b6e1..852e2258 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 feae3aae..c84dd6f5 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 4d399824..93fb984a 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 ea91d2a9..30710626 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 85ad1a77..777754b2 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 d584df17..1fe92573 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 51a28a16..98cbc704 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 35ef28ca..296d4b9e 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 bb8c8844..c7ce6965 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 bae79a92..3d3cf957 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 194a14ec..09b7c470 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 243c0c04..bcc6e119 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 7e18fa0d..71b28102 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 a8686f48..670d1aed 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 c1ecc6be..3bbff2ea 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 2b15abae..63e69991 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 0c5a780b..93a722da 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 d707b23c..280a3f9f 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 820204ce..947f8bcb 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 a61c03bb..5842663d 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 6f82a8ae..e58171b6 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 23389da4..20518c42 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 0947d362..5db0c732 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 90a40390..c0de6e1a 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 ac700330..94c13512 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 a92d1c1e..a17ea112 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 3de67ef4..def24a56 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 6342d878..55561788 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 fd9d322f..43704489 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 dfdc3e7f..eeddcf09 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 18bcb10f..5a1c5347 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 85f1f1e0..aa80d6ec 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 50acbf47..d7acb030 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 81b52e85..19312768 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 705a5e56..17665cd6 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 e36cc616..a4a3038b 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 9eeb2264..cb2405b3 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 4dc5af85..08872459 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 d69f8b05..9f0c31d7 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 1e6fc83e..de1a1f19 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 72012fdc..a7fabf3b 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 caf813f0..d005698c 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 0b8cdab2..e10d54dd 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 e1be6971..f148b7d8 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 975be0c1..99306dcd 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 8f0bb7aa..e582df83 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 d5b94715..49a3c300 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 b1fb3c03..d67b35c6 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 $ */ /************************************************************************/ -- GitLab