diff --git a/Makefile b/Makefile index 8a542642c1de82235fda3377cddc241b6c481ae8..67329702d2039ef602bd4d4907ae148e6cb8e314 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $fiHeader: Makefile,v 1.11 92/02/24 13:09:36 cer Exp Locker: cer $ +# $fiHeader: Makefile,v 1.12 92/02/26 10:23:58 cer Exp Locker: cer $ # # Makefile for CLIM 2.0 # @@ -55,6 +55,7 @@ CLIM-UTILS-OBJS = utils/excl-verification.fasl \ utils/transformations.fasl \ utils/regions.fasl \ utils/region-arithmetic.fasl \ + utils/extended-regions.fasl \ utils/designs.fasl CLIM-SILICA-OBJS = silica/classes.fasl \ @@ -65,6 +66,7 @@ CLIM-SILICA-OBJS = silica/classes.fasl \ silica/event.fasl \ silica/port.fasl \ silica/medium.fasl \ + silica/framem.fasl \ silica/graphics.fasl \ silica/std-sheet.fasl \ silica/layout.fasl \ @@ -72,7 +74,8 @@ CLIM-SILICA-OBJS = silica/classes.fasl \ silica/db-box.fasl \ silica/db-table.fasl \ silica/gadgets.fasl \ - silica/db-scroll.fasl + silica/db-scroll.fasl \ + silica/db-border.fasl CLIM-STANDALONE-OBJS = clim/gestures.fasl \ clim/defprotocol.fasl \ @@ -88,7 +91,6 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \ clim/input-defs.fasl \ clim/input-protocol.fasl \ clim/output-protocol.fasl \ - clim/window-protocol.fasl \ clim/recording-protocol.fasl \ clim/text-recording.fasl \ clim/graphics-recording.fasl \ @@ -104,6 +106,7 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \ clim/translators.fasl \ clim/histories.fasl \ clim/ptypes2.fasl \ + clim/excl-presentations.fasl \ clim/standard-types.fasl \ clim/table-formatting.fasl \ clim/graph-formatting.fasl \ @@ -167,7 +170,8 @@ MOTIF-CLIM-OBJS = xm-silica/pkg.fasl \ xm-silica/xt-gadgets.fasl \ xm-silica/xm-gadgets.fasl \ xm-silica/xm-menus.fasl \ - xm-silica/xt-pixmaps.fasl + xm-silica/xt-pixmaps.fasl \ + xm-silica/xm-cursor.fasl OL-CLIM-OBJS = tk/ol-classes.fasl \ tk/ol-init.fasl \ @@ -208,6 +212,11 @@ compile: FORCE clim.fasl: $(MOTIF-OBJS) $(CAT) $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami` $(MV) $(TMP)/clim.fasl_`whoami` clim.fasl + ls -lt clim.fasl >> Clim-sizes.n + ls -lt clim.fasl + +echo-fasls: + ls -lt $(MOTIF-OBJS) > /tmp/foo clim-debug.fasl: $(MOTIF-OBJS) $(CAT) $(DEBUG-OBJS) > $(TMP)/clim-debug.fasl_`whoami` @@ -223,6 +232,8 @@ clim: FORCE (load \"misc/dev-load-xm.lisp\") \ (load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch $(MV) $(TMP)/clim.temp_`whoami` $(CLIM) + ls -lt $(CLIM) >> Clim-sizes.n + ls -lt $(CLIM) clim-small: FORCE $(ECHO) " \ @@ -231,7 +242,9 @@ clim-small: FORCE (load \"misc/load-xm.lisp\") \ (load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch $(MV) $(TMP)/clim.temp_`whoami` $(CLIM-SMALL) - + ls -lt $(CLIM-SMALL) >> Clim-sizes.n + ls -lt $(CLIM-SMALL) + xm-composer: cd tk ; $(MAKE) xm-composer diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp index 128f325358b426c313c10578d7a90b454c8ea954..f69c0afd662a37d256343128d8833e523c4af9d8 100644 --- a/clim/excl-presentations.lisp +++ b/clim/excl-presentations.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: excl-presentations.lisp,v 1.3 92/02/24 13:09:45 cer Exp Locker: cer $ +;; $fiHeader: excl-presentations.lisp,v 1.4 92/02/26 10:23:36 cer Exp Locker: cer $ (in-package :clim-internals) @@ -39,8 +39,11 @@ &rest args &key (type nil type-p) object) - (unless (and type-p - (find-presentation-type-class type nil)) + (when (and (null type-p) + ;;--- If its a lisp kind of object then we want to generate expressions + ;;--- but in the lisp thats all we generate to there + ;;--- should be a problem + t) (setf (getf args :type) (presentation-type-of object))) (apply #'call-next-method rec args)) diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp index adf15ebb3380029c331571de2860b5ff9a7d5d42..12031d350a30822772071b7630cf476873315ebd 100644 --- a/clim/input-protocol.lisp +++ b/clim/input-protocol.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: input-protocol.lisp,v 1.5 92/01/31 14:58:16 cer Exp $ +;; $fiHeader: input-protocol.lisp,v 1.6 92/02/24 13:07:54 cer Exp Locker: cer $ (in-package :clim-internals) @@ -370,11 +370,12 @@ ;; Presentation translators have probably already run... (defmethod receive-gesture - ((stream input-protocol-mixin) (gesture pointer-button-press-event)) - (when *pointer-button-press-handler* - ;; This may throw or something, but otherwise we will return the gesture - (funcall *pointer-button-press-handler* stream gesture)) - gesture) + ((stream input-protocol-mixin) (gesture pointer-button-press-event)) + (if *pointer-button-press-handler* + ;; This may throw or something, but otherwise we will return the gesture + (progn (funcall *pointer-button-press-handler* stream gesture) + nil) + gesture)) (defmethod receive-gesture ((stream input-protocol-mixin) (gesture (eql ':resynchronize))) diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp index 117f176f97e7d3bd20983e2b5032e9bcdcd573d0..7989cb038c36d7f5576510dbf6e221aa97daa469 100644 --- a/clim/ptypes1.lisp +++ b/clim/ptypes1.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: ptypes1.lisp,v 1.4 92/02/24 13:08:21 cer Exp Locker: cer $ +;; $fiHeader: ptypes1.lisp,v 1.5 92/02/26 10:23:42 cer Exp Locker: cer $ (in-package :clim-internals) @@ -397,6 +397,12 @@ (defmethod acceptable-presentation-type-class ((class ccl::compile-time-class)) nil) +#+Allegro +(progn + (warn "This should be elsewhere") + (defmethod clos::class-prototype ((class clos::structure-class)) + (allocate-instance class))) + ;;;; Retrieving Information about a Presentation Type or P.T. Abbreviation @@ -769,7 +775,10 @@ 'define-presentation-type (typecase superclass (funcallable-standard-class 'defgeneric) - (standard-class 'defclass) + (standard-class + 'defclass) + #+Allegro + (clos::structure-class 'defstruct) #+Symbolics ;Symbolics CLOS, that is (clos:structure-class 'defstruct) #+CCL-2 (structure-class 'defstruct)) diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp index 2f29c7debcad1d8e7bcb81ec0c6beadf0238507e..471fc561a2f37f27304a7856f90b13a67e26ac50 100644 --- a/clim/recording-protocol.lisp +++ b/clim/recording-protocol.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: recording-protocol.lisp,v 1.6 92/01/31 16:22:15 cer Exp $ +;; $fiHeader: recording-protocol.lisp,v 1.1 92/02/24 13:18:28 cer Exp Locker: cer $ (in-package :clim-internals) @@ -1279,16 +1279,17 @@ #+Silica (defmethod repaint-sheet :after ((stream output-recording-mixin) region) ;;--- Who should establish the clipping region? + ;;--- Is it here or in the handle-repaint method ;; Who should clear the region? (with-sheet-medium (medium stream) (multiple-value-call #'draw-rectangle* - medium - (bounding-rectangle* (region-intersection - region - (or (pane-viewport-region stream) - (bounding-rectangle stream)))) - :ink +background-ink+)) - (stream-replay stream region)) + medium + (bounding-rectangle* (region-intersection + region + (or (pane-viewport-region stream) + (bounding-rectangle stream)))) + :ink +background-ink+) + (stream-replay stream region))) diff --git a/demo/listener.lisp b/demo/listener.lisp index 5f3270ffe237580d6fcec461959e2e47bedb1eaf..53e2de27e4351489baba73779afab393dceed3fb 100644 --- a/demo/listener.lisp +++ b/demo/listener.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: listener.lisp,v 1.2 92/02/24 13:09:25 cer Exp Locker: cer $ +;; $fiHeader: listener.lisp,v 1.3 92/02/26 10:23:55 cer Exp Locker: cer $ (in-package :clim-demo) @@ -36,6 +36,24 @@ (defvar *listener-depth* -1) +#+Allegro +(progn + (defvar *tpl-current-stack-group* nil + ;; The stack-group object corresponding to the stack we are debugging. + ) + + (defvar *top-top-frame-pointer* nil + ;; The newest (possibly invisible) frame at the current break level. + ) + + (defvar *top-frame-pointer* nil + ;; The newest (possibly invisible) frame at the current break level. + ) + + (defvar *current-frame-pointer* nil + ;; Current stack frame pointer. + )) + (defun lisp-listener-top-level (frame) "Run a simple Lisp listener using the window provided." #+Silica (enable-frame frame) @@ -46,7 +64,7 @@ (terpri window) (let* ((*standard-input* window) (*standard-output* window) - #+Minima (*error-output* window) + #+(or Allegro Minima) (*error-output* window) (*query-io* window) #+Minima (*debug-io* window) (*package* *package*) @@ -54,7 +72,19 @@ (*** nil) (** nil) (* nil) (/// nil) (// nil) (/ nil) (+++ nil) (++ nil) (+ nil) - (- nil)) + (- nil) + #+Allegro + (*tpl-current-stack-group* sys::*current-stack-group*) + #+Allegro + (*top-top-frame-pointer* + (debug::newest-frame si::*current-stack-group* :visible-only-p nil)) + #+Allegro + (*top-frame-pointer* + (or (db::find-interesting-frame *top-top-frame-pointer*) + *top-top-frame-pointer*)) + #+Allegro + (*current-frame-pointer* *top-frame-pointer*) + ) (with-command-table-keystrokes (keystrokes command-table) (condition-restart-loop (#+Genera (sys:error sys:abort) #-Genera (error) @@ -129,13 +159,19 @@ (shiftf /// // / values) (shiftf *** ** * (first values))))))))) +(defvar *debugger-condition* nil) +(defvar *debugger-restarts* nil) + (defun listener-debugger-hook (condition hook) (declare (ignore hook)) (let ((*debug-io* (frame-query-io *application-frame*)) - (*error-output* (frame-query-io *application-frame*))) - (describe-error condition *error-output*) + (*error-output* (frame-query-io *application-frame*)) + (*debugger-condition* condition) + (*debugger-restarts* (compute-restarts))) + (describe-error *error-output*) (lisp-listener-top-level *application-frame*))) + (define-presentation-type restart-name ()) (define-presentation-method presentation-typep (object (type restart-name)) @@ -145,6 +181,7 @@ &key) (prin1 (restart-name object) stream)) +#+nomore (define-presentation-translator invoke-restart (restart-name form lisp-listener :documentation ((object stream) @@ -154,38 +191,53 @@ (object) `(invoke-restart ',object)) -(defun describe-error (condition stream) - (with-output-as-presentation (stream condition 'form +(define-presentation-to-command-translator + invoke-restart + (restart com-invoke-restart lisp-listener) + (object) + (list object)) + +(define-lisp-listener-command (com-invoke-restart :name t) + ((restart 'restart)) + (invoke-restart restart)) + +(define-lisp-listener-command (com-describe-error :name t) + () + (describe-error *error-output*)) + +(defun describe-error (stream) + (when *debugger-condition* + (with-output-as-presentation (stream *debugger-condition* 'form :single-box t) - (format stream "~2&Error: ~A" condition)) + (format stream "~2&Error: ~A" *debugger-condition*)) + (let ((restarts *debugger-restarts*)) + (when restarts + (let ((actions '(invoke-restart))) + (dolist (restart (reverse restarts)) + (let ((action (member (restart-name restart) + '(abort continue muffle-warning store-value use-value)))) + (when action + (pushnew (first action) actions)))) + (format stream "~&Use~?to resume~:[~; or abort~] execution:" + "~#[~; ~S~; ~S or ~S~:;~@{~#[~; or~] ~S~^,~}~] " + actions (member 'abort actions))) + (fresh-line stream) + (let ((i 0)) + (formatting-table (stream :x-spacing '(2 :character)) + (dolist (restart restarts) + (with-output-as-presentation (stream restart 'restart + :single-box t) + (formatting-row (stream) + (formatting-cell (stream) + (format stream "~D" i)) + (formatting-cell (stream) + (format stream "~S" (restart-name restart))) + (formatting-cell (stream) + (format stream "~A" restart)))) + (incf i))))))) (let ((process (clim-sys:current-process))) (when process (format stream "~&In process ~A." process))) - (let ((restarts (compute-restarts condition))) - (when restarts - (let ((actions '(invoke-restart))) - (dolist (restart (reverse restarts)) - (let ((action (member (restart-name restart) - '(abort continue muffle-warning store-value use-value)))) - (when action - (pushnew (first action) actions)))) - (format stream "~&Use~?to resume~:[~; or abort~] execution:" - "~#[~; ~S~; ~S or ~S~:;~@{~#[~; or~] ~S~^,~}~] " - actions (member 'abort actions))) - (fresh-line stream) - (let ((i 0)) - (formatting-table (stream :x-spacing '(2 :character)) - (dolist (restart restarts) - (with-output-as-presentation (stream restart 'restart-name - :single-box t) - (formatting-row (stream) - (formatting-cell (stream) - (format stream "~D" i)) - (formatting-cell (stream) - (format stream "~S" (restart-name restart))) - (formatting-cell (stream) - (format stream "~A" restart)))) - (incf i)))))) (force-output stream)) diff --git a/notes/clim.todo b/notes/clim.todo index 4919de37e906c2f4f50353f0e705549eb173253d..ebc74c5e9d636f1ff109461c33e5fd937fcb71ee 100644 --- a/notes/clim.todo +++ b/notes/clim.todo @@ -1,4 +1,4 @@ -%% $fiHeader: clim.todo,v 1.1 92/02/10 17:51:12 cer Exp Locker: cer $ +%% $fiHeader: clim.todo,v 1.3 92/02/14 18:57:52 cer Exp Locker: cer $ %%%%%%%%%%%%%%%%%%%%%%%%% CLIM 2.0 plan % Silica back-ends @@ -10,137 +10,135 @@ * Postscript % Holes to fill in - * Rename DEFSYS package to CLIM-DEFSYS. - * Reinstate clipping regions. - * Complete abstract gadgets. + * [cer] input-protocol and the handle-event problem + * [cer] Why does INPUT-PROTOCOL-MIXIN define an input buffer? What's wrong with the + sheet event queue? + * [cer] Define cursor protocol + * [cer] Rename DEFSYS package to CLIM-DEFSYS. + * [swm] Complete abstract gadgets. - Take whatever is needed from ILA CLIM in order to get the non-adaptive gadgets together. - * Write a "null" frame manager that implements the same look and feel for all + * [swm] Write a "null" frame manager that implements the same look and feel for all ports. - Genera's frame manager will inherit from this. - * Take the keyboard gesture stuff code from ILA CLIM, but make it more + * [swm] Take the keyboard gesture stuff code from ILA CLIM, but make it more cons-efficient. - * Reinstate CLIM 0.9's :MENU-GROUP, but call it :MENU-BAR. - - NIL means no menu bar. - - T means use the current command table. - - A symbol names the command table to use. - * Stream defprotocols: be sure that all of the sheet and medium protocol + * [swm] Stream defprotocols: be sure that all of the sheet and medium protocol functions are explicitly defined with DEFOPERATION so that the stream trampolines are properly created. - * Layout for gadgets within ACCEPTING-VALUES. - * ACCEPTING-VALUES :OWN-WINDOW architecture that allows integration with + * [all] Layout for gadgets within ACCEPTING-VALUES. + * [all] ACCEPTING-VALUES :OWN-WINDOW architecture that allows integration with toolkit dialogs. - - For example, :OWN-WINDOW T dialogs should use a separate pane to hold the - Exit and Abort buttons. - * Implement clean interface to THROW-HIGHLIGHTED-PRESENTATION. + * [all] Implement clean interface to THROW-HIGHLIGHTED-PRESENTATION. - SWM claims that it is already clean. Why do SWM and CER disagree? - * Interprocess communication, i.e., one process to another to execute a frame + * [all] Interprocess communication, i.e., one process to another to execute a frame command. * Temporary-medium sheets. - - Medium accessors on a sheet with no medium? - - Temporary medium need to have their state decached. + - [swm] Medium accessors on a sheet with no medium? + - [all] Temporary medium need to have their state decached. This looks + like it should be a method on deallocate-medium since the medium + is not degrafted. Just not associated with a window. This does + not seem nice: engraft,degraft, deallocate? * Sheet protocol. - - Where do event queues come from? - - Repaint protocol: who clears the area and sets the clipping region when + - [all] Where do event queues come from? + - [all] Repaint protocol: who clears the area and sets the clipping region when doing the repaint? - - How do we deal with the case where a sheet has one children and its + - [cer] How do we deal with the case where a sheet has one children and its mirror allows one children only but the sheet actually has two children, e.g., (FRAME (HORIZONTALLY () () ())). - - What is the precise value returned by EVENT-SHEET? Does the EVENT-SHEET - accessor return the sheet that the event was dispatched to? - * Why does INPUT-PROTOCOL-MIXIN define an input buffer? What's wrong with the - sheet event queue? - * Multiple layouts need to allow different size reqs for the sheets. - * The code for switching layouts needs to be cleaned up. - * Implement :COMPUTE size spec, that is, panes that get their size from the - size of the output in the pane. - * Implement compatibility code for CLIM 1.0's :LAYOUT language. - * Protocol to compute to the WM the desired geometry of the frame. - * When the viewport is resized in might need to be moved, for example, if it + - [all] What is the precise value returned by EVENT-SHEET? Does the EVENT-SHEET + accessor return the sheet that the event was dispatched to? We + had to do this for correct distribution of keyboard events. + * [cer] Multiple layouts need to allow different size reqs for the sheets. + * [cer] The code for switching layouts needs to be cleaned up. + * [swm] Implement compatibility code for CLIM 1.0's :LAYOUT language. + * [cer] Protocol to compute to the WM the desired geometry of the frame. + * [cer] When the viewport is resized in might need to be moved, for example, if it becomes big enough to display the entire window: in the ALLOCATE-SPACE for viewport. - * Pointer documentation panes and other pane types, - * Gadget enable/disable protocol. + * [cer] Pointer documentation panes and other pane types, + * [cer] Gadget enable/disable protocol. * Event protocol: - Consider design of DISTRIBUTE-EVENT. - - Timestamp. - - Native region. - * On-demand scrollbars. - * Should we do "stream relative" coordinates (as opposed to the current + - [all] Timestamp. + - [all] Native region. + * [cer] On-demand scrollbars. + * [all] Should we do "stream relative" coordinates (as opposed to the current "parent relative" scheme) for output records? It solves some problems, but introduces others. - * Should we divide the drawing protocol into a medium and a port layer, or + * [swm] Should we divide the drawing protocol into a medium and a port layer, or should it be a single layer as Bill suggests? - * Spiff up the code for defining new graphics operators. + * [swm] Spiff up the code for defining new graphics operators. - DEFINE-GRAPHICS-OPERATOR is like DEFGENERIC. - DEFINE-GRAPHICS-METHOD is like DEFMETHOD. - DEFINE-GRAPHICS-RECORDING. - What of this goes into the spec? - * Figure out what things are part of the frame manager protocol and which are + * [swm] Figure out what things are part of the frame manager protocol and which are part of the port protocol. - PORT-MENU-CHOOSE should really be FRAME-MANAGER-MENU-CHOOSE. - Ditto, PORT-DIALOG-VIEW. - * Figure out how views really interact with frame managers and dialogs. + * [swm] Figure out how views really interact with frame managers and dialogs. - Indirect views. - * Implement more of DRAW-DESIGN for composites. + * [swm] Implement more of DRAW-DESIGN for composites. - Create a table that describes what works and what doesn't, for each port. - * Figure out which WINDOW-xxx functions from CLIM 1.0 make sense. It's OK to + * [swm] Figure out which WINDOW-xxx functions from CLIM 1.0 make sense. It's OK to change the names to correspond to newthink. - WINDOW-VIEWPORT - WINDOW-VIEWPORT-POSITION* and WINDOW-SET-VIEWPORT-POSITION*. - WINDOW-INSIDE-xxx and WINDOW-SET-INSIDE-xxx. + * [jdi] Design and implement a colormap scheme % Cleanups - * What should we retain from previous versions of CLIM? + * [swm] What should we retain from previous versions of CLIM? - Go through CLIM 1.0 to make sure we didn't miss anything. - Go through ILA CLIM with a fine-tooth comb. - * Flush all of the DRAW-xxx-INTERNAL junk. - * Find all the #+Silica/#-Silica stuff. + * [swm] Flush all of the DRAW-xxx-INTERNAL junk. + * [swm ] Find all the #+Silica/#-Silica stuff. - Make sure that the #+Silica branch really does the right thing. - Flush the #-Silica branch. - * Must we really convert all of the code to lowercase? Do it if we must. - * Sort out the whole server path mechanism and make sure we can + * [swm] Must we really convert all of the code to lowercase? Do it if we must. + * [cer] Sort out the whole server path mechanism and make sure we can windows where we want. % Bugs to fix - * What's the problem with radio-boxes and move-cursor-after. The alternative + * [cer] What's the problem with radio-boxes and move-cursor-after. The alternative definitions almost work except for exit-buttons. I think the bounding rectangle of gadget output records is computed incorrectly and that it works because the update-gadget-position is broken to match. - * No output-recording for draw-text*. Hence the compass menu is + * [swm] No output-recording for draw-text*. Hence the compass menu is broken. - * why? #<standard-method stream-read-char-no-hang (motif-top-level-sheet) @ #x1b18eee> - * When default-text-margin slot yet bound. Drawing on a unexposed window + * [cer] why? #<standard-method stream-read-char-no-hang (motif-top-level-sheet) @ #x1b18eee> + * [cer] When default-text-margin slot yet bound. Drawing on a unexposed window can cause problems. % Performance - * Meet CLIM 1.0 performance goals. - * Surpass CLIM 1.0 performance goals. - * Simplify transformation classes so that there is a single class of + * [all] Meet CLIM 1.0 performance goals. + * [all] Surpass CLIM 1.0 performance goals. + * [swm] Simplify transformation classes so that there is a single class of transformation. Special-case +IDENTITY-TRANSFORMATION+. - * Make use of volatile transformations. + * [swm] Make use of volatile transformations. - Be careful never to modify +IDENTITY-TRANSFORMATION+. - * Make use of volatile rectangular regions. - * Reinstate sheet region and transformation caches (as in ILA CLIM). + * [swm] Make use of volatile rectangular regions. + * [swm] Reinstate sheet region and transformation caches (as in ILA CLIM). * Add port-level caches for inks. - * (deftype coordinate () ...) + * [swm] (deftype coordinate () ...) - Flush all inappropriate FIXNUM declarations from the code and replace them with the new COORDINATE declaration. - Look at callers of FLOOR, CEILING, TRUNCATE, and ROUND, and decide what of those really mean to coerce to the COORDINATE type. - The per-port code will needs to "devicize" all coordinates. For example, for CLX that means integerizing, but not for PostScript. - * Reinstate graphics function optimizers. + * [swm] Reinstate graphics function optimizers. - Is any of the CLIM 1.0 graphics-defining stuff useful? - Is any of the ILA CLIM graphics-defining stuff useful? % Size issues - * Modularize with load on demand/required modules + * [swm] Modularize with load on demand/required modules - Extended geometry (lines, ellipses, polygons). - DRAW-DESIGN and MAKE-DESIGN-FROM-OUTPUT-RECORD. - Some formatted output stuff: graph formatting, FILLING-OUTPUT. -% Specification +% [swm] Specification * Write up the Silica API and protocol. * Write up the gadget API and protocol. - Document new callback function architecture. diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index 655e164a7505f1a26c2e5963f58b1cce20373c6d..026fcbd66f633b05e58ea6f201ca546305557da1 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -20,7 +20,7 @@ U;; -*- mode: common-lisp; package: xm-silica -*- ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-graphics.lisp,v 1.8 92/02/24 13:06:27 cer Exp Locker: cer $ +;; $fiHeader: xt-graphics.lisp,v 1.9 92/02/26 10:23:26 cer Exp Locker: cer $ (in-package :xm-silica) diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp index 181d74b9b534c774a4bf559c7c87d2939196ca80..fea0c40751d5dace8d9f6eaa7680bdbccb2c7c4a 100644 --- a/tk/load-xm.lisp +++ b/tk/load-xm.lisp @@ -20,36 +20,43 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: load-xm.lisp,v 1.5 92/02/16 20:55:01 cer Exp $ +;; $fiHeader: load-xm.lisp,v 1.6 92/02/24 13:03:10 cer Exp Locker: cer $ (in-package :tk) -#| -make ucl_xtras='/usr/tech/cer/stuff/clim-2.0/xm-classes.o /usr/motif/usr/lib/libXm.a /usr/motif/usr/lib/libXt.a /usr/motif/usr/lib/libX11.a' ucl -|# +(defmacro symbols-from-file (file) + (with-open-file (s file :direction :input) + (do ((r nil) + (l (read-line s nil nil) (read-line s nil nil))) + ((null l) + `(quote ,r)) + (push l r)))) - -(defun load-from-xm (&optional (what *motif-classes*)) - (setq what (remove-if #'ff::get-entry-point - `( - "_XCopyGC" - ,@what - ))) +(defun load-undefined-symbols-from-library (what kludges libraries) + (setq what (remove-if #'ff::get-entry-point what)) (when what - #+ignore - (mapc #'foreign-functions:remove-entry-point - '("__unpack_quadruple" - "__prod_b10000" - "__carry_out_b10000" - "__prod_65536_b10000")) + (mapc #'foreign-functions:remove-entry-point kludges) (load "" :unreferenced-lib-names what - :foreign-files - '("/usr/motif/usr/lib/libXm.a" - "/usr/motif/usr/lib/libXt.a" - "/usr/motif/usr/lib/libX11.a") + :foreign-files libraries :print t))) +;;;; +(defvar *libxm-pathname* "/usr/motif/usr/lib/libXm.a") +(defvar *libxt-pathname* "/usr/motif/usr/lib/libXt.a") +(defvar *libx11-pathname* "/usr/motif/usr/lib/libX11.a") + +(defun load-from-xm () + (load-undefined-symbols-from-library + (list* "_XCopyGC" (symbols-from-file "misc/undefinedsymbols.motif")) + '("__unpack_quadruple" + "__prod_b10000" + "__carry_out_b10000" + "__prod_65536_b10000") + (list *libxm-pathname* + *libxt-pathname* + *libx11-pathname*))) + (load-from-xm)