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))