diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp index c760d233f86aa90cabf3438dcae5ca8fceeb0dbf..bd462a55652f6030fe1cb20a83b56f26f3b082af 100644 --- a/clim/excl-presentations.lisp +++ b/clim/excl-presentations.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: excl-presentations.lisp,v 1.5 92/02/28 09:17:48 cer Exp $ +;; $fiHeader: excl-presentations.lisp,v 1.6 92/03/04 16:21:33 cer Exp Locker: cer $ (in-package :clim-internals) @@ -40,11 +40,12 @@ &rest args &key (type nil type-p) object) - (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) + (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/notes/clim.todo b/notes/clim.todo index 3e72ed4673a87848f27caf62a6f9cfae3f722532..84d0a143045a1e36210034efa2d1b3e289edaf67 100644 --- a/notes/clim.todo +++ b/notes/clim.todo @@ -1,4 +1,4 @@ -%% $fiHeader: clim.todo,v 1.7 92/03/04 10:47:05 cer Exp Locker: cer $ +%% $fiHeader: clim.todo,v 1.8 92/03/06 09:08:36 cer Exp Locker: cer $ %% ****************************************** SWM things @@ -210,6 +210,11 @@ * [cer] perhaps max widths ending up smaller than widths! * [cer] :fill in box panes?? * [cer] why do we need a pane when we read commands? + * [cer] replay-output-record is not called on output-record-mixin! + See the method in recording-output-protocol.lisp + * [cer] I suspect that replay needs to intersect the region with the + viewport + %% ******************************************* JDI things diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index 74650c6dab8e65a5ef596c2735778f7cb4c51b17..f8ca5a4ed03167a15cab5ed09feb96bafb3e69d4 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: gadgets.lisp,v 1.8 92/02/24 13:04:35 cer Exp $ +;; $fiHeader: gadgets.lisp,v 1.9 92/03/04 16:19:41 cer Exp Locker: cer $ "Copyright (c) 1991, 1992 by Franz, Inc. All rights reserved. Portions copyright (c) 1992 by Symbolics, Inc. All rights reserved." @@ -179,8 +179,18 @@ ((selections :initform nil :reader radio-box-selections) (current-selection :initform nil + :initarg :current-selection :accessor radio-box-current-selection))) +(defmethod initialize-instance :after ((rb radio-box) &key choices) + (let ((fr (pane-frame rb))) + (with-look-and-feel-realization ((frame-manager fr) fr) + (dolist (choice choices) + (realize-pane 'toggle-button + :value (equal (radio-box-current-selection rb) choice) + :label (string choice) + :id choice + :parent rb))))) ;;; Menu-bar diff --git a/silica/mirror.lisp b/silica/mirror.lisp index 9e0ca13477c1c9b578585d10195e256584f79257..f4d832f76733a60b7d1f8f7b4b8f6fffda55684b 100644 --- a/silica/mirror.lisp +++ b/silica/mirror.lisp @@ -19,7 +19,7 @@ ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: mirror.lisp,v 1.9 92/03/04 16:19:49 cer Exp Locker: cer $ +;; $fiHeader: mirror.lisp,v 1.10 92/03/06 09:08:28 cer Exp Locker: cer $ (in-package :silica) @@ -266,10 +266,11 @@ (/= sc-y 1.0) (not (zerop tr-x)) (not (zerop tr-y))) - (warn "Mirror scaling ~S,~S,~S,~S" - (list tr-x tr-y sc-x sc-y) sheet - (multiple-value-list (mirror-inside-edges* port sheet)) - (sheet-region sheet))) + (let (#+Allegro (*error-output* excl::*initial-terminal-io*)) + (warn "Mirror scaling ~S,~S,~S,~S" + (list tr-x tr-y sc-x sc-y) sheet + (multiple-value-list (mirror-inside-edges* port sheet)) + (sheet-region sheet)))) (setf (sheet-native-transformation sheet) ;;--- Inline the composition to save some consing (compose-transformations diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp index 0e52ee40cf509b45e3f80db7667ac79d2383cbb4..1c9d662149f5c4489678e3a31a3de01c41854405 100644 --- a/tk-silica/xm-gadgets.lisp +++ b/tk-silica/xm-gadgets.lisp @@ -18,7 +18,7 @@ ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xm-gadgets.lisp,v 1.13 92/03/04 16:20:36 cer Exp Locker: cer $ +;; $fiHeader: xm-gadgets.lisp,v 1.14 92/03/06 09:08:32 cer Exp Locker: cer $ (in-package :xm-silica) @@ -468,11 +468,11 @@ (id t) (value t)) (when (eq value t) - (setf (radio-box-current-selection client) v) + (setf (radio-box-current-selection client) id) (value-changed-callback client (gadget-client client) (gadget-id client) - v))) + id))) ;; This is an experiment at using a frame but there are problems with ;; it diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index 0ea475efb5ca3eaf1094942d106bb30e900468fb..84fefd384e7a179e642245f552ea83c4cddf6274 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.9 92/03/04 16:20:46 cer Exp Locker: cer $ +;; $fiHeader: xt-silica.lisp,v 1.10 92/03/06 09:08:33 cer Exp Locker: cer $ (in-package :xm-silica) @@ -136,7 +136,9 @@ (defmethod destroy-mirror ((port xt-port) sheet) - (tk::destroy-widget (sheet-direct-mirror sheet))) + ;;-- I dont think that we should do this. + (tk::destroy-widget (sheet-direct-mirror sheet)) + ) (defmethod realize-mirror ((port xt-port) sheet) (let ((parent (find-widget-parent port sheet))) diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp index 9f9978f835c2d3b33a4907a4530d7f9c37b9ede6..dcd0591703b2df31cd3458a64741a1cafa3d360f 100644 --- a/tk/make-classes.lisp +++ b/tk/make-classes.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: make-classes.lisp,v 1.7 92/02/16 20:55:03 cer Exp $ +;; $fiHeader: make-classes.lisp,v 1.8 92/02/24 13:03:28 cer Exp Locker: cer $ (in-package :tk) @@ -245,7 +245,8 @@ (error "toolkit errror: ~a" (char*-to-string message))) (defun-c-callable toolkit-warning-handler ((message :unsigned-long)) - (warn "toolkit warning: ~a" (char*-to-string message))) + (let ((*error-output* excl:*initial-terminal-io*)) + (warn "toolkit warning: ~a" (char*-to-string message)))) (defun add-resource-to-class (class resource)