The menu-recompute-geometry function (shown in the
following example) handles the job of calculating the size of the menu,
based on its current item list and its current text font. CLX provides
a way to inquire the geometrical properties of a font object (for
example, its ascent and descent from the baseline) and also a text-extents
function.
text-extents returns the geometry of a given string as
displayed in a given font. Notice the use of the with-state
macro when setting a window's geometry attributes. CLX strives to
preserve the familiar setf style of accessing individual window
attributes, even though an attribute access actually involves sending a
request to a (possibly remote) server and/or waiting for a reply. with-state
tells CLX to batch together all read and write accesses to a given
window, using a local cache to minimize the number of server requests.
This CLX feature can result in a dramatic improvement in client
performance without burdening the programmer interface.
menu-recompute-geometry causes all the item subwindows to
become mapped. Mapping a window means attempting to make it
visible on the screen. However, a subwindow will not actually be
visible until it and all of its ancestors are mapped. Even then,
another window might be covering up the subwindow.
(defun menu-recompute-geometry (menu)
(when (menu-geometry-changed-p menu)
(let* ((menu-font (GCONTEXT-FONT (menu-gcontext menu)))
(title-width (TEXT-EXTENTS menu-font (menu-title menu)))
(item-height (+ (FONT-ASCENT menu-font)
(FONT-DESCENT menu-font)
*menu-item-margin*))
(item-width 0)
(items (menu-item-alist menu))
menu-width)
;; Find max item string width
(setf item-width
(+ *menu-item-margin*
(dolist (next-item items item-width)
(setf item-width (max item-width
(TEXT-EXTENTS menu-font (second next-item)))))))
;; Compute final menu width, taking margins into account
(setf menu-width (max title-width (+ item-width *menu-item-margin*)))
(let ((window (menu-window menu)))
;; Update width and height of menu window
(WITH-STATE (window)
(setf (DRAWABLE-WIDTH window) menu-width
(DRAWABLE-HEIGHT window) (* (1+ (length items)) item-height)))
;; Update width, height, position of item windows
(let ((item-left (round (- menu-width item-width) 2))
(next-item-top (- item-height (round *menu-item-margin* 2))))
(dolist (next-item items)
(let ((window (first next-item)))
(WITH-STATE (window)
(setf (DRAWABLE-HEIGHT window) item-height
(DRAWABLE-WIDTH window) item-width
(DRAWABLE-X window) item-left
(DRAWABLE-Y window) next-item-top)))
(incf next-item-top item-height))))
;; Map all item windows
(MAP-SUBWINDOWS (menu-window menu))
;; Save item geometry
(setf (menu-item-width menu) item-width
(menu-item-height menu) item-height
(menu-width menu) menu-width
(menu-title-width menu) title-width
(menu-geometry-changed-p menu) nil))))
Of course, the sample client must know how to draw/redraw the menu and
its items, so the function menu-refresh is defined next to
handle that task (shown in the following example). Note that the
location of window output is given relative to the window origin.
Windows and subwindows have different coordinate systems. The location
of the origin (upper-left corner) of a subwindow's coordinate
system is given with respect to its parent window's coordinate
system. Negative coordinates are valid, although only output to the
+x/+y quadrant of a window's coordinate system will ever be visible.
(defun menu-refresh (menu)
(let* ((gcontext (menu-gcontext menu))
(baseline-y (FONT-ASCENT (GCONTEXT-FONT gcontext))))
;; Show title centered in "reverse-video"
(let ((fg (GCONTEXT-BACKGROUND gcontext))
(bg (GCONTEXT-FOREGROUND gcontext)))
(WITH-GCONTEXT (gcontext :foreground fg :background bg)
(DRAW-IMAGE-GLYPHS
(menu-window menu)
gcontext
(round (- (menu-width menu)
(menu-title-width menu)) 2) ;start x
baseline-y ;start y
(menu-title menu))))
;; Show each menu item (position is relative to item window)
(let ((box-margin (round *menu-item-margin* 2)))
(dolist (item (menu-item-alist menu))
(DRAW-IMAGE-GLYPHS
(first item) gcontext
box-margin ;start x
(+ baseline-y box-margin) ;start y
(second item))))))
with-gcontext is a CLX macro that allows you temporarily to modify a graphics context within the dynamic scope of the macro body. draw-image-glyphs is a CLX text drawing function which produces a terminal-like rendering: foreground character on a background block. (More sophisticated text rendering functions are also available.) The strange use of glyphs instead of string here actually highlights an important fact: X and Common Lisp have totally different concepts of a character. A Common Lisp character is an object whose implementation can comprehend a vast universe of text complexities (typefaces, type styles, international character sets, symbols, and so forth). However, to X, a string is just a sequence of integer indexes into the array of bitmaps represented by a CLX font object. In general, draw-image-glyphs , text-extents , and other CLX text functions accept a :translate keyword argument. Its value is a function which translates the characters of a string argument into the appropriate font-and-index pairs needed by CLX. This example relies upon the default translation function, which simply uses char-code to compute an index into the current font.