diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp index e5b513a8b4af439412b4fe0d0de53d75e27936e4..ab3ede9f1ae903c0dcdd150aeca4a73c5a3554a6 100644 --- a/clim/excl-presentations.lisp +++ b/clim/excl-presentations.lisp @@ -21,13 +21,25 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: excl-presentations.lisp,v 1.13 92/09/30 18:03:43 cer Exp $ +;; $fiHeader: excl-presentations.lisp,v 1.14 92/10/28 11:31:34 cer Exp $ (in-package :clim-internals) +(defmacro with-excl-presentations ((stream &optional (state t)) &body body) + `(flet ((with-excl-presentations-body (,stream) + ,@body)) + (declare (dynamic-extent #'with-excl-presentations-body)) + (invoke-with-excl-presentations ,stream ,state #'with-excl-presentations-body))) + + +(defmethod invoke-with-excl-presentations (stream state continuation) + (letf-globally (((stream-excl-recording-p stream) state)) + (funcall continuation stream))) + (defmethod excl::stream-recording-p ((stream output-recording-mixin)) - (stream-recording-p stream)) + (and (stream-recording-p stream) + (stream-excl-recording-p stream))) (defmethod excl::stream-io-record-type ((stream output-recording-mixin)) nil) diff --git a/clim/histories.lisp b/clim/histories.lisp index 0be63208b15aeddf7442c0f4fed8aa96f84c62da..4b90eb0cd6a8d2a98baf688a46dfbe5902d1a355 100644 --- a/clim/histories.lisp +++ b/clim/histories.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: histories.lisp,v 1.14 92/12/03 10:26:51 cer Exp $ +;; $fiHeader: histories.lisp,v 1.15 92/12/14 15:02:10 cer Exp $ (in-package :clim-internals) @@ -571,7 +571,7 @@ (write-string "(End of history.)" stream)) (t (with-output-as-presentation (stream - (list history max-displayed-index nil) + (list history max-displayed-index nil stream) 'display-rest-of-history) (format stream "(~D more item~:P in history.)" (- current-length max-displayed-index))))))) diff --git a/clim/stream-class-defs.lisp b/clim/stream-class-defs.lisp index a8a11f113d0efa2b5733855558cb42b7a075664e..12125ee43c806914fd626b876e7014ebf561e746 100644 --- a/clim/stream-class-defs.lisp +++ b/clim/stream-class-defs.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: stream-class-defs.lisp,v 1.10 92/09/08 15:18:35 cer Exp Locker: cer $ +;; $fiHeader: stream-class-defs.lisp,v 1.11 92/09/30 11:45:05 cer Exp $ (in-package :clim-internals) @@ -68,8 +68,14 @@ #+Allegro ;; Support for allegro presentations (excl-presentation-stack :initform nil - :accessor stream-excl-presentation-stack)) + :accessor + stream-excl-presentation-stack) + #+Allegro + (excl-recording-p :accessor stream-excl-recording-p + :initform nil + :initarg :excl-recording-p)) (:default-initargs :draw-p t :record-p t ;!!! + :output-record (make-instance 'standard-tree-output-history))) diff --git a/clim/stream-defprotocols.lisp b/clim/stream-defprotocols.lisp index 40348a0469c6d315a1f9e858038c95812513eff2..caf6dec94f85172eec60d271b35942b8e81d3b80 100644 --- a/clim/stream-defprotocols.lisp +++ b/clim/stream-defprotocols.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: stream-defprotocols.lisp,v 1.13 92/11/18 15:44:49 colin Exp $ +;; $fiHeader: stream-defprotocols.lisp,v 1.14 92/12/03 10:27:53 cer Exp $ (in-package :clim-internals) @@ -92,7 +92,9 @@ stream-input-buffer stream-pointers stream-primary-pointer - stream-text-cursor) + stream-text-cursor + stream-read-gesture-cursor-state + ) (defoperation stream-read-gesture basic-extended-input-protocol ((stream basic-extended-input-protocol) diff --git a/demo/listener.lisp b/demo/listener.lisp index cbc6ffc6276c7ed4484e8db44ecbc3f5ec1b77b7..218942abe2a22b13a3407c20c27b06e7363f1845 100644 --- a/demo/listener.lisp +++ b/demo/listener.lisp @@ -1,20 +1,21 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: listener.lisp,v 1.27 92/12/14 15:02:40 cer Exp $ +;; $fiHeader: listener.lisp,v 1.28 92/12/16 16:47:41 cer Exp $ (in-package :clim-demo) "Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." (define-application-frame lisp-listener () - () + () (:command-table (lisp-listener :inherit-from (user-command-table))) (:command-definer t) (:menu-bar nil) (:top-level (lisp-listener-top-level)) (:panes - (interactor :interactor - :scroll-bars :both)) + (interactor :interactor + #+allegro :excl-recording-p #+allegro t + :scroll-bars :both)) (:layouts (default interactor))) (defmethod frame-maintain-presentation-histories ((frame lisp-listener)) t) diff --git a/silica/layout.lisp b/silica/layout.lisp index 99fe1a5731a89ae9d4950aa87267deab4bc7e73d..e14a686ba9c8df6cec15f149d1ce4b222429e62d 100644 --- a/silica/layout.lisp +++ b/silica/layout.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: layout.lisp,v 1.27 92/09/30 11:44:39 cer Exp Locker: cer $ +;; $fiHeader: layout.lisp,v 1.28 92/10/02 15:18:26 cer Exp $ (in-package :silica) @@ -150,7 +150,9 @@ (let ((owidth (- right left)) (oheight (- bottom top))) (if (or (and width (/= owidth width)) - (and height (/= oheight height))) + (and height (/= oheight height)) + #+Allegro + (mirror-needs-resizing-p sheet width height)) ;; It should be safe to modify the sheet's region, since ;; each sheet gets a fresh region when it is created (let ((region (sheet-region sheet))) @@ -163,6 +165,24 @@ ;;--- I guess we do not want to do this always but ... (allocate-space sheet owidth oheight)))))) +;;;-- This sucks but it seems to get round the problem of the mirror +;;;-- geometry being completely wrong after the layout has been changed + +#+Allegro +(defmethod mirror-needs-resizing-p ((sheet sheet) width height) + (declare (ignore width height)) + nil) + + +#+Allegro +(defmethod mirror-needs-resizing-p ((sheet mirrored-sheet-mixin) width height) + (and (sheet-direct-mirror sheet) + (multiple-value-bind (left top right bottom) + (mirror-region* (port sheet) sheet) + (or (/= width (- right left)) + (/= height (- bottom top)))))) + + (defmethod move-sheet ((sheet basic-sheet) x y) (let ((transform (sheet-transformation sheet))) (multiple-value-bind (old-x old-y)