[beirc-cvs] CVS update: beirc/beirc.lisp

[Andreas Fuchs]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv18781

Modified Files:
	beirc.lisp 
Log Message:
fix the last known issue: redisplay now leaves a good-looking set of panes.

also, remove a lot of debug PRINT statements.

Date: Wed Sep 14 23:00:40 2005
Author: afuchs

Index: beirc/beirc.lisp
diff -u beirc/beirc.lisp:1.4 beirc/beirc.lisp:1.5
--- beirc/beirc.lisp:1.4	Wed Sep 14 22:31:44 2005
+++ beirc/beirc.lisp	Wed Sep 14 23:00:35 2005
@@ -66,18 +66,31 @@
       (pane :reader pane :initform nil)
       (focused-nicks :accessor focused-nicks :initform nil)))
 
+;;; KLUDGE: make-clim-application-pane doesn't return an application
+;;; pane, but a pane that wraps the application pane. we need the
+;;; application pane for redisplay, though.
+(defun actual-application-pane (pane)
+  "Find the actual clim:application-pane buried the layers and
+  layers of wrapping panes that make-clim-application-pane
+  returns."
+  (if (typep pane 'clim:application-pane)
+      pane
+      (loop for child in (sheet-children pane)
+            for found-pane = (actual-application-pane child)
+            if found-pane do (return found-pane))))
+
 (defmethod initialize-instance :after ((object receiver) &rest initargs)
   (declare (ignore initargs))
   (setf (slot-value object 'pane)
         (with-look-and-feel-realization
             ((frame-manager *application-frame*) *application-frame*)
-          (print (make-clim-application-pane
+           (make-clim-application-pane
                   :display-function
                   (lambda (frame pane)
                     (beirc-app-display frame pane object))
                   :display-time :command-loop
                   :width 400 :height 600
-                  :incremental-redisplay t) *debug-io*))))
+                  :incremental-redisplay t))))
 
 (defun make-receiver (name &rest initargs)
   (let ((receiver (apply 'make-instance 'receiver :name name initargs)))
@@ -383,13 +396,12 @@
   ;; Hack:
   ;; Figure out if we are scrolled to the bottom.
   (let* ((receiver (receiver event))
-         (pane (pane receiver)))    ; FIXME: pane isn't a stream pane, but a VRACK-PANE. gack.
+         (pane (actual-application-pane (pane receiver))))
     (let ((btmp (pane-scrolled-to-bottom-p pane)))
       (setf (pane-needs-redisplay pane) t)
-      (time (redisplay-frame-panes frame :force-p t))
-;;       (when btmp                       
-;;         (scroll-pane-to-bottom pane))
-      )
+      (time (redisplay-frame-pane frame pane))
+       (when btmp                       
+         (scroll-pane-to-bottom pane)))
     (medium-force-output (sheet-medium pane)) ;###
     ))
 
@@ -610,8 +622,6 @@
 (defun beirc-app-display (*application-frame* *standard-output* receiver)
   ;; Fix me: This usage of UPDATING-OUTPUT is sub-optimal and ugly!
   ;; Fix me: as is all that *standard-output* stuff
-  (print *standard-output* *debug-io*)
-  (print (pane receiver) *debug-io*)
   (let ((w (- (floor (bounding-rectangle-width (sheet-parent *standard-output*))
                      (clim:stream-string-width *standard-output* "X"))
               2))