From b422a15d0ff12b46a9a33b58a6fecd9848d5e0ad Mon Sep 17 00:00:00 2001
From: cer <cer>
Date: Fri, 16 Apr 1993 09:45:59 +0000
Subject: [PATCH] Makefile.defs		Modified training to compile
 test-suite first 			Added silica/db-label.lisp
 clim/accept-values.lisp		changing-space-requirements fix
 clim/graph-formatting.lisp	added find-child-output-record method that
 searches all of the old children

clim/menus.lisp		Fixed for :label to menus
climtoys/coverage.lisp	Sorted files by coverage
climtoys/ib.lisp	Reworked architecture introducing blanket-viewer class.
demo/browser.lisp	Display snapshots in interactor rather on graph
misc/train.lisp		Training to record failed tests in port specific files. Compiles test-suite.lisp
silica/db-border.lisp 	Moved code into silica/db-label.lisp
silica/db-layout.lisp 	invoke-with-changing-space-requirements layout argument defaults to t
silica/gadgets.lisp	Moved code into silica/db-label.lisp
silica/mirror.lisp  	added always-propagate-region-changes-p so
			that we can force mirror resizes to change
			sheet. Forces the rest of the tree to be laid out
sys/sysdcl.lisp		Added db-label.lisp
test/test-driver.lisp	Added *default-input-state-timeout* test
			reporting to send output to file
test/test-suite.lisp	Minor cosmetic changes.
test/test.lisp		made window bigger
tk/resources.lisp	Fixed wrap mode
tk-silica/ol-gadgets.lisp		openlook-frame-pane now
			ignores bacground argument. made use of
			openlook-labelled-gadget. fixed orrientation
			problem in radio-box.
tk-silica/xm-frames.lisp	Moved update-frame-settings and
			frame-manager-note-pretty-name-changed  to xt-frames
tk-silica/xm-gadgets.lisp		Added
			always-propagate-region-changes-p method
tk-silica/xm-silica.lisp		REmoved dialog shell
			change-widget-geometry method
tk-silica/xt-frames.lisp		Moved update-frame-settings and
			frame-manager-note-pretty-name-changed  to xt-frames
tk-silica/xt-silica.lisp Only turn on backing store if the server is safe
---
 clim/accept-values.lisp   |   4 +-
 clim/menus.lisp           |  24 ++++-----
 silica/db-border.lisp     |  23 +--------
 silica/db-label.lisp      | 100 ++++++++++++++++++++++++++++++++++++++
 silica/db-layout.lisp     |   4 +-
 silica/gadgets.lisp       |  55 +--------------------
 silica/mirror.lisp        |   9 +++-
 sys/sysdcl.lisp           |   4 +-
 tk-silica/xm-gadgets.lisp |   5 +-
 tk/resources.lisp         |   7 ++-
 10 files changed, 140 insertions(+), 95 deletions(-)
 create mode 100644 silica/db-label.lisp

diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 926bec3d..53447fd9 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.58 93/04/02 13:35:55 cer Exp $
+;; $fiHeader: accept-values.lisp,v 1.59 93/04/07 09:06:31 cer Exp $
 
 (in-package :clim-internals)
 
