From e436c422b88ee12156a585bbcf270554706eb61c Mon Sep 17 00:00:00 2001 From: cer <cer> Date: Sun, 4 Oct 1992 14:16:52 +0000 Subject: [PATCH] fixes --- Makefile | 19 +++-- clim/frames.lisp | 5 +- demo/address-book.lisp | 5 +- demo/color-editor.lisp | 32 ++++++-- demo/demo-activity.lisp | 9 ++- demo/ico.lisp | 146 ++++++++++++++++++++++++------------- demo/puzzle.lisp | 3 +- silica/classes.lisp | 4 +- silica/framem.lisp | 2 +- silica/medium.lisp | 31 +++++++- test/test-suite.lisp | 23 +----- test/test.lisp | 4 +- tk-silica/ol-gadgets.lisp | 13 +++- tk-silica/xt-graphics.lisp | 98 ++++++++++++------------- tk-silica/xt-silica.lisp | 7 +- tk/resources.lisp | 6 +- utils/base-designs.lisp | 15 +--- utils/designs.lisp | 123 ++++++++++--------------------- utils/packages.lisp | 75 +++++++++---------- 19 files changed, 333 insertions(+), 287 deletions(-) diff --git a/Makefile b/Makefile index a384f71c..97e58006 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $fiHeader: Makefile,v 1.50 92/10/01 08:25:05 cer Exp Locker: cer $ +# $fiHeader: Makefile,v 1.51 92/10/02 15:20:51 cer Exp Locker: cer $ # # Makefile for CLIM 2.0 # @@ -104,13 +104,22 @@ OL_UNDEFS=misc/undefinedsymbols.olit CLIMFASLS= climg.fasl climol.fasl climxm.fasl clim-debug.fasl clim-debugol.fasl \ clim-debugxm.fasl climps.fasl climgg.fasl # clim1compat.fasl -CLIMOBJS= clim-motif_d.o clim-olit_d.o clim-motif.o clim-olit.o stub-xt.o stub-x.o \ +PUBLIC_OBJS= stub-xt.o stub-x.o \ xlibsupport.o MyDrawingA.o \ olsupport.o xtsupport.o +OL_LICENSED_OBJS=clim-olit.o clim-olit_d.o +XM_LICENSED_OBJS=clim-motif_d.o clim-motif.o + +CLIMOBJS=$(PUBLIC_OBJS) $(XM_LICENSED_OBJS) $(OL_LICENSED_OBJS) + +INSTALLED_CLIMOBJS=$(PUBLIC_OBJS) $(XM_LICENSED_OBJS) $(OL_LICENSED_OBJS) + + # These are linked into the distribution -FCLIMOBJS= `pwd`/clim-motif_d.o `pwd`/clim-olit_d.o \ - `pwd`/clim-motif.o `pwd`/clim-olit.o \ +# `pwd`/clim-olit_d.o \ `pwd`/clim-olit.o \ + +FCLIMOBJS= `pwd`/clim-motif_d.o `pwd`/clim-motif.o \ `pwd`/stub-xt.o `pwd`/stub-x.o \ `pwd`/xlibsupport.o `pwd`/MyDrawingA.o `pwd`/olsupport.o `pwd`/xtsupport.o @@ -705,7 +714,7 @@ makeclimolfasls : compile-ol cat-ol install_clim : - cp $(CLIMOBJS) $(CLIMFASLS) $(DEST) + cp $(INSTALLED_CLIMOBJS) $(CLIMFASLS) $(DEST) # Link in the libraries & distribution object files with standard names diff --git a/clim/frames.lisp b/clim/frames.lisp index f0a30dc8..0a8df2f1 100644 --- a/clim/frames.lisp +++ b/clim/frames.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: frames.lisp,v 1.44 92/09/30 18:03:45 cer Exp Locker: cer $ +;; $fiHeader: frames.lisp,v 1.45 92/10/02 15:19:25 cer Exp Locker: cer $ (in-package :clim-internals) @@ -67,6 +67,9 @@ (defmethod graft ((frame standard-application-frame)) (graft (frame-manager frame))) +(defmethod frame-palette ((frame standard-application-frame)) + (frame-manager-palette (frame-manager frame))) + ;;--- These should really be somewhere else (defmethod frame-manager ((stream standard-encapsulating-stream)) (frame-manager (encapsulating-stream-stream stream))) diff --git a/demo/address-book.lisp b/demo/address-book.lisp index 88a71404..9a998117 100644 --- a/demo/address-book.lisp +++ b/demo/address-book.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: address-book.lisp,v 1.13 92/09/24 09:40:02 cer Exp Locker: cer $ +;; $fiHeader: address-book.lisp,v 1.14 92/09/30 18:04:06 cer Exp Locker: cer $ (in-package :clim-demo) @@ -44,6 +44,9 @@ (add-address (make-address :name "John Irwin" :address "Franz, Inc." :number "510-548-3600")) + (add-address (make-address :name "Colin Meldrum" + :address "Franz, Inc." + :number "510-548-3600")) (add-address (make-address :name "Scott McKay" :address "Symbolics, Inc." :number "617-221-1000")) diff --git a/demo/color-editor.lisp b/demo/color-editor.lisp index fc909bce..f9d356d3 100644 --- a/demo/color-editor.lisp +++ b/demo/color-editor.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: color-editor.lisp,v 1.4 92/10/02 09:22:38 cer Exp $ +;; $fiHeader: color-editor.lisp,v 1.5 92/10/02 15:20:34 cer Exp Locker: cer $ (in-package :clim-demo) @@ -14,7 +14,7 @@ (display-color (pane-frame stream) stream)) (define-application-frame color-chooser () - ((color :accessor color :initform (make-rgb-color 0 0 0)) + (color mutable-p red blue green intensity hue saturation) (:menu-bar nil) @@ -78,11 +78,30 @@ (vertically () display exit)) rgb ihs)))) +(defmethod run-frame-top-level :before ((frame color-chooser) &key) + (with-slots (mutable-p color) frame + (setf color + (if (setf mutable-p (palette-color-p (frame-palette frame))) + (make-mutable-color :color +black+) + +black+)))) + +(defmethod color ((frame color-chooser)) + (with-slots (mutable-p color) frame + (if mutable-p + (mutable-color-color color) + color))) + +(defmethod (setf color) (new-color (frame color-chooser)) + (with-slots (mutable-p color) frame + (if mutable-p + (mutate-color color new-color) + (setf color new-color)))) + (defmethod display-color ((frame color-chooser) stream) (with-bounding-rectangle* (left top right bottom) (window-viewport stream) (with-output-recording-options (stream :record nil) (draw-rectangle* stream left top right bottom - :filled t :ink (color frame))))) + :filled t :ink (slot-value frame 'color))))) (defmacro define-rgb-callbacks (color) (check-type color (member red green blue)) @@ -148,7 +167,10 @@ (defmethod value-changed-callback :after ((slider slider) (client (eql 'color)) id value) (declare (ignore id value)) - (redisplay-frame-pane (pane-frame slider) 'display)) + (let ((frame (pane-frame slider))) + (with-slots (mutable-p) frame + (unless mutable-p + (redisplay-frame-pane (pane-frame slider) 'display))))) (defvar *color-choosers* nil) @@ -166,7 +188,7 @@ (push (cons port frame) *color-choosers*)) frame))) (run-frame-top-level frame) - (color frame))) + (slot-value frame 'color))) (define-demo "Color Chooser" do-color-chooser) diff --git a/demo/demo-activity.lisp b/demo/demo-activity.lisp index 09f2f078..070ddee2 100644 --- a/demo/demo-activity.lisp +++ b/demo/demo-activity.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: demo-activity.lisp,v 1.1 92/09/22 19:43:05 cer Exp $ +;; $fiHeader: demo-activity.lisp,v 1.2 92/10/02 15:20:36 cer Exp Locker: cer $ (in-package :clim-demo) @@ -47,7 +47,12 @@ (incf *untitled-count*)) (define-demo-app-command (com-select-frame :name t :menu t) - ((frame `((member ,@(frame-manager-frames *activity*)) :name-key ,#'frame-pretty-name))) + ((frame `((member ,@(frame-manager-frames *activity*)) + ;;-- After a frame is deleted it ends not being a member + ;;-- of the presentation type so you get bogus + ;;-- presentations and the find in the present method + ;;-- returns nil + :name-key ,#'(lambda (x) (and x (frame-pretty-name x)))))) (select-activity-active-frame *activity* frame)) (define-demo-app-command (com-funky-add :name t :menu t) diff --git a/demo/ico.lisp b/demo/ico.lisp index f99535a3..ca3ec3c5 100644 --- a/demo/ico.lisp +++ b/demo/ico.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: ico.lisp,v 1.7 92/09/30 18:04:15 cer Exp Locker: cer $ +;; $fiHeader: ico.lisp,v 1.8 92/10/02 15:20:37 cer Exp Locker: cer $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. @@ -19,14 +19,24 @@ ;;; ;;; ICO Frames ;;; +(defparameter *background-color* +black+) +(defparameter *line-color* +white+) +(defparameter *face1-color* +red+) +(defparameter *face2-color* +green+) (define-application-frame ico-frame () ((ico-time-p :initform t) + (ico-buffers :initform 1) + (ico-color-group2 :initform nil) + (ico-color-group3 :initform nil) + (inks0 :initform (vector *background-color*)) + (inks1 :initform (vector *line-color*)) + (inks2 :initform (vector *face1-color*)) + (inks3 :initform (vector *face2-color*)) (ico-line-style :initform :thin) (draw-edges :initform t) (draw-faces :initform nil) - (ico-process :initform nil :accessor ico-process) - (ico-color-group :initform nil :accessor ico-color-group)) + (ico-process :initform nil :accessor ico-process)) (:command-table (ico-frame :inherit-from (accept-values-pane))) (:panes (target :application :width 400 :height 400) @@ -41,24 +51,70 @@ (defmethod display-options-pane ((frame ico-frame) pane &key max-width max-height) (declare (ignore max-width max-height)) - (with-slots (ico-time-p ico-line-style draw-edges draw-faces) frame - (formatting-item-list (pane :n-rows 1) - (formatting-cell (pane) - (setf ico-time-p (accept 'boolean - :default ico-time-p - :stream pane - :prompt "Time"))) - (formatting-cell (pane) - (let ((x (append (and draw-faces '(:faces)) - (and draw-edges '(:edges))))) - (setf x (accept '(subset :faces :edges) :default x :stream pane :prompt "Choose")) - (setf draw-edges (and (member :edges x) t) - draw-faces (and (member :faces x) t)))) - (formatting-cell (pane) - (setf ico-line-style (accept '(member :thin :thick) - :default ico-line-style + (formatting-item-list (pane :n-rows 1) + (with-slots (ico-time-p ico-buffers ico-line-style draw-edges draw-faces) frame + (formatting-cell (pane) + (setf ico-time-p (accept 'boolean + :default ico-time-p :stream pane - :prompt "Line Style")))))) + :prompt "Time"))) + (formatting-cell (pane) + (let ((x (append (and draw-faces '(:faces)) + (and draw-edges '(:edges))))) + (setf x (accept '(subset :faces :edges) :default x :stream pane :prompt "Choose")) + (setf draw-edges (and (member :edges x) t) + draw-faces (and (member :faces x) t)))) + (formatting-cell (pane) + (setf ico-line-style (accept '(member :thin :thick) + :default ico-line-style + :stream pane + :prompt "Line Style"))) + (formatting-cell (pane) + (multiple-value-bind (buffering ptype changed) + (accept '(member :single :double :triple) + :default (svref #(:single :double :triple) (1- ico-buffers)) + :stream pane + :prompt "Buffering") + (declare (ignore ptype)) + (when changed + (with-slots (ico-color-group2 ico-color-group3 + inks0 inks1 inks2 inks3) frame + (case buffering + (:single + (setf ico-buffers 1 + inks0 (vector *background-color*) + inks1 (vector *line-color*) + inks2 (vector *face1-color*) + inks3 (vector *face2-color*))) + (:double + (let ((g (or ico-color-group2 + (setf ico-color-group2 (make-color-group 4 4))))) + (setf ico-buffers 2 + inks0 (vector (group-color g 0 nil) + (group-color g nil 0)) + inks1 (vector (group-color g 1 nil) + (group-color g nil 1)) + inks2 (vector (group-color g 2 nil) + (group-color g nil 2)) + inks3 (vector (group-color g 3 nil) + (group-color g nil 3))))) + (:triple + (let ((g (or ico-color-group3 + (setf ico-color-group3 (make-color-group 4 4 4))))) + (setf ico-buffers 3 + inks0 (vector (group-color g 0 nil nil) + (group-color g nil 0 nil) + (group-color g nil nil 0)) + inks1 (vector (group-color g 1 nil nil) + (group-color g nil 1 nil) + (group-color g nil nil 1)) + inks2 (vector (group-color g 2 nil nil) + (group-color g nil 2 nil) + (group-color g nil nil 2)) + inks3 (vector (group-color g 3 nil nil) + (group-color g nil 3 nil) + (group-color g nil nil 3))))))))))))) + (define-ico-frame-command (com-ico-throw-ball :menu "Throw ball" :keystroke #\t) () (with-application-frame (frame) @@ -77,8 +133,6 @@ (catch-ball frame)) (defmethod throw-ball ((frame ico-frame)) - (unless (ico-color-group frame) - (setf (ico-color-group frame) (make-color-group 4 4))) (unless (ico-process frame) (setf (ico-process frame) (clim-sys:make-process #'(lambda () @@ -123,15 +177,6 @@ (defun run-ico (frame &optional (count 1000000)) (let* ((pane (frame-target frame)) (medium (sheet-medium pane)) - (group (ico-color-group frame)) - (i0 (vector (group-color group 0 nil) (group-color group nil 0))) - (i1 (vector (group-color group 1 nil) (group-color group nil 1))) - (i2 (vector (group-color group 2 nil) (group-color group nil 2))) - (i3 (vector (group-color group 3 nil) (group-color group nil 3))) - (background-color +black+) - (line-color +white+) - (face1-color +red+) - (face2-color +green+) (win-w (bounding-rectangle-width pane)) (win-h (bounding-rectangle-height pane)) (ico-x (floor (* (- win-w ico-w) 128) 256)) @@ -148,8 +193,8 @@ (declare (integer win-w win-h) (integer ico-x ico-y ico-dx ico-dy xtop ytop prev-x prev-y) (special prev-x prev-y)) - - (with-slots (draw-faces draw-edges) frame + (with-slots (draw-faces draw-edges ico-buffers inks0 inks1 inks2 inks3) + frame (ecase *ico-mode* #+abc (:abc (clear-region medium +everywhere+)) @@ -167,25 +212,23 @@ #+genera (:genera (setq drawable (medium-drawable medium)))) - (window-clear pane) - (draw-rectangle* medium 0 0 win-w win-h :ink (group-color group 0 0)) (dotimes (i count) - (let* ((buffer (mod i 2))) + (let* ((ico-buffers ico-buffers) + (inks0 inks0) + (inks1 inks1) + (inks2 inks2) + (inks3 inks3) + (buffer (mod i ico-buffers))) (multiple-value-setq (edges face-list) (calculate-ico ico-x ico-y draw-edges draw-faces edges face-list)) - ;; Draw ICO (ecase *ico-mode* #+clim (:clim - - (draw-rectangle* medium 0 0 win-w win-h :ink (svref i0 - buffer) :filled t) - - + (draw-rectangle* medium 0 0 win-w win-h :ink (svref inks0 buffer) :filled t) (when draw-edges - (draw-lines* medium edges :ink (svref i1 buffer) + (draw-lines* medium edges :ink (svref inks1 buffer) :line-thickness (ecase (slot-value frame 'ico-line-style) (:thick 5) @@ -197,15 +240,16 @@ :closed t :filled t :ink (if (oddp (car f)) - (svref i2 buffer) - (svref i3 buffer))))) - (with-delayed-mutations - (mutate-color (svref i0 buffer) background-color) - (mutate-color (svref i1 buffer) line-color) - (mutate-color (svref i2 buffer) face1-color) - (mutate-color (svref i3 buffer) face2-color)) - #+ignore + (svref inks2 buffer) + (svref inks3 buffer))))) + (when (> ico-buffers 1) + (with-delayed-mutations + (mutate-color (svref inks0 buffer) *background-color*) + (mutate-color (svref inks1 buffer) *line-color*) + (mutate-color (svref inks2 buffer) *face1-color*) + (mutate-color (svref inks3 buffer) *face2-color*))) (silica:medium-force-output medium)) + #+xlib-ignore (:clx (setf (xlib:gcontext-foreground gcontext) white) diff --git a/demo/puzzle.lisp b/demo/puzzle.lisp index 23a6ddce..3f572156 100644 --- a/demo/puzzle.lisp +++ b/demo/puzzle.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: puzzle.lisp,v 1.16 92/09/24 09:40:14 cer Exp $ +;; $fiHeader: puzzle.lisp,v 1.17 92/10/02 15:20:47 cer Exp Locker: cer $ (in-package :clim-demo) @@ -83,7 +83,6 @@ (cell-id (encode-puzzle-cell row column))) (updating-output (stream :unique-id cell-id - :cache-text #'equal :cache-value value) (formatting-cell (stream :align-x :right) (unless (zerop value) diff --git a/silica/classes.lisp b/silica/classes.lisp index 1a3ef297..a018e760 100644 --- a/silica/classes.lisp +++ b/silica/classes.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: classes.lisp,v 1.20 92/09/30 18:03:12 cer Exp Locker: cer $ +;; $fiHeader: classes.lisp,v 1.21 92/10/02 15:18:05 cer Exp Locker: cer $ (in-package :silica) @@ -113,6 +113,8 @@ (defclass basic-palette (palette) ((port :reader palette-port :initarg :port) + (color-p :reader palette-color-p :initarg :color-p) + (mutable-p :reader palette-mutable-p :initarg :mutable-p) (color-cache :initform (make-hash-table) :reader palette-color-cache) (mutable-color-cache :initform (make-hash-table) :reader palette-mutable-color-cache) diff --git a/silica/framem.lisp b/silica/framem.lisp index e980499e..f4eed741 100644 --- a/silica/framem.lisp +++ b/silica/framem.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: framem.lisp,v 1.18 92/09/30 18:03:14 cer Exp Locker: cer $ +;; $fiHeader: framem.lisp,v 1.19 92/10/02 15:18:20 cer Exp Locker: cer $ (in-package :silica) diff --git a/silica/medium.lisp b/silica/medium.lisp index 463e86a8..26f2bfb3 100644 --- a/silica/medium.lisp +++ b/silica/medium.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: medium.lisp,v 1.23 92/09/24 09:37:46 cer Exp $ +;; $fiHeader: medium.lisp,v 1.24 92/10/02 15:18:28 cer Exp Locker: cer $ (in-package :silica) @@ -424,3 +424,32 @@ (generate-trampolines medium-protocol medium standard-sheet-output-mixin `(sheet-medium ,standard-sheet-output-mixin)) +;;; not clear that these should be here. + +(defmethod sheet-palette ((sheet sheet)) + (let* ((frame (pane-frame sheet)) + (framem (and frame (frame-manager frame)))) + (if framem + (frame-manager-palette framem) + (port-default-palette (port sheet))))) + +(defmethod medium-palette ((medium medium)) + (sheet-palette (medium-sheet medium))) + +;;; especially these - could be with other named-color stuff in +;;; utils/designs but things like port, sheet, medium aren't known +;;; there. + +(defmethod find-named-color (name (port port)) + (find-named-color name (port-default-palette port))) + +(defmethod find-named-color (name (sheet sheet)) + (find-named-color name (sheet-palette sheet))) + +(defmethod find-named-color (name (medium medium)) + (find-named-color name (medium-palette medium))) + + + + + diff --git a/test/test-suite.lisp b/test/test-suite.lisp index 05b1b6a1..12bf33fa 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 -*- -;; $fiHeader: test-suite.lisp,v 1.38 92/09/30 18:04:00 cer Exp Locker: cer $ +;; $fiHeader: test-suite.lisp,v 1.39 92/10/02 15:20:19 cer Exp Locker: cer $ (in-package :clim-user) @@ -685,26 +685,7 @@ people, shall not perish from the earth. :towards-x x :towards-y 0))))) (defparameter *named-colors* - '(+white+ +black+ +red+ +green+ +blue+ +yellow+ +cyan+ +magenta+ - +snow+ +ghost-white+ +white-smoke+ +gainsboro+ +floral-white+ +old-lace+ +linen+ - +antique-white+ +papaya-whip+ +blanched-almond+ +bisque+ +peach-puff+ +navajo-white+ - +moccasin+ +cornsilk+ +ivory+ +lemon-chiffon+ +seashell+ +honeydew+ +mint-cream+ +azure+ - +alice-blue+ +lavender+ +lavender-blush+ +misty-rose+ +dark-slate-gray+ +dim-gray+ - +slate-gray+ +light-slate-gray+ +gray+ +light-gray+ +midnight-blue+ +navy-blue+ - +cornflower-blue+ +dark-slate-blue+ +slate-blue+ +medium-slate-blue+ +light-slate-blue+ - +medium-blue+ +royal-blue+ +dodger-blue+ +deep-sky-blue+ +sky-blue+ +light-sky-blue+ - +steel-blue+ +light-steel-blue+ +light-blue+ +powder-blue+ +pale-turquoise+ +dark-turquoise+ - +medium-turquoise+ +turquoise+ +light-cyan+ +cadet-blue+ +medium-aquamarine+ +aquamarine+ - +dark-green+ +dark-olive-green+ +dark-sea-green+ +sea-green+ +medium-sea-green+ - +light-sea-green+ +pale-green+ +spring-green+ +lawn-green+ +chartreuse+ - +medium-spring-green+ +green-yellow+ +lime-green+ +yellow-green+ +forest-green+ +olive-drab+ - +dark-khaki+ +khaki+ +pale-goldenrod+ +light-goldenrod-yellow+ +light-yellow+ +gold+ - +light-goldenrod+ +goldenrod+ +dark-goldenrod+ +rosy-brown+ +indian-red+ +saddle-brown+ - +sienna+ +peru+ +burlywood+ +beige+ +wheat+ +sandy-brown+ +tan+ +chocolate+ +firebrick+ - +brown+ +dark-salmon+ +salmon+ +light-salmon+ +orange+ +dark-orange+ +coral+ +light-coral+ - +tomato+ +orange-red+ +hot-pink+ +deep-pink+ +pink+ +light-pink+ +pale-violet-red+ +maroon+ - +medium-violet-red+ +violet-red+ +violet+ +plum+ +orchid+ +medium-orchid+ +dark-orchid+ - +dark-violet+ +blue-violet+ +purple+ +medium-purple+ +thistle+)) + '(+white+ +black+ +red+ +green+ +blue+ +yellow+ +cyan+ +magenta+)) (define-test (colored-inks graphics) (stream) "Test colors" diff --git a/test/test.lisp b/test/test.lisp index ccd22db5..4fb51483 100644 --- a/test/test.lisp +++ b/test/test.lisp @@ -19,7 +19,7 @@ ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: test.lisp,v 1.38 92/09/08 10:35:06 cer Exp $ +;; $fiHeader: test.lisp,v 1.39 92/09/24 09:39:44 cer Exp Locker: cer $ (in-package :clim-user) @@ -34,7 +34,7 @@ (make-pane 'push-button :label "press me" :background +black+ - :foreground +purple+ + :foreground +cyan+ :text-style (make-text-style :serif :roman 20))))) diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp index 4ef5d466..1750431a 100644 --- a/tk-silica/ol-gadgets.lisp +++ b/tk-silica/ol-gadgets.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: ol-gadgets.lisp,v 1.27 92/09/30 11:45:34 cer Exp Locker: cer $ +;; $fiHeader: ol-gadgets.lisp,v 1.28 92/10/02 15:20:54 cer Exp Locker: cer $ (in-package :xm-silica) @@ -438,12 +438,23 @@ (defclass openlook-text-field (text-field xt-leaf-pane) ()) +;;-- Extreme hack alert + +(defmethod compose-space ((tf openlook-text-field) &key width height) + (declare (ignore width height)) + (let ((string (gadget-value tf)) + (font (tk::get-values (sheet-mirror tf) :font))) + (if (zerop (length string)) (setq string "fooofofofo")) + (make-space-requirement :width (* (length string) (tk::font-width font)) + :height (+ 5 (tk::font-height font))))) + (defmethod find-widget-class-and-initargs-for-sheet ((port openlook-port) (parent t) (sheet openlook-text-field)) (with-accessors ((value gadget-value)) sheet (values 'tk::text-field (append + `(:chars-visible ,(if (zerop (length value)) 30 (length value))) (and value `(:string ,value)))))) (defun openlook-text-field-edit-widget (tf &optional (mirror (sheet-direct-mirror tf))) diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index d6a7b6e1..f2225f8d 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-graphics.lisp,v 1.42 92/09/30 18:04:28 cer Exp Locker: cer $ +;; $fiHeader: xt-graphics.lisp,v 1.43 92/10/02 15:21:08 cer Exp Locker: cer $ (in-package :tk-silica) @@ -64,22 +64,29 @@ (defclass xt-palette (basic-palette) ((colormap :reader palette-colormap :initarg :colormap) - (color-p :initarg :color-p) + (xcolor-cache :initform (make-hash-table) :reader palette-xcolor-cache) + (named-color-cache :initform (make-hash-table :test #'equalp) + :reader palette-named-color-cache) (white-pixel :initarg :white-pixel) (black-pixel :initarg :black-pixel))) -(defmethod make-palette ((port xt-port) &key colormap) +(defun make-xt-palette (port colormap) (let* ((display (port-display port)) (screen (tk::display-screen-number display))) - (unless colormap - (setq colormap (tk::create-colormap display screen))) (make-instance 'xt-palette :port port :colormap colormap + :mutable-p (and + (member (port-visual-class port) + '(:gray-scale :pseudo-color :direct-color)) + t) :color-p (port-color-p port) :white-pixel (x11:xwhitepixel display screen) :black-pixel (x11:xblackpixel display screen)))) +(defmethod make-palette ((port xt-port) &key) + (make-xt-palette port (tk::create-colormap (port-display port)))) + #+ignore (defmethod (setf frame-manager-palette) :after ((palette xt-palette) (framem standard-frame-manager)) @@ -90,25 +97,36 @@ frame))))) (setf (tk::window-colormap window) colormap))))) -(defmethod medium-palette ((medium xt-medium)) - (frame-manager-palette - (frame-manager (pane-frame (medium-sheet medium))))) - +(defun get-xcolor (color palette) + (let ((xcolor-cache (palette-xcolor-cache palette))) + (or (gethash color xcolor-cache) + (setf (gethash color xcolor-cache) + (multiple-value-bind (red green blue) + (color-rgb color) + (let* ((x #.(1- (ash 1 16)))) + (make-instance 'tk::color + :red (truncate (* x red)) + :green (truncate (* x green)) + :blue (truncate (* x blue))))))))) + +(defmethod find-named-color (name (palette xt-palette)) + (let ((named-color-cache (palette-named-color-cache palette))) + (or (gethash name named-color-cache) + (setf (gethash name named-color-cache) + (let ((xcolor (tk::lookup-color (palette-colormap palette) name)) + (x #.(1- (ash 1 16)))) + (make-rgb-color (/ (x11:xcolor-red xcolor) x) + (/ (x11:xcolor-green xcolor) x) + (/ (x11:xcolor-blue xcolor) x))))))) + (defmethod update-palette-entry ((palette xt-palette) pixel color) - (let ((xcolor (cdr (decode-true-color palette color)))) + (let ((xcolor (get-xcolor color palette))) + (setf (x11:xcolor-pixel xcolor) pixel) (with-slots (colormap) palette (tk::store-color colormap xcolor)))) -(defmethod update-palette-entry ((palette xt-palette) pixel (color named-color)) - (with-slots (colormap) palette - (tk::store-named-color - colormap - (named-color-name color) - pixel - #.(logior x11:dored x11:dogreen x11:doblue)))) - (defmethod update-palette-entries ((palette xt-palette) updates) (with-slots (colormap) palette (let* ((n (ash (length updates) -1)) @@ -117,7 +135,7 @@ (dotimes (i n) (let ((pixel (aref updates j)) (color (aref updates (1+ j)))) - (let ((xcolor (cdr (decode-true-color palette color)))) + (let ((xcolor (get-xcolor color palette))) (declare (ignore ignore)) (setf (x11:xcolor-array-red xcolors i) (x11:xcolor-red xcolor) (x11:xcolor-array-green xcolors i) (x11:xcolor-green xcolor) @@ -201,7 +219,6 @@ (tk::object-display drawable)))) (error "drawable and display do not match")) (let* ((display (port-display port)) - (screen (tk::display-screen-number display)) (drawable (or drawable (tk::display-root-window display)))) (unless foreground-gcontext @@ -388,7 +405,7 @@ ;;; there otherwise make a gc using decode-color to get the foreground ;;; pixel value -;;--- This is really on color, named-color, mutable-color, and group-color. +;;--- This is really on color, mutable-color, and group-color. ;;--- Perhaps there should be a class like basic-color? (defmethod decode-ink ((ink design) (medium xt-medium)) @@ -519,7 +536,10 @@ and on color servers, unless using white or black") (defmethod decode-ink ((ink pattern) medium) (xt-decode-pattern ink medium)) - + +(defmethod decode-color ((medium xt-medium) (design design)) + (error "Drawing with design: ~A not yet implemented" design)) + (defmethod decode-color ((medium xt-medium) (x (eql +foreground-ink+))) (with-slots (foreground-gcontext) medium (tk::gcontext-foreground foreground-gcontext))) @@ -534,30 +554,14 @@ and on color servers, unless using white or black") (decode-color stream +background-ink+))) (defmethod decode-color ((medium xt-medium) (color color)) - (car (decode-true-color (medium-palette medium) color))) - -(defmethod decode-color ((medium xt-medium) (color named-color)) - (car (decode-true-color (medium-palette medium) color))) - -;;; in this context a true-color means a named or and rgb (or equiv -;;; ihs) color - -(defmethod decode-true-color ((palette xt-palette) (color color)) - (let ((color-cache (palette-color-cache palette))) + (let* ((palette (medium-palette medium)) + (color-cache (palette-color-cache palette))) (or (gethash color color-cache) (setf (gethash color color-cache) (with-slots (color-p white-pixel black-pixel) palette (cond (color-p - (multiple-value-bind (red green blue) - (color-rgb color) - (let* ((x #.(1- (ash 1 16))) - (xcolor (make-instance 'tk::color - :red (truncate (* x red)) - :green (truncate (* x green)) - :blue (truncate (* x blue))))) - (cons (tk::allocate-color - (palette-colormap palette) xcolor) - xcolor)))) + (tk::allocate-color + (palette-colormap palette) (get-xcolor color palette))) ;;-- support gray-scale here (t (multiple-value-bind (r g b) (color-rgb color) @@ -567,16 +571,6 @@ and on color servers, unless using white or black") white-pixel black-pixel))))))))))) -(defmethod decode-true-color ((palette xt-palette) (color named-color)) - (let ((color-cache (palette-color-cache palette))) - (or (gethash color color-cache) - (setf (gethash color color-cache) - (let* ((colormap (palette-colormap palette)) - (xcolor (tk::lookup-color colormap - (named-color-name color)))) - (cons (tk::allocate-color colormap xcolor) - xcolor)))))) - (defmethod decode-color ((medium xt-medium) (color mutable-color)) (let* ((palette (medium-palette medium)) (mutable-color-cache (palette-mutable-color-cache palette))) diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index 9a28038f..21d8ac5b 100644 --- a/tk-silica/xt-silica.lisp +++ b/tk-silica/xt-silica.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-silica.lisp,v 1.48 92/09/30 18:04:31 cer Exp Locker: cer $ +;; $fiHeader: xt-silica.lisp,v 1.49 92/10/02 15:21:11 cer Exp Locker: cer $ (in-package :xm-silica) @@ -107,7 +107,7 @@ (port-depth port) (x11:xdefaultdepth display (tk::display-screen-number display)) (port-visual-class port) (tk::screen-root-visual-class (tk::default-screen display)) (slot-value port 'default-palette) - (make-palette port :colormap (tk::default-colormap (port-display port)))) + (make-xt-palette port (tk::default-colormap (port-display port)))) (let* ((screen (x11:xdefaultscreenofdisplay display)) (bs-p (not (zerop (x11::screen-backing-store screen)))) (su-p (not (zerop (x11::screen-save-unders screen)))) @@ -123,7 +123,8 @@ (and *use-color* (> (port-depth port) 2) (member (port-visual-class port) - '(:static-color :true-color :pseudo-color :direct-color)))) + '(:static-color :true-color :pseudo-color :direct-color)) + t)) (defvar *xt-font-families* '((:fix "*-*-courier-*-*-*-*-*-*-*-*-*-*-*-*") (:sans-serif "*-*-helvetica-*-*-*-*-*-*-*-*-*-*-*-*") diff --git a/tk/resources.lisp b/tk/resources.lisp index 0adc335c..a6cc7c1a 100644 --- a/tk/resources.lisp +++ b/tk/resources.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: resources.lisp,v 1.33 92/09/24 09:37:18 cer Exp Locker: cer $ +;; $fiHeader: resources.lisp,v 1.34 92/09/30 18:03:07 cer Exp Locker: cer $ (in-package :tk) @@ -623,3 +623,7 @@ (defmethod convert-resource-in ((parent t) (typep (eql 'char)) value) (cltl1:int-char value)) +(defmethod convert-resource-in ((parent t) (typep (eql 'font-struct)) value) + (make-instance 'font + :display (widget-display parent) + :foreign-address value)) diff --git a/utils/base-designs.lisp b/utils/base-designs.lisp index ae7d7766..ef0a6714 100644 --- a/utils/base-designs.lisp +++ b/utils/base-designs.lisp @@ -5,7 +5,7 @@ "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." "Portions Copyright (c) 1992 Franz, Inc. All rights reserved." -;;; $fiHeader$ +;;; $fiHeader: base-designs.lisp,v 1.1 92/09/30 18:02:42 cer Exp $ ;;; Designs @@ -92,19 +92,6 @@ (with-slots (color) color `(make-mutable-color ,color))) - -;;; Named Colors - -(defclass named-color (design) - ((name :type string :reader named-color-name :initarg :name))) - -(define-constructor make-named-color named-color (name) - :name name) - -(defmethod make-load-form ((color named-color)) - (with-slots (name) color - `(make-named-color ,name))) - ;;; Color Groups diff --git a/utils/designs.lisp b/utils/designs.lisp index dd98108a..d454d284 100644 --- a/utils/designs.lisp +++ b/utils/designs.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: designs.lisp,v 1.5 92/08/18 17:24:05 cer Exp $ +;; $fiHeader: designs.lisp,v 1.6 92/09/30 18:03:18 cer Exp $ (in-package :clim-utils) @@ -28,66 +28,18 @@ ((= opacity 1) +everywhere+) (t (make-standard-opacity-1 opacity)))) - -;;; Named Colors - -(defmethod print-object ((color named-color) stream) - (print-unreadable-object (color stream :type t :identity t) - (princ (named-color-name color) stream))) - -(defmacro define-named-color (color) - (let* ((sym (symbol-name color)) - (name (substitute #\space #\- - (string-downcase - (subseq sym 1 (1- (length sym))))))) - `(defconstant ,color - (make-named-color ,name)))) - -(defmacro define-named-colors (&rest colors) - `(progn - ,@(mapcar #'(lambda (color) - `(define-named-color ,color)) colors))) - -(define-named-colors - +black+ +white+ +red+ +green+ +blue+ +cyan+ +magenta+ +yellow+ - +snow+ +ghost-white+ +white-smoke+ +gainsboro+ +floral-white+ - +old-lace+ +linen+ +antique-white+ +papaya-whip+ +blanched-almond+ - +bisque+ +peach-puff+ +navajo-white+ +moccasin+ +cornsilk+ +ivory+ - +lemon-chiffon+ +seashell+ +honeydew+ +mint-cream+ +azure+ - +alice-blue+ +lavender+ +lavender-blush+ +misty-rose+ - +dark-slate-gray+ +dim-gray+ +slate-gray+ +light-slate-gray+ +gray+ - +light-gray+ +midnight-blue+ +navy-blue+ +cornflower-blue+ - +dark-slate-blue+ +slate-blue+ +medium-slate-blue+ +light-slate-blue+ - +medium-blue+ +royal-blue+ +dodger-blue+ +deep-sky-blue+ +sky-blue+ - +light-sky-blue+ +steel-blue+ +light-steel-blue+ +light-blue+ - +powder-blue+ +pale-turquoise+ +dark-turquoise+ +medium-turquoise+ - +turquoise+ +light-cyan+ +cadet-blue+ +medium-aquamarine+ +aquamarine+ - +dark-green+ +dark-olive-green+ +dark-sea-green+ +sea-green+ - +medium-sea-green+ +light-sea-green+ +pale-green+ +spring-green+ - +lawn-green+ +chartreuse+ +medium-spring-green+ +green-yellow+ - +lime-green+ +yellow-green+ +forest-green+ +olive-drab+ +dark-khaki+ - +khaki+ +pale-goldenrod+ +light-goldenrod-yellow+ +light-yellow+ - +gold+ +light-goldenrod+ +goldenrod+ +dark-goldenrod+ +rosy-brown+ - +indian-red+ +saddle-brown+ +sienna+ +peru+ +burlywood+ +beige+ - +wheat+ +sandy-brown+ +tan+ +chocolate+ +firebrick+ +brown+ - +dark-salmon+ +salmon+ +light-salmon+ +orange+ +dark-orange+ +coral+ - +light-coral+ +tomato+ +orange-red+ +hot-pink+ +deep-pink+ +pink+ - +light-pink+ +pale-violet-red+ +maroon+ +medium-violet-red+ - +violet-red+ +violet+ +plum+ +orchid+ +medium-orchid+ +dark-orchid+ - +dark-violet+ +blue-violet+ +purple+ +medium-purple+ +thistle+) - ;;; Gray colors -(defconstant rgb-black (make-gray-color-1 0f0)) -(defconstant rgb-white (make-gray-color-1 1f0)) +(defconstant +black+ (make-gray-color-1 0f0)) +(defconstant +white+ (make-gray-color-1 1f0)) (defun make-gray-color (luminosity) #+Genera (declare lt:(side-effects simple reducible)) (assert (and (numberp luminosity) (<= 0 luminosity 1)) (luminosity) "The luminosity ~S is not a number between 0 and 1" luminosity) - (cond ((= luminosity 0) rgb-black) - ((= luminosity 1) rgb-white) + (cond ((= luminosity 0) +black+) + ((= luminosity 1) +white+) (t (make-gray-color-1 (float luminosity 0f0))))) (defmethod print-object ((color gray-color) stream) @@ -121,7 +73,7 @@ "The blue value ~S is not a number between 0 and 1" blue) (if (= red green blue) (make-gray-color red) - (make-rgb-color-1 (float red 0f0) (float green 0f0) (float blue 0f0)))) + (make-rgb-color-1 (float red 0f0) (float green 0f0) (float blue 0f0)))) (defmethod print-object ((color rgb-color) stream) (print-unreadable-object (color stream :type t :identity t) @@ -162,7 +114,7 @@ "The hue value ~S is not a number between 0 and 1" hue) (assert (and (numberp saturation) (<= 0 saturation 1)) (saturation) "The saturation value ~S is not a number between 0 and 1" saturation) - (cond ((= intensity 0) rgb-black) + (cond ((= intensity 0) +black+) (t (make-ihs-color-1 (float intensity 0f0) (float hue 0f0) (float saturation 0f0))))) @@ -191,11 +143,25 @@ (with-slots (intensity hue saturation) color (values intensity hue saturation))) + +(defmacro define-named-color (color r g b) + `(defconstant ,color + (make-rgb-color-1 (float ,r 0f0) (float ,g 0f0) (float ,b 0f0)))) + +;;; The primary colors + +(define-named-color +red+ 1 0 0) +(define-named-color +green+ 0 1 0) +(define-named-color +blue+ 0 0 1) +(define-named-color +cyan+ 0 1 1) +(define-named-color +magenta+ 1 0 1) +(define-named-color +yellow+ 1 1 0) + ;;; Mutable Colors (defun make-mutable-color (&key (color +black+)) - (make-mutable-color-1 (ensure-color color))) + (make-mutable-color-1 color)) (defmethod print-object ((color mutable-color) stream) (print-unreadable-object (color stream :type t :identity t) @@ -203,32 +169,24 @@ (defvar *doing-delayed-mutations* nil) -(defun mutate-mutable (mutable color) +(defmethod mutate-mutable ((mutable mutable-color) (color color)) (if *doing-delayed-mutations* (dolist (palette (mutable-color-palettes mutable)) - (let ((cell (gethash mutable (palette-mutable-color-cache palette))) - (mutations (palette-delayed-mutations palette))) - (vector-push-extend cell mutations) - (vector-push-extend color mutations))) + (let ((cell (gethash mutable (silica:palette-mutable-color-cache palette))) + (mutations (silica:palette-delayed-mutations palette))) + (excl:without-interrupts + (vector-push-extend cell mutations) + (vector-push-extend color mutations)))) (dolist (palette (mutable-color-palettes mutable)) - (let ((cell (gethash mutable (palette-mutable-color-cache palette)))) + (let ((cell (gethash mutable (silica:palette-mutable-color-cache palette)))) (update-palette-entry palette cell color))))) -(defun ensure-color (color) - (assert (or (typep color 'color) - (typep color 'named-color)) - (color) - "~S is not of type ~S or ~S" color 'color 'named-color) - color) - -(defmethod (setf mutable-color-color) :before (color (mutable mutable-color)) - (let ((color (ensure-color color))) - (mutate-mutable mutable color))) +(defmethod (setf mutable-color-color) :after ((color color) (mutable mutable-color)) + (mutate-mutable mutable color)) -(defmethod mutate-color ((mutable mutable-color) color) - (let ((color (ensure-color color))) - (setf (slot-value mutable 'color) color) - (mutate-mutable mutable color))) +(defmethod mutate-color ((mutable mutable-color) (color color)) + (setf (slot-value mutable 'color) color) + (mutate-mutable mutable color)) ;;; note that the actual color mutation occurs on exiting the outermost ;;; with-delayed-mutations @@ -243,8 +201,8 @@ ,@body (progn (unless ,outer-doing-delayed-mutations - (dolist (,palette *all-palettes*) - (let ((,mutations (palette-delayed-mutations ,palette))) + (dolist (,palette silica:*all-palettes*) + (let ((,mutations (silica:palette-delayed-mutations ,palette))) (update-palette-entries ,palette ,mutations) (setf (fill-pointer ,mutations) 0))))))))) @@ -264,11 +222,10 @@ (setf (gethash layers cache) (make-group-color color-group layers))))) -(defmethod mutate-color ((group-color group-color) color) - (let ((color (ensure-color color))) - (with-delayed-mutations - (dolist (mutable (group-color-mutables group-color)) - (mutate-mutable mutable color))))) +(defmethod mutate-color ((group-color group-color) (color color)) + (with-delayed-mutations + (dolist (mutable (group-color-mutables group-color)) + (mutate-mutable mutable color)))) ;;; group-color-mutables should not be exported to the user. It is important ;;; that these mutables are not drawn with. Instead the fully specified group diff --git a/utils/packages.lisp b/utils/packages.lisp index 50645a3f..5228d3db 100644 --- a/utils/packages.lisp +++ b/utils/packages.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: packages.lisp,v 1.31 92/09/30 18:03:24 cer Exp Locker: cer $ +;; $fiHeader: packages.lisp,v 1.32 92/10/02 15:18:52 cer Exp Locker: cer $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) @@ -2028,60 +2028,36 @@ contrasting-inks-limit design designp + find-named-color + group-color + make-color-group make-contrasting-inks make-flipping-ink make-gray-color make-ihs-color + make-mutable-color make-opacity make-rgb-color + mutable-color-color + mutate-color opacity opacity-value opacityp + with-delayed-mutations + + ;; Palettes - - named-color - make-named-color - named-color-name - palette - *all-palettes* - basic-palette + palette-color-p + palette-mutable-p + palettep make-palette - default-palette port-default-palette - palette-color-cache - palette-mutable-color-cache - palette-color-group-cache - palette-delayed-mutations - color-cache - mutable-color-cache - color-group-cache - update-palette-entry - update-palette-entries medium-palette + sheet-palette + frame-palette frame-manager-palette - mutable-color - make-mutable-color - mutable-color-color - mutable-color-palettes - mutate-color - with-delayed-mutations - *doing-delayed-mutations* - - color-group - color-group-layers - color-group-cache - color-group-mutable-array - - map-over-group-colors - group-color - group-color-group - group-color-layers - make-color-group - make-group-color - mutables - ;; Designs compose-in compose-out @@ -3395,6 +3371,9 @@ radians->degrees ;; From DESIGNS + color-group + color-group-layers + color-group-mutable-array color-luminosity composite-in composite-out @@ -3409,16 +3388,23 @@ flipping-ink gray-color gray-color-luminosity + group-color-group + group-color-layers ihs-color make-color-for-contrasting-ink make-design-from-output-record make-flipping-ink make-gray-color-for-contrasting-ink + map-over-group-colors + mutable-color + mutable-color-palettes pattern rectangular-tile rgb-color stencil - stencil-array)) + stencil-array + update-palette-entry + update-palette-entries)) (#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clim-silica @@ -3446,6 +3432,7 @@ (:export *all-drawing-options* + *all-palettes* *modifier-keys* *null-text-style* *pointer-buttons* @@ -3457,6 +3444,7 @@ add-sheet-callbacks all-drawing-options-lambda-list allocate-event + basic-palette basic-pixmap-medium bury-mirror canvas @@ -3470,6 +3458,7 @@ clear-space-requirement-caches-in-tree click-event client-overridability-mixin + color-p compute-gadget-label-size compute-list-pane-selected-items compute-menu-bar-pane @@ -3478,6 +3467,7 @@ compute-text-y-adjustment copy-event deallocate-event + default-palette default-space-requirements define-character-face define-character-face-added-mappings @@ -3560,11 +3550,16 @@ mirror-visible-p mirrored-sheet-mixin modifier-keysym + mutable-p mute-repainting-mixin non-drawing-option-keywords note-layout-mixin-region-changed one-of-pane option-pane + palette-color-cache + palette-mutable-color-cache + palette-color-group-cache + palette-delayed-mutations parse-gesture-spec pixmap pixmap-from-menu-item -- GitLab