display-title method for title-pane

Report from Robert Swindells

 affects mcclim
 status confirmed
 importance wishlist
 tag pane compatibility patch
 summary "display-title method for title-pane"
 done

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