[mcclim-devel] Title panes

[Robert Swindells]

Robert Strandh wrote:
>Robert Swindells writes:
> > 
> > There doesn't seem to be a display-title method for the title-pane
> > class, is this deliberate ?
>
>I can only guess.  The spec says very little about the title pane.  It
>doesn't even mention any :initarg or a slot that can be used to give a
>title.  It does mention the name of the display function, but doesn't
>say anything else about it.  That's probably the reason nobody
>implemented it.  
>
> > The examples in the Franz CLIM User Guide imply to me that you should
> > be able to use this pane type without needing to supply a
> > display-function for it.
>
>It should not be very hard to do this.  If you can give me some
>examples of how to use it and what is supposed to happen when the
>title pane is displayed, or better yet, some code, I'll be happy to
>put it in. 

The following patch works well enough for me to see something:

It might need a bounding box and the Franz example looks as if the
text may need to be larger than the default size.

Index: panes.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/panes.lisp,v
retrieving revision 1.197
diff -u -r1.197 panes.lisp
--- panes.lisp  1 Aug 2009 22:11:06 -0000       1.197
+++ panes.lisp  6 Oct 2009 23:21:01 -0000
@@ -2741,11 +2741,22 @@
 ;;; TITLE PANE
 
 (defclass title-pane (clim-stream-pane)
-  ()
+  ((display-string :initarg :display-string
+                  :accessor display-string))
   (:default-initargs :display-time t
                      :scroll-bars nil
                      :display-function 'display-title))
 
+(defmethod display-title (frame (pane title-pane))
+  (declare (ignore frame))
+  (let ((a (text-style-ascent (pane-text-style pane) pane))
+       (tw (text-size pane (display-string pane))))
+    (with-bounding-rectangle* (x1 y1 x2 y2) (sheet-region pane)
+      (multiple-value-bind (tx ty)
+         (values (- (/ (- x2 x1) 2) (/ tw 2))
+                 (+ y1 2 a))
+         (draw-text* pane (display-string pane) tx ty)))))
+
 ;;; Pointer Documentation Pane
 
 (defparameter *default-pointer-documentation-background* +black+)