diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp index 2ae757ebaafa54875bde002c7e838f199b3297d3..6003c155d82907e88a4b87e20aa64ec6ca0c64ab 100644 --- a/clim/db-stream.lisp +++ b/clim/db-stream.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: db-stream.lisp,v 1.46 93/03/18 14:36:24 colin Exp $ +;; $fiHeader: db-stream.lisp,v 1.47 93/03/19 09:43:21 cer Exp $ (in-package :clim-internals) @@ -389,8 +389,9 @@ (:thickness 1 :name ,name ,@(and background-p `(:background ,background-var))) - #+Allegro ,pane - #-Allegro (spacing (:thickness 1) ,pane)))) + (spacing (:thickness 1 + ,@(and background-p `(:background ,background-var))) + ,pane)))) `(let ((,stream) ,@(and background-p `((,background-var ,background)))) (values ,pane ,stream)))) diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp index f4331b5489f028099f5454c16b582e6ec2808a3d..0955018ce56022167f46b30dd986f9e1142aa579 100644 --- a/clim/gadget-output.lisp +++ b/clim/gadget-output.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: gadget-output.lisp,v 1.44 93/02/08 15:56:49 cer Exp $ +;; $fiHeader: gadget-output.lisp,v 1.45 93/03/04 18:59:54 colin Exp $ (in-package :clim-internals) @@ -608,7 +608,13 @@ (values (outlining () slider) slider)))))) -;;; Text editing gadgets +;;; Text Field gadget + +;; The string case is straightforward +(define-presentation-method decode-indirect-view + ((type string) (view gadget-dialog-view) + (framem standard-frame-manager) &key) + +text-field-view+) (define-presentation-method accept-present-default ((type t) stream (view text-field-view) @@ -692,37 +698,15 @@ (setf (accept-values-query-error-p query) nil) (do-avv-command object stream query)))))) -;; The string case is straightforward + + (define-presentation-method decode-indirect-view - ((type string) (view gadget-dialog-view) + ((type sequence) (view gadget-dialog-view) (framem standard-frame-manager) &key) +text-field-view+) -;;--- How does this differ from the default method for -;;--- accept-present-default -#+++ignore -(define-presentation-method accept-present-default - ((type string) stream (view text-field-view) - default default-supplied-p present-p query-identifier - &key (prompt t) (active-p t)) - (declare (ignore default-supplied-p present-p)) - (move-cursor-to-view-position stream view) - (flet ((update-gadget (record gadget button) - (declare (ignore record gadget)) - (if active-p - (activate-gadget button) - (deactivate-gadget button)) - (setf (gadget-value button) default))) - (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget) - (let ((text-field (make-pane-from-view 'text-field view - :label (and (stringp prompt) prompt) - :value default - :client stream :id query-identifier - :value-changed-callback - (make-accept-values-value-changed-callback - stream query-identifier) - :active active-p))) - (values text-field text-field))))) + +;;; Text Editor gadget (define-presentation-method accept-present-default ((type string) stream (view text-editor-view) diff --git a/silica/classes.lisp b/silica/classes.lisp index 59773011a52e0cf92eb45134e8b4397aa81ff88b..784aa5bbff51ac75e86e370d5c025a755b6f773f 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.30 93/01/11 15:45:14 colin Exp $ +;; $fiHeader: classes.lisp,v 1.31 93/03/04 19:01:04 colin Exp $ (in-package :silica) @@ -39,8 +39,6 @@ (pointer :initform nil) (mapping-table :initform (make-hash-table :test #'equal)) (mapping-cache :initform (cons nil nil)) ;one entry cache - (default-text-style :initform *default-text-style* - :accessor port-default-text-style) (undefined-text-style :initform *undefined-text-style* :accessor port-undefined-text-style) ;; When this is true, the text style to device font mapping is done diff --git a/silica/db-border.lisp b/silica/db-border.lisp index 0ee322f2700a9715b5524a11861da2ba5c9e2a5b..278941c901420f68973278418abf7143f9aca1fd 100644 --- a/silica/db-border.lisp +++ b/silica/db-border.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: db-border.lisp,v 1.17 93/02/08 15:57:24 cer Exp $ +;; $fiHeader: db-border.lisp,v 1.18 93/03/18 14:37:39 colin Exp $ "Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. Portions copyright (c) 1991, 1992 by Symbolics, Inc. All rights reserved." @@ -66,7 +66,7 @@ (defclass outlined-pane (border-pane) () ;; Yes, the background for this pane is the default foreground color - (:default-initargs :background *default-pane-foreground*)) + (:default-initargs :default-background *default-pane-foreground*)) (defmacro outlining ((&rest options &key thickness &allow-other-keys) &body contents) @@ -80,7 +80,7 @@ (defclass spacing-pane (border-pane) () - (:default-initargs :background *default-pane-background* :thickness 2)) + (:default-initargs :thickness 2)) (defmacro spacing ((&rest options &key thickness &allow-other-keys) &body contents) (declare (ignore thickness)) diff --git a/silica/pixmaps.lisp b/silica/pixmaps.lisp index d47a86ec0d7035e6d32d6778ad6623666e3ec1d9..ab193987ebab2f8f9af71bb6aab28140e80a9652 100644 --- a/silica/pixmaps.lisp +++ b/silica/pixmaps.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: pixmaps.lisp,v 1.14 92/12/03 10:29:30 cer Exp $ +;; $fiHeader: pixmaps.lisp,v 1.15 93/02/08 15:57:36 cer Exp $ (in-package :silica) @@ -75,7 +75,6 @@ (medium-foreground sheet) (or (medium-foreground medium) +black+) (medium-background sheet) (or (medium-background medium) +white+) (medium-default-text-style sheet) (or (medium-default-text-style medium) - (and port (port-default-text-style port)) *default-text-style*))) (defmethod handle-repaint ((pane pixmap-sheet) region) diff --git a/test/test-suite.lisp b/test/test-suite.lisp index f75f713be0ab79a4f373541e99989ec471160bcd..c36c882a5ac4442fefd2294707cde0bf8d72edfe 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.54 93/01/18 13:57:57 cer Exp $ +;; $fiHeader: test-suite.lisp,v 1.55 93/02/10 10:04:16 cer Exp $ (in-package :clim-user) @@ -1961,10 +1961,10 @@ Luke Luck licks the lakes Luke's duck likes.")) (draw-point* stream (/ square-dimension 4) (/ square-dimension 2))) - (when draw-/-diagonal + (when draw-\\-diagonal (draw-line* stream 0 square-dimension square-dimension 0 :line-cap-shape :round)) - (when draw-\\-diagonal + (when draw-/-diagonal (draw-line* stream 0 0 square-dimension square-dimension :line-cap-shape :round)))))))))) diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp index 68ca499b0135f986b1dce608bdc34795cab691cc..3b501ddcb9868e3c10c5f559fae825c09570c747 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.39 93/03/04 19:01:52 colin Exp $ +;; $fiHeader: ol-gadgets.lisp,v 1.40 93/03/19 09:46:54 cer Exp $ (in-package :xm-silica) @@ -301,9 +301,8 @@ ;; submenus then it creates one with a menu of its own (let* ((mirror (call-next-method)) - (text-style (menu-bar-text-style sheet)) - (font-list (and text-style - (list :font (text-style-mapping port text-style)))) + (text-style (pane-text-style sheet)) + (font-list (list :font (text-style-mapping port text-style))) (options font-list)) (labels ((update-menu-item-sensitivity (widget frame commands) (declare (ignore widget)) diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp index de6374071301242011854d7b33abc937499252f2..01ad70269abe008e518ccefd70f6cfbed799fb51 100644 --- a/tk-silica/xm-gadgets.lisp +++ b/tk-silica/xm-gadgets.lisp @@ -18,7 +18,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xm-gadgets.lisp,v 1.66 93/03/18 14:39:13 colin Exp $ +;; $fiHeader: xm-gadgets.lisp,v 1.67 93/03/19 09:47:02 cer Exp $ (in-package :xm-silica) @@ -1571,22 +1571,24 @@ (gadget-supplies-scrolling-p contents)) (sheet-adopt-child sp contents) (with-look-and-feel-realization (frame-manager frame) - (when (member scroll-bars '(:both :dynamic :vertical)) - (let ((sb (make-pane 'scroll-bar - :background (pane-background sp) - :orientation :vertical :id :vertical :client sp))) - (setf (scroller-pane-vertical-scroll-bar sp) sb) - (sheet-adopt-child sp sb))) - (when (member scroll-bars '(:both :dynamic :horizontal)) - (let ((sb (make-pane 'scroll-bar - :background (pane-background sp) - :orientation :horizontal :id :horizontal :client sp))) - (setf (scroller-pane-horizontal-scroll-bar sp) sb) - (sheet-adopt-child sp sb))) - (sheet-adopt-child sp (setf (slot-value sp 'viewport) - (make-pane 'viewport - :scroller-pane sp - :background (pane-background sp)))) + (let ((background (getf (silica::sheet-with-resources-initargs sp) + :background))) + (when (member scroll-bars '(:both :dynamic :vertical)) + (let ((sb (make-pane 'scroll-bar + :background background + :orientation :vertical :id :vertical :client sp))) + (setf (scroller-pane-vertical-scroll-bar sp) sb) + (sheet-adopt-child sp sb))) + (when (member scroll-bars '(:both :dynamic :horizontal)) + (let ((sb (make-pane 'scroll-bar + :background background + :orientation :horizontal :id :horizontal :client sp))) + (setf (scroller-pane-horizontal-scroll-bar sp) sb) + (sheet-adopt-child sp sb))) + (sheet-adopt-child sp (setf (slot-value sp 'viewport) + (make-pane 'viewport + :scroller-pane sp + :background background)))) (sheet-adopt-child (slot-value sp 'viewport) contents)))) (defmethod gadget-supplies-scrolling-p ((sheet t)) nil) diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index 22618480d70cd1784074668e2ff8c97f77ebd6f0..4005ac36bc0ff48b23530925d2fd21c47b3202b2 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.71 93/03/18 14:39:45 colin Exp $ +;; $fiHeader: xt-silica.lisp,v 1.72 93/03/19 09:47:13 cer Exp $ (in-package :xm-silica) @@ -1211,10 +1211,8 @@ classes "Foreground")) (text-style (xt::get-resource db names "textStyle" classes "TextStyle"))) - `(,@(and background `(:background - ,(find-named-color background palette))) - ,@(and foreground `(:foreground - ,(find-named-color foreground palette))) + `(,@(and background `(:background ,background)) + ,@(and foreground `(:foreground ,foreground)) ,@(and text-style `(:text-style ,(let ((spec (read-from-string text-style))) diff --git a/utils/packages.lisp b/utils/packages.lisp index 7df12373dcd301d85e1fc6f6c1dd3176a65395fa..f49a9343f99baea952b7ab1902a65eb48c068a60 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.49 93/03/18 14:58:25 colin Exp $ +;; $fiHeader: packages.lisp,v 1.50 93/03/19 09:47:26 cer Exp $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) @@ -3482,7 +3482,6 @@ port-canonical-gesture-specs port-canonicalize-gesture-spec port-deallocate-pixmap - port-default-text-style port-display port-draw-cursor port-event-loop