[mcclim-devel] tow more patches

[Max-Gerd Retzlaff]

Hi,

here are two additional patches.

Bye,
Max

========================================================================


- :own-window of accepting-values is not implemented

  I've made a patch based on clim:open-window-stream. Consider it to be a
  quick and *dirty* hack. Look at the sleep..

 -- zipp --

--- dialog.lisp.~1.19.~ 2005-02-27 21:52:49.000000000 +0100
+++ dialog.lisp 2005-08-18 03:21:37.284609600 +0200
@@ -136,6 +136,30 @@
 
 (defvar *accepting-values-stream* nil)
 
+(defmacro with-stream-in-own-window ((&optional (stream '*query-io*)
+                                                &rest further-streams)
+                                     &rest body)
+  `(let* ((,stream (open-window-stream))
+          ,@(mapcar (lambda (a-stream)
+                      (list a-stream stream))
+                    further-streams))
+     (sleep 0.1) ;; hackhack.. some delay to "ensure" that the window-stream ist opened
+     (unwind-protect
+         (progn
+           , at body)
+       (close ,stream))))
+
 (defmacro accepting-values
     ((&optional (stream t)
       &rest args
@@ -144,17 +168,22 @@
            align-prompts label scroll-bars
            x-position y-position width height command-table frame-class)
      &body body)
-  (declare (ignorable own-window exit-boxes initially-select-query-identifier
+  (declare (ignorable exit-boxes initially-select-query-identifier
             modify-initial-query resynchronize-every-pass resize-frame
             align-prompts label scroll-bars
             x-position y-position width height command-table frame-class))
   (setq stream (stream-designator-symbol stream '*standard-input*))
   (with-gensyms (accepting-values-continuation)
+    (let ((return-form
     `(flet ((,accepting-values-continuation (,stream)
               , at body))
        (invoke-accepting-values ,stream
                                 #',accepting-values-continuation
-                                , at args))))
+                                , at args))
+            ))
+      (if own-window
+          `(with-stream-in-own-window (,stream *standard-input* *standard-output*) ,return-form)
+          return-form))))
 
 (defun invoke-accepting-values
     (stream body

 -- zapp --


========================================================================


- A patch to open-window-stream to be able to do modify the display-function
  of the created window-stream afterwards, as in:

  (let ((stream (open-window-stream)))
    (setf (slot-value stream 'climi::display-function)
          (lambda (frame pane)
            (declare (ignore frame))
            (write-string "foo" pane)))
    stream)
                   
  and not having to explicitly call (redisplay-frame-panes (pane-frame *) :force-p t)
  after changing the display function.

  The standalone-event-loop for open-window-stream is quite Spartan. The
  default-frame-top-level includes a call to redisplay-frame-panes with force (only
  for the first time) before calling simple-event-loop as well. I conclude that calling
  redisplay-frame-panes in open-window-stream is the right thing to do. 

  By the way, standard-event-loop is complete copy of simple-event-loop aside from
  two lines of code to handle FRAME-EXIT. Not very nice.

  Patch to panes.lisp

 - zipp -

--- panes.lisp.~1.153.~ 2005-06-24 01:12:42.000000000 +0200
+++ panes.lisp  2005-08-18 03:48:55.298593624 +0200
@@ -2591,6 +2596,8 @@
     #+clim-mp
     (unless input-buffer
       (clim-sys:make-process (lambda () (let ((*application-frame* frame))
+                                          (redisplay-frame-panes frame :force-p t)
                                           (standalone-event-loop)))))
     (slot-value frame 'stream)))

 - zapp -


========================================================================

-- 
Max-Gerd Retzlaff <m.retzlaff at gmx.net>

For your amusement:
My brother sent me a postcard the other day with this big satellite
photo of the entire earth on it. On the back it said: "Wish you were
here".
	        -- Steven Wright
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/mcclim-devel/attachments/20050818/92407b8f/attachment.sig>