[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

pop-up-menus



pop-up-menus who display current selection don't seem to be doing a good
job of showing the selected-item.

Here is a patch that will show the selected item in full.  Be warned that
it does override the dialog-item-size, if needed.

BTW;  It seems that quite regularly when messing with text in dialog-items
one has to use (or (view-font view) (view-font (view-window view)))...

Suggestion:  define the view-font method for a dialog-item to do this...
[probably should check that view-window is a view first, of course]

#|
;;;;patch size-rectangles for pop-up-menu
(defmethod ccl::size-rectangles ((menu pop-up-menu))
  "does a lot of tweaking to get the thing to draw right"
  (let* ((my-pos (view-position menu))
         (my-size (add-points (view-size menu) #@(-1 -1)))
         (text (dialog-item-text menu))
         (font (or (view-font menu) (view-font (view-window menu))))
         (title-offset (make-point (if (eql 0 (length text))
                                     0
                                     (+ 8 (string-width text font)))
                                   0))
         (selected (selected-item menu))
         (sel-title (when selected (menu-item-title selected)))
         (sel-width (when sel-title (string-width sel-title font)))
         (sel-offset (add-points title-offset (make-point (+ 24 sel-width)
(point-v my-size))))
         (menu-rect (or (ccl::pop-up-menu-rect menu)
                        (setf (ccl::pop-up-menu-rect menu) (make-record
:rect))))
         (title-rect (or (ccl::pop-up-menu-title-rect menu)
                         (setf (ccl::pop-up-menu-title-rect menu)
                               (make-record :rect)))))
    (rset menu-rect :rect.topleft (add-points my-pos title-offset))
    (rset menu-rect :rect.bottomright (add-points my-pos my-size))
    (when sel-width (rset menu-rect :rect.bottomright (add-points my-pos
sel-offset)))
    (rset title-rect :rect.topleft my-pos)
    (rset title-rect :rect.bottomright (make-point (+ (point-h my-pos)
                                                      title-offset)
                                                   (+ (point-v my-pos)
                                                      (point-v my-size)
                                                      -4)))))
|#

"TANSTAAFL" Rich lynch@ils.nwu.edu