with-output-as-gadget (was Re: [mcclim-devel] Missing realizerincall to MAKE-PANE-1)

Max-Gerd Retzlaff m.retzlaff at gmx.net
Sun Dec 25 20:49:08 UTC 2005


Hello

On Sun, Dec 25, 2005 at 10:57:09AM -0500, Paul Werkowski wrote:
> I think I have it!
> 
> Change the initialize-instance :after method  on gadget-output-record to just
> doing
> 
> (setf (gadget record) child)
> 
> and move the rest of the stuff in there to just after the call to
> stream-add-output-record in with-output-as-gadget.
>
> Seems to work for the cases I have tried. Maybe it will work for Max
> as well?

Yes, it's really better. Some of my tests and also Xophe's gadget-test
work now. But there is still a SIMPLE-ERROR
   "There is no applicable method for the generic function
   #<STANDARD-GENERIC-FUNCTION SHEET-NATIVE-TRANSFORMATION (6)> when
   called with arguments (NIL)."
for my example that has a WITH-OUTPUT-AS-GADGET inside an
ACCEPTING-VALUES..

Btw. I've attached a patch for my interpretation of the description
you've given for your changes..


There is a problem with the space requirement: I do my tests inside
the CLIM-Listener and the scrollbar gets larger than needed, or better
there is always some white space after the output-gadget (while its
size seems to be related to the size of the actual gadget). (But I've
just realized that I have a version of mcclim that is previous to
Gilbert's recent work on the scrollbars. (Shame on me.))

And if I call a test in a freshly started Listener the output-gadget
will always displayed in the top left corner of the Listener's
application pane. Only if the first screen is "full" (that is the
scrollbar gets actually useful) it will be displayed *after* the
prompt (while it does not scroll past the gadget). Even a second or
third output-gadget will be displayed in the top left corner on top of
the previous gadgets, if the application pane does not yet scroll.

I hope these confused descriptions are not too hard to understand.
Thank you,
Max

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

For your amusement:
Gravity is a myth, the Earth sucks.

-------------- next part --------------
--- gadgets.lisp__before-Paul-Werkowski	2005-12-25 21:43:55.957060368 +0100
+++ gadgets.lisp	2005-12-25 21:46:55.621747184 +0100
@@ -2742,13 +2742,8 @@
 (defclass gadget-output-record (basic-output-record displayed-output-record)
   ((gadget :initarg :gadget :accessor gadget)))
 
-(defmethod initialize-instance :after ((record gadget-output-record) &key child x y)
-  (let* ((sr (compose-space child))
-         (width  (space-requirement-width sr))
-         (height (space-requirement-height sr)))
-    (allocate-space child width height)
-    (setf (gadget record) child
-          (rectangle-edges* record) (values x y (+ x width) (+ y height)))))
+(defmethod initialize-instance :after ((record gadget-output-record) &key child)
+  (setf (gadget record) child))
 
 (defmethod note-output-record-got-sheet ((record gadget-output-record) sheet)
   (multiple-value-bind (x y)  (output-record-position record)
@@ -2801,6 +2796,11 @@
               (,gadget-output-record (make-instance 'gadget-output-record
                                                     :child ,gadget :x (round ,x) :y (round ,y))))
          (stream-add-output-record ,stream ,gadget-output-record)
+         (let* ((sr (compose-space ,gadget))
+                (width  (space-requirement-width sr))
+                (height (space-requirement-height sr)))
+           (allocate-space ,gadget width height)
+           (setf (rectangle-edges* ,gadget-output-record) (values ,x ,y (+ ,x width) (+ ,y height))))
          (setup-gadget-record ,stream ,gadget-output-record (round ,x) (round ,y))
          (values ,gadget ,gadget-output-record)))))
 
-------------- 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/20051225/ff0c176c/attachment.sig>


More information about the mcclim-devel mailing list