diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp index 926bec3d339324687cd9549543d95cb72391fff2..53447fd917d5c5afdbec3a362a93453469aa60e9 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 48521a6975677fa3e866d84bf9f993ed6936e78e..3d01f68ff4ad4be5345f522cc94a1ec50f4435ac 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 278941c901420f68973278418abf7143f9aca1fd..a2b7c29365bca761955a93bde044ef64f7ff49a4 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 0000000000000000000000000000000000000000..efeca13529e0f4f89350641cfd77039c6931ced1 --- /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 b5a8b4f06ee7b7af160fc18e18e4d433fd7ed17c..bd96f5758e43588d4990c70e880f8177fd02a58d 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 80b087819dcaad6df4c866e77c72fa1dc0f50cdb..cb1c399b40ea7559592d18d01afa410fd4a8ef25 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 334c6294c9073fb96e59eebe285a3a3a9cba1ee4..fe9e16db5e79332e8c489f46e72c9eabda4cf8e5 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 ca6691114c22e8735c53621cb71c7e962a834b93..06d1bec7272e4cfe117cd7cc18055b61c1fbcbba 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 bc84c504a57185034bebd5463b447a1a54c0d4d2..7d170c418e52e586825fcb1c901ffaee2a81dae1 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 9f30d5832ce2ee0eaf95b4c0c3c80d818423ec40..a961d3642d441f56f467fb70196c58546a5941e9 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)))