@@ -480,7 +480,7 @@
 					     (or (/= width vwidth) (/= height vheight))))))))
 			 (size-panes-appropriately)))))
 		 (size-panes-appropriately ()
-		   (changing-space-requirements ()
+		   (changing-space-requirements (:layout t)
 		     ;; We really want to specify the min/max sizes of
 		     ;; the exit-button pane also
 		     (size-frame-from-contents exit-button-stream
diff --git a/clim/menus.lisp b/clim/menus.lisp
index 48521a69..3d01f68f 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.41 93/03/19 09:43:40 cer Exp $
+;; $fiHeader: menus.lisp,v 1.42 93/03/31 10:38:45 cer Exp $
 
 (in-package :clim-internals)
 
@@ -14,7 +14,7 @@
 
 (define-application-frame menu-frame ()
   (menu 
-   (label  :initform nil :accessor menu-frame-label)
+   (label :initarg :label :initform nil :accessor menu-frame-label)
    (scroll-bars :initarg :scroll-bars 
 		:initform t
 		:reader menu-frame-scroll-bars))
@@ -43,8 +43,9 @@
        *application-frame*))
 
 ;; Returns a stream that corresponds to the pane holding the menu
-(defmethod frame-manager-get-menu ((framem standard-frame-manager) &key scroll-bars)
+(defmethod frame-manager-get-menu ((framem standard-frame-manager) &key scroll-bars label)
   (let ((frame (make-application-frame 'menu-frame
+				       :label label
 				       :scroll-bars scroll-bars
 				       :frame-manager framem
 				       :save-under t)))
@@ -54,14 +55,15 @@
     (values (slot-value frame 'menu) frame)))
 
 (defresource menu (associated-window root &key label (scroll-bars t))
-  :constructor 
-    (let* ((framem (if (null root) (find-frame-manager) (frame-manager root))))
-      (frame-manager-get-menu framem :scroll-bars scroll-bars))
-    :matcher (and (eq scroll-bars (menu-frame-scroll-bars (pane-frame menu)))
-		  (eq (not label) (not (menu-frame-label (pane-frame menu))))
-		  (eq (frame-manager menu) (frame-manager root)))
-  :deinitializer (window-clear menu)
-  :initializer (initialize-menu (port menu) menu :label label))
+	     :constructor 
+	     (let* ((framem (if (null root) (find-frame-manager) (frame-manager root))))
+	       (frame-manager-get-menu framem :scroll-bars scroll-bars :label label))
+	     :matcher (and (eq scroll-bars (menu-frame-scroll-bars (pane-frame menu)))
+			   (eq (not label) (not (menu-frame-label (pane-frame menu))))
+			   (eq (frame-manager menu) (frame-manager root)))
+	       
+	     :deinitializer (window-clear menu)
+	     :initializer (initialize-menu (port menu) menu :label label))
 
 (defmethod initialize-menu ((port basic-port) menu &key label)
   ;;--- Should this flush the menu's event queue?
diff --git a/silica/db-border.lisp b/silica/db-border.lisp
index 278941c9..a2b7c293 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.18 93/03/18 14:37:39 colin Exp $
+;; $fiHeader: db-border.lisp,v 1.19 93/03/25 15:40:25 colin Exp $
 
 "Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
@@ -133,27 +133,6 @@
 		 (vertically () ,lvar ,cvar)))))))
 
 
-(defclass generic-label-pane 
-	  (label-pane
-	   space-requirement-mixin
-	   leaf-pane)
-    ()
-  (:default-initargs :align-x :left
-		     :text-style *default-label-text-style*))
-
-(defmethod compose-space ((pane generic-label-pane) &key width height)
-  (declare (ignore width height))
-  (multiple-value-bind (width height)
-      (compute-gadget-label-size pane)
-    (make-space-requirement :width width :height height)))
-  
-(defmethod handle-repaint ((pane generic-label-pane) region)
-  (declare (ignore region))			;not worth checking
-  (with-sheet-medium (medium pane)
-    (with-bounding-rectangle* (left top right bottom) (sheet-region pane)
-      (declare (ignore right bottom))
-      (draw-gadget-label pane medium left top
-			 :align-x (gadget-alignment pane) :align-y :top))))
 
 
 ;;; Separator panes
diff --git a/silica/db-label.lisp b/silica/db-label.lisp
new file mode 100644
index 00000000..efeca135
--- /dev/null
+++ b/silica/db-label.lisp
@@ -0,0 +1,100 @@
+;; -*- mode: common-lisp; package: silica -*-
+;;
+;;				-[]-
+;; 
+;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
+;; copyright (c) 1986-1992 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 FAR
+;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
+;; applicable.
+;;
+;; $fiHeader$
+
+(in-package :silica)
+
+(defclass generic-label-pane 
+	  (label-pane
+	   space-requirement-mixin
+	   leaf-pane)
+    ()
+  (:default-initargs :align-x :left
+		     :text-style *default-label-text-style*))
+
+(defmethod compose-space ((pane generic-label-pane) &key width height)
+  (declare (ignore width height))
+  (multiple-value-bind (width height)
+      (compute-gadget-label-size pane)
+    (make-space-requirement :width width :height height)))
+  
+(defmethod handle-repaint ((pane generic-label-pane) region)
+  (declare (ignore region))			;not worth checking
+  (with-sheet-medium (medium pane)
+    (with-bounding-rectangle* (left top right bottom) (sheet-region pane)
+      (declare (ignore right bottom))
+      (draw-gadget-label pane medium left top
+			 :align-x (gadget-alignment pane) :align-y :top))))
+
+(defmethod compute-gadget-label-size ((pane labelled-gadget-mixin))
+  (let ((label (gadget-label pane)))
+    (etypecase label
+      (string
+	(let ((text-style (slot-value pane 'text-style)))
+	  (with-sheet-medium (medium pane)
+	    (multiple-value-bind (width height)
+		(text-size medium label :text-style text-style)
+	      (values (+ width (text-style-width text-style medium))
+		      (+ height (floor (text-style-height text-style medium) 2)))))))
+      (null (values 0 0))
+      (pattern
+	(values (pattern-width label) (pattern-height label)))
+      (pixmap
+	(values (pixmap-width label) (pixmap-height label))))))
+
+(defmethod draw-gadget-label ((pane labelled-gadget-mixin) medium x y
+			      &key (align-x (gadget-alignment pane))
+				   (align-y :baseline))
+  (let ((label (gadget-label pane)))
+    (etypecase label
+      (string
+	(let ((text-style (slot-value pane 'text-style)))
+	  (draw-text* medium label x y
+		      :text-style text-style
+		      :align-x align-x :align-y align-y)))
+      (null)      
+      (pattern
+	(let ((width (pattern-width label))
+	      (height (pattern-height label)))
+	  (ecase align-x
+	    (:left)
+	    (:right (decf x width))
+	    (:center (decf x (floor width 2))))
+	  (ecase align-y
+	    ((:top :baseline))
+	    (:bottom (decf x height))
+	    (:center (decf x (floor height 2))))
+	  (draw-pattern* medium label x y)))
+      (pixmap
+	(let ((width (pixmap-width label))
+	      (height (pixmap-height label)))
+	  (ecase align-x
+	    (:left)
+	    (:right (decf x width))
+	    (:center (decf x (floor width 2))))
+	  (ecase align-y
+	    ((:top :baseline))
+	    (:bottom (decf x height))
+	    (:center (decf x (floor height 2))))
+	  (copy-from-pixmap label 0 0 width height
+			    medium x y))))))
diff --git a/silica/db-layout.lisp b/silica/db-layout.lisp
index b5a8b4f0..bd96f575 100644
--- a/silica/db-layout.lisp
+++ b/silica/db-layout.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-layout.lisp,v 1.30 93/03/19 09:44:36 cer Exp $
+;; $fiHeader: db-layout.lisp,v 1.31 93/03/31 10:39:31 cer Exp $
 
 (in-package :silica)
 
@@ -90,7 +90,7 @@
 
 (defvar *inside-changing-space-requirements* nil)
 
-(defun invoke-with-changing-space-requirements (continuation &key resize-frame layout)
+(defun invoke-with-changing-space-requirements (continuation &key resize-frame (layout t))
   (let ((old-inside-changing-space-requirements 
 	  *inside-changing-space-requirements*)
 	(*inside-changing-space-requirements* 
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 80b08781..cb1c399b 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.48 93/03/31 10:39:36 cer Exp $
+;; $fiHeader: gadgets.lisp,v 1.49 93/04/08 13:18:00 colin Exp $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -161,58 +161,7 @@
 	(format stream "~A" (slot-value object 'label)))
       (call-next-method)))
 
-(defmethod compute-gadget-label-size ((pane labelled-gadget-mixin))
-  (let ((label (gadget-label pane)))
-    (etypecase label
-      (string
-	(let ((text-style (slot-value pane 'text-style)))
-	  (with-sheet-medium (medium pane)
-	    (multiple-value-bind (width height)
-		(text-size medium label :text-style text-style)
-	      (values (+ width (text-style-width text-style medium))
-		      (+ height (floor (text-style-height text-style medium) 2)))))))
-      (null (values 0 0))
-      (pattern
-	(values (pattern-width label) (pattern-height label)))
-      (pixmap
-	(values (pixmap-width label) (pixmap-height label))))))
-
-(defmethod draw-gadget-label ((pane labelled-gadget-mixin) medium x y
-			      &key (align-x (gadget-alignment pane))
-				   (align-y :baseline))
-  (let ((label (gadget-label pane)))
-    (etypecase label
-      (string
-	(let ((text-style (slot-value pane 'text-style)))
-	  (draw-text* medium label x y
-		      :text-style text-style
-		      :align-x align-x :align-y align-y)))
-      (null)      
-      (pattern
-	(let ((width (pattern-width label))
-	      (height (pattern-height label)))
-	  (ecase align-x
-	    (:left)
-	    (:right (decf x width))
-	    (:center (decf x (floor width 2))))
-	  (ecase align-y
-	    ((:top :baseline))
-	    (:bottom (decf x height))
-	    (:center (decf x (floor height 2))))
-	  (draw-pattern* medium label x y)))
-      (pixmap
-	(let ((width (pixmap-width label))
-	      (height (pixmap-height label)))
-	  (ecase align-x
-	    (:left)
-	    (:right (decf x width))
-	    (:center (decf x (floor width 2))))
-	  (ecase align-y
-	    ((:top :baseline))
-	    (:bottom (decf x height))
-	    (:center (decf x (floor height 2))))
-	  (copy-from-pixmap label 0 0 width height
-			    medium x y))))))
+
 
 
 ;;--- We might want a way of changing the range and the value together.
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index 334c6294..fe9e16db 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: mirror.lisp,v 1.28 92/10/02 15:18:29 cer Exp $
+;; $fiHeader: mirror.lisp,v 1.29 93/02/08 15:57:34 cer Exp $
 
 (in-package :silica)
 
@@ -366,7 +366,9 @@
 	 (parent (sheet-parent sheet))
 	 (sheet-to-parent (sheet-transformation sheet))
 	 (parent-to-native (sheet-native-transformation parent))
-	 (region-changed-p nil)
+	 ;;-- What does this really mean. Surely something has changed
+	 ;;-- then we should propagate stuff down [clim2bug376]
+	 (region-changed-p (always-propagate-region-changes-p sheet))
 	 (transformation-changed-p nil))
     ;; Sheet in parent space
     (multiple-value-bind (ominx ominy omaxx omaxy)
@@ -412,6 +414,9 @@
 	(when transformation-changed-p
 	  (note-sheet-transformation-changed sheet :port-did-it t))))))
 
+(defmethod always-propagate-region-changes-p ((sheet mirrored-sheet-mixin))
+  nil)
+
 (defmethod handle-event ((sheet mirrored-sheet-mixin)
 			 (event window-configuration-event))
   (mirror-region-updated (port sheet) sheet)
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index ca669111..06d1bec7 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.36 93/03/04 19:01:15 colin Exp $
+;; $fiHeader: sysdcl.lisp,v 1.38 93/04/16 09:26:26 layer Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :cl-user)
 
@@ -191,6 +191,8 @@
   ("db-scroll")
   ("scroll-pane")
   ("db-button")
+  ("db-label"
+   :load-before-compile ("db-border"))
   ("db-slider"))
 
 (clim-defsys:defsystem clim-standalone
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index bc84c504..7d170c41 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.70 93/04/02 13:37:26 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.71 93/04/07 09:07:22 cer Exp $
 
 (in-package :xm-silica)
 
@@ -869,6 +869,9 @@
                                    basic-pane)
           ())
 
+(defmethod silica::always-propagate-region-changes-p ((sheet xm-frame-viewport-mixin))
+  t)
+
 (defclass xm-frame-viewport (xm-frame-viewport-mixin) ())
 
 (defmethod find-widget-class-and-initargs-for-sheet
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 9f30d583..a961d364 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.41 93/03/01 14:26:28 cer Exp $
+;; $fiHeader: resources.lisp,v 1.43 93/04/16 09:26:38 layer Exp $
 
 (in-package :tk)
 
@@ -690,3 +690,8 @@
 					  (:etched-out 6) 
 					  (:in 7)
 					  (:out 8)))
+
+
+(define-enumerated-resource ol-wrap-mode  ((:wrap-off 74) 
+					   (:wrap-any 75)
+					   (:wrap-white-space 76)))
-- 
GitLab