




               Programming With CLUE: An Extended Example






                             Kerry Kimbrough




                               Version 7.0
                             September, 1989





           Copyright (C) 1989 Texas Instruments Incorporated.                
                                                                                     
    Permission is granted to any individual or institution to use, copy,
    modify, and distribute  this document,  provided that  this complete
    copyright  and  permission  notice  is  maintained,  intact,  in all
    copies.
                                                                                     
    Texas  Instruments  Incorporated  provides  this  document   "as is"
    without express or implied warranty.




This document contains detailed examples of CLUE programming, all  based
on a  simple  CLUE  program  and  the  set  of  contact  classes used to
implement it.   Complete  sources  for  these  examples  may be found in
clue/examples/menu.l Some of the functions used are defined by CLX,  the
basic Common Lisp interface to the X Window System.

The  example  "application"  program  presents  a  simple  pop-up   menu
consisting of a column of strings: a title string followed by selectable
menu items.  The  application program  itself relies  upon the following
two types of contacts.

button
    A pointer-sensitive  area  containing  a  text  label.   Moving  the
    pointer cursor onto  a button  causes it  to be  highlighted with  a
    rectangular border.  If the pointer cursor is inside a button,  then
    clicking any  pointer  button  will  cause  the button contact to be
    selected.  That is, the :select callback of the button is invoked.

menu
    A shell contact which  contains a column  of buttons.  A  menu shell
    automatically  fills  in  its  content  with  a  title-frame,  which
    provides a  menu  title  string;  and  a  choices  composite,  which
    arranges and controls the selectable button items.  When an item has
    been selected, a menu automatically "pops down" and then invokes its
    own :select callback.


In order  to  implement  menu  and  button contacts, three other contact
classes are shown.

title-frame
    A special  composite  which  labels  its  single  child with a title
    string.

choices
    A collection  of  items  for  selection.   Each  child  of a choices
    composite is regarded  as a  selectable item.   Therefore, a choices
    automatically defines a  :select callback  function for  each of its
    children.  This callback allows a choices composite to report when a
    child has been selected and to record the selected child  for future
    reference.

column
    A geometry manager composite which arranges its children in a single
    vertical column and  ensures that  all children  have the same size.
    The choices class is a subclass of column that uses  column geometry
    management to lay out selectable items.


1. Writing A CLUE Application

The complete  application  program  is  the function just-say-lisp shown
below.  just-say-lisp has the typical  structure of a CLUE  application,
consisting of four steps.
        
    1. Open a connection to an X display server and create a
       contact-display.

    2. Initialize the user interface by creating a set of contacts.

    3. Enter an event loop to process user input.

    4. Terminate by leaving the event loop, destroying all contacts and
       closing the display server connection.


(defun just-say-lisp (host &optional (font-name "fg-16"))
  (let* ((display   (open-contact-display 'just-say-lisp :host host))
         (screen    (contact-screen (display-root display)))
         (fg-color  (screen-black-pixel screen))
         (bg-color  (screen-white-pixel screen))

         ;; Create menu
         (menu      (make-contact
                      'menu
                      :parent     display
                      :font       font-name
                      :title      "Please pick your favorite language:"
                      :foreground fg-color
                      :background bg-color))
         (menu-mgr  (menu-manager menu)))    
    
    ;; Create menu items
    (dolist (label '("Fortran" "APL" "Forth" "Lisp"))
      (make-contact
        'button
        :parent     menu-mgr
        :label      label
        :foreground fg-color))
       
    ;; Bedevil the user until he picks a nice programming language
    (unwind-protect
        (loop
          ;; Pop up menu at current pointer position
          (multiple-value-bind (x y) (query-pointer (contact-parent menu))
            (let ((choice (menu-choose menu x y)))
              (when (string-equal "Lisp" choice)
                (return)))))      

      (close-display display))))


1.1. Creating A Contact Display

The open-contact-display function creates a connection to the  X display
server named by the :host argument.  A contact-display representing this
connection is returned.

  (let* ((display   (open-contact-display 'just-say-lisp :host host))
         (screen    (contact-screen (display-root display)))
         (fg-color  (screen-black-pixel screen))
         (bg-color  (screen-white-pixel screen))

The only required  argument to  open-contact-display is  a display  name
symbol (for example, just-say-lisp).  This symbol  acts as a name for  a
specific server  connection.   However,  since  an application typically
uses only a single contact-display, the display name generally serves as
a name for the  entire application.  As  an application name,  a display
name is used primarily as a top-level component in resource names.   See
Section 5.1 for examples of how resources are used.  A display name  may
also be used by  a window manager  client.  For example,  the name of  a
contact-display is used to initialize the :wm_class property of all  its
shells; some window managers may choose to show this property in  window
title bars.   Some  window  managers  may  also  allow  users to specify
application properties as  window manager  resources, using  the display
name as a component in resource names.

Several functions in CLUE and CLX operate on a contact-display  in order
to access various  attributes of  the display  server.  For example, the
display-root function returns a root contact corresponding to a  display
screen.  A  screen  object,  in  turn,  may  be  accessed  to  determine
screen-specific attributes (for example, the pixel values  corresponding
to black and white in the screen's default colormap).

1.2. Creating Contacts

The make-contact function is used to create an instance of  a particular
contact class.
         ;; Create menu
         (menu      (make-contact
                      'menu
                      :parent     display
                      :font       font-name
                      :title      "Please pick your favorite language:"
                      :foreground fg-color
                      :background bg-color))

make-contact has two  required arguments  --- the  name of contact class
(e.g.  menu) and  the parent  of the  new contact  (given by the :parent
keyword argument).  For convenience, a  contact-display may be given  as
the :parent; this is equivalent to setting the :parent  to (display-root
display).

If the :parent is a contact-display or a root, then the new contact will
be a "top-level contact." All top-level contacts should be instances  of
override-shell,  top-level-shell,  top-level-session,  or  one  of their
subclasses.   (In   the   example   above,   menu   is   a  subclass  of
override-shell.) These classes implement  the special behavior  required
of top-level  X  windows  in  order  to  interact  properly  with window
managers and  session  managers.   CLUE  does  not prevent programs from
creating a  non-shell  top-level  contact,  but  the  behavior  of  such
contacts may be unpredictable.

Other  arguments   to   make-contact   are   initargs   which initialize
class-specific attributes.  The  default values  for initargs  depend on
the implementation  of  the  contact  class.   Typically,  most initargs
correspond to contact  resources.  When  resource initargs  are omitted,
then a default value may be read from a resource database initialized by
an individual user.  A good  practice for application programmers  is to
minimize the number of initargs set in the program and thus to  increase
the ability  of  a  user  to  fine-tune  the user interface with his own
resource preferences.

Note that in the just-say-lisp example, the menu and button contacts are
created without initializing their position or size.  The reason is that
all contact geometry is computed  automatically.  The size and  position
of each button is determined partly by the font and string used for  its
label and  partly  by  the  geometry  management  policy provided by its
parent.  The button parent  returned by the  menu-manager function is  a
choices composite created automatically  by the menu  shell.  Similarly,
the size of  the menu  is determined  from the  size and  layout of  the
buttons it contains.



1.3. The Event Loop

In the main body of the just-say-lisp function, the menu-choose function
is called  repeatedly.   menu-choose  presents  the  menu at a specified
location, waits  for  the  user  to  make  a selection, then returns the
selected item.  The CLX function query-pointer is used to determine  the
current pointer position where the menu will appear.
 
        (loop
          ;; Pop up menu at current pointer position
          (multiple-value-bind (x y) (query-pointer (contact-parent menu))
            (let ((choice (menu-choose menu x y)))
              (when (string-equal "Lisp" choice)
                (return))))) 

menu-choose, which  contains  the  program  event  loop, is shown below.
Note that the event  loop is terminated  when an item  is selected by  a
throw to the :menu-selection tag.   add-callback is used to  program the
menu's :select callback to invoke the  throw.  This is done by  defining
the throw-menu-selection function as the :select callback function.

  (defun menu-choose (menu x y)
    "Present the MENU at the given location and return the label of the
  item chosen. If no item is chosen, then nil is returned."
  
    ;; Set menu callback to return chosen item label
    (add-callback menu :select 'throw-menu-selection menu)
  
    ;; Display the menu so that first item is at x,y.
    (menu-present menu x y)
  
    ;; Event processing loop
    (catch :menu-selection
      (loop (process-next-event (contact-display menu)))))
  
  
  (defun throw-menu-selection (menu)
    "Throw to :menu-selection tag, returning the label of the selected menu button (if any)."
    (let ((selection (choice-selection (menu-manager menu))))
      (throw :menu-selection
             (when selection (button-label selection)))))
  

Note that  another  program  could  change  many  aspects  of the menu's
behavior simply by defining a different :select callback function.   For
example, a menu selection  might cause another  function to be  executed
without exiting  the  event  loop.   Also,  the value corresponding to a
selected menu item  could be  computed differently,  rather than  simply
returning the item button label string.


1.4 Managing Contacts

menu-choose calls the function menu-present in order to display the menu
at a given location.

  (defun menu-present (menu x y)
    "Present the MENU with the first item centered on the given position."
    ;; Complete initial geometry management before positioning menu
    (unless (realized-p menu)
      (initialize-geometry menu))
  
    (let ((parent  (contact-parent menu))
          (item    (first (composite-children (menu-manager menu)))))
      
      ;; Compute the y position of the center of the first item
      ;; with respect to the menu
      (multiple-value-bind (item-x item-y)
          (contact-translate item 0 (round (contact-height item) 2) menu)
        (declare (ignore item-x))
  
        ;; Try to center first item at the given location, but
        ;; make sure menu is completely visible in its parent  
        (change-geometry
          menu
          :x (max 0 (min (- (contact-width parent) (contact-width menu))
                         (- x (round (contact-width menu) 2))))
          :y (max 0 (min (- (contact-height parent) (contact-height menu))
                         (- y item-y)))
          :accept-p t)))
    
    ;; Make menu visible
    (setf (contact-state menu) :mapped))


menu-present demonstrates  several  CLUE  features  used  by application
programmers to manage  contacts.  The  (setf contact-state)  function is
used   to   manage   the    menu's   visual   state.     The   functions
initialize-geometry  and   change-geometry   are   used  to  manage menu
geometry.

(setf contact-state) is the  function that changes  the visual state  of
the menu.  Setting the state to :mapped causes the menu to be  displayed
at its current position.  Actually, mapping the menu causes the X server
to  send  an   :exposure  event   for  the   menu.   Then,   inside  the
process-next-event loop, when CLUE receives this event, the menu display
method is called automatically.

change-geometry is  called  to  move  the  menu  to  the current pointer
position --- that is, to change the  x and y position of the  upper left
corner of the  menu.  change-geometry  actually requests  approval for a
geometry change  from  the  parent  of  the  menu.  The actual effect of
change-geometry depends  on  the  parent's  geometry  management policy.
Later examples describe  geometry management  in more  detail.  In  this
case, the :accept-p argument to change-geometry is true, indicating that
the new position determined by the parent's geometry management  will be
used.

initialize-geometry is a special function that is not used by most  CLUE
programs.    By   invoking    the   process    of   geometry management,
initialize-geometry causes the initial geometry for the menu and all  of
its descendants  to  be  computed  before  they  are  actually realized.
Ordinarily, initialize-geometry is  called automatically  just before  a
composite is realized;  realizing the  contact is  also a  step that  is
usually invoked automatically  just before  the event  loop begins.  But
the menu is a special case.  Why?

Note that in order for menu-present to pop up the menu over the  pointer
position, the initial  size of  the menu  must be  known before the menu
becomes :mapped.  Recall that the final menu size depends on the  number
of items, the  size of  the item  labels, etc.   and that  computing the
initial size  involves  geometry  management.   For  most contacts, this
initial geometry  management  can  be  performed automatically simply by
ensuring that  the  contact  is  "managed",  i.e.   neither  :mapped nor
:withdrawn.  But, because the menu is an instance of an  override-shell,
it cannot be  managed until  it :mapped.   What is  needed is  a way  to
compute the  initial  geometry  management  for  the  menu  before it is
managed.  That is the special purpose of initialize-geometry.  Note that
after the menu is realized, initialize-geometry is no longer necesssary.


1.5. Terminating the Program

The just-say-lisp program ends when  the user selects the  "right" item.
The CLX close-display function is called to close the connection to  the
X server.  This  also causes  the menu  and all  other server  resources
created for this display to be destroyed.

    (unwind-protect
        (loop
          ...
          )      

      (close-display display))

A good programming practice illustrated by just-say-lisp is to place the
event loop inside  an unwind-protect  form and  to include close-display
among the cleanup forms.  Without  this protection, an unexpected  error
could  cause  the  program  to  terminate  without  freeing  the  server
resources it has  created.  If  server resources  are repeatedly created
without being destroyed, then  the X server  will eventually run  out of
memory and fail.


2. Implementing A Menu

This section looks at the CLUE features used by a contact programmer  to
implement the menu contact class.

2.1 Defining a Contact Class

The menu  class  is  defined  by  a  defcontact form which specifies its
superclasses, its slots, and its resources.

    (defcontact menu (override-shell) ; A subclass of override-shell with...
      ()                              ; ...no additional slots, and...
      (:resources
        (font       :type     font)   ; ... class resources, and...
        (foreground :type     pixel)
        (title      :type     string)
           
        (state      :initform :withdrawn)) ; ...a different default state
      
      (:documentation
        "Presents a column of menu items."))

The syntax  of  defcontact  is  very  similar  to that of defclass.  The
difference lies in the resource specifications which are special to CLUE
contact classes.  Resource specifications declare contact initargs  that
can be initialized from a resource database.  For example, the  resource
specifications for  menu  mean  that  a  :font  initarg  can be given to
make-contact when creating a font and  that the default value for  :font
can found in the resource database.   The :type given for the  menu font
resource means that the :font  value will automatically be  converted to
the 'xlib:font  type.   Resource  type  conversion  involves the convert
function, which is discussed later.

A subclass also inherits resource specifications from its  superclasses.
In this case, the menu class inherits the state resource from the  basic
contact class but assigns it a  different default value of :withdrawn  .
In other words, a menu will not automatically become :mapped by  default
like most contacts (instead,  this is done  later by menu-present  after
the menu has been moved to the right position).  Note that to modify  an
inherited resource, it is  sufficient to list  only the changed  part of
its resource specification.

2.2. Class Initialization

The  initialize-instance   function   is   part   of  the  standard CLOS
initialization protocol invoked by  make-contact.  A contact  programmer
will typically define an :after method for initialize-instance in  order
to implement any class-specific initializations.  The :after method  for
the menu  class  creates  most  of  the  pieces used to construct a menu
automatically.  As  a  result,  application  programs  do not need to be
aware of the details of the menu contact hierarchy.

    (defmethod initialize-instance :after
      ((menu menu) &key title font foreground background &allow-other-keys)
      
      ;; Create title-frame containing choices child to manage menu items
      (let* ((title   (make-contact
                        'title-frame
                        :parent     menu
                        :name       :title
                        :text       title
                        :font       font
                        :foreground foreground
                        :background (or background :white)))
             
             (manager (make-contact
                        'choices
                        :parent       title
                        :name         :manager
                        :border-width 0)))
    
        ;; Define callback to handle effect of selection
        (add-callback manager :select 'popup-menu-select menu)
    
        ;; Moving pointer off menu causes nil selection
        (add-event manager
                   '(:leave-notify :ancestor :nonlinear)
                   '(choice-select nil))))
    
    
    
When a menu  is returned  from make-contact,  it contains  a title-frame
showing the menu  title.  In  turn, the  title-frame contains  a choices
composite known as the "menu manager".   Menu items are then created  by
adding children to this menu manager.  This hierarchy structure exploits
the power  of  CLOS  and  object-oriented  programming  to provide extra
implementation  modularity.   The  functions  for  title  display,  item
arrangement, and overall menu behavior are handled by separate  classes.
As a result, new types of menus to be implemented easily by substituting
new classes for each of these functions.

Two other aspects of the  menu are also initialized  here upon creation.
The menu-manager,  a  choices  composite,  uses  the :select callback to
signal when  a  user  has  selected  an  item.   Because  the menu class
implements a  pop-up  menu,  add-callback  is  called to initialize this
callback with a function that implements  the "pop down" side effect  of
selecting an item.  When the menu manager's :select callback is invoked,
the popup-menu-select function  withdraws the  menu before  invoking the
application function associated with the :select callback of the menu.

    (defmethod popup-menu-select ((menu menu))
      ;; Pop down immediately
      (setf (contact-state menu) :withdrawn)
      (display-force-output (contact-display menu))
    
      ;; Invoke menu callback
      (apply-callback menu :select))
    
In addition,  add-event  is  used  to  define  an event translation that
implements another aspect of pop menu behavior.  The details of defining
this event translation are shown in the next section.



2.3. Defining Event Translations

 
The following event translation, which is attached to the  menu manager,
causes the  manager's  choice-select  action  to  performed whenever the
pointer is moved outside the menu manager.

        ;; Moving pointer off menu causes nil selection
        (add-event manager
                   '(:leave-notify :ancestor :nonlinear)
                   '(choice-select nil))
   

The argument passed to the choice-select function is nil.  The item thus
selected is nil; that is, moving  the pointer off the menu  to disappear
without actually selecting an item  (see Section 4.2, The  Menu Manager,
for a description of of choice-select).   Note that this is an  instance
event translation that applies only to a specific menu manager instance.
An alternative might  have been  to use  defevent to  define this  event
translation for all instances of the choices class.  However, this would
assign "select nil when leaving" behavior to all choices contacts; using
an instance translation instead allows the same choices class to be used
in cases where this behavior is is not desirable.

Like any X window,  a contact must  select the types  of events that  it
wants to receive and process.  The event-mask slot contains a bit string
representing the  events  selected  for  a  contact.   But CLUE programs
rarely need to access the  event-mask directly.  For example,  this call
to add-event  automatically  updates  the  menu  manager's event-mask to
select :leave-notify events.

The event specification syntax  used here is  an extension to  the basic
event specifications provided by CLUE.  The extension defines a new type
of event specification  of the  form (:leave-notify  kind*), where  each
kind is a keyword identifying a kind of :leave-notify event.  This  type
of event specification will match a :leave-notify event if the event  is
one of the specified kinds.  A contact programmer creates this new  type
of event specification by defining a check function and a match functon.

    (defun leave-check (event-key &rest kinds)
      (dolist (kind kinds)
        (unless
          (member
            kind
            '(:ancestor :virtual :inferior :nonlinear :nonlinear-virtual))
          (error "~s isn't a valid kind of ~s event" kind event-key)))
      (list 'leave-match kinds))
    
    (defun leave-match (event kinds)
      (member (slot-value event 'kind) kinds :test #'eq))
    
    (setf (check-function :leave-notify) 'leave-check)

The check-function set for the :leave-notify event type  is leave-check.
The arguments to leave-check are the elements of the event-specification
list --- an event type keyword and a set of event kind keywords.   After
verifying that only  valid kinds  are specified,  leave-check returns  a
list containing the leave-match function and the "canonical form" of the
event specification.  Inside the event loop, leave-match will be  called
to compare an input event with this canonical form.  leave-match reports
a match when  the event  is a  :leave-notify event  of one  of the kinds
specified by the canonical event specification.


3. Implementing A Button

This section looks at the CLUE features used by a contact programmer  to
implement the button contact class.


3.1 Slot Resources

A button is a non-composite contact with a set of attributes represented
by slots --- a  text label plus  a font and  a foreground color  used to
draw the  label.   All  of  these  attribute  slots are also declared as
resources.  As a result, when an  instance of a button is  created, CLUE
automatically converts  values  given  for  these  resource slots to the
specified representation type.  This applies not only to initarg  values
given to make-contact but also to  default values found in the  resource
database or in  resource initforms.   For example,  the default initform
for the  font  slot  is  the  font  name  "fg-16"  which,  if  used,  is
automatically converted to  a font  object via  the open-font  function.
Similarly, the  default  foreground  value  of  :black  is automatically
converted to an appropriate pixel value using screen-black-pixel.   CLUE
defines a  number  of  built-in  convert  methods that can convert among
commonly-used representations for X objects like fonts, pixels, pixmaps,
and images.  Programmers are free  to extend this mechanism  by defining
their own convert methods.

    (defcontact button (contact)
      
      ((label
         :accessor   button-label
         :initarg    :label
         :initform   ""
         :type       string)
    
       (font
         :accessor   button-font
         :initarg    :font
         :initform   "fg-16"
         :type       font)
    
       (foreground
         :accessor   button-foreground
         :initarg    :foreground
         :initform   :black
         :type       pixel)
    
       (compress-exposures
         :allocation :class
         :initform   :on
         :reader     contact-compress-exposures
         :type       (member :off :on)))
      
      (:resources
        (background :initform :white)
        (border     :initform :white)
        font
        foreground
        label)
      
      (:documentation
        "Triggers an action."))


Notice also that several slots inherited from the base contact class are
given new  default  values  for  the  button  class.  The background and
border resources for buttons default to :white.  The  compress-exposures
slot  defaults  to  :on.   Thus,   :exposure  events  for  buttons   are
"compressed" ---  all  but  the  final  member  in  a sequence of button
:exposure events  are  discarded.   Why?   Because  displaying  a button
contact is  a  simple  matter  of  drawing  its  text  label, it is more
efficient to draw  the whole  string at  once than  it is  to draw  each
individual exposed piece.  event-compress is a class slot  and therefore
cannot be a resource;  its new default  value for the  button class must
therefore be  defined  in  a  slot  specification  instead of a resource
specification.

Of course,  class  resources  need  not  be  represented  as slots.  For
example, the defcontact form for  the menu class shown  earlier declares
non-slot  resources  for  font,  foreground  color,  and  title  string.
Non-slot  resources  values  are  contained  in  the  argument  list  to
initialize-instance.  As shown earlier for menu, non-slot resources  are
typically used in :after  methods for initialize-instance  to initialize
other components of a contact instance.


3.2 Displaying a Contact
    
Every class of contacts that contains something to display must define a
method for the display function.  CLUE automatically invokes this method
whenever an :exposure event for the contact is processed.  Some  contact
classes do  not  need  a  display  method.   For  example,  by  default,
composite  subclasses  do  not  receive  :exposure  events  because  all
displayable information is typically contained in the children.

The display  method  for  the  button  class  is  shown  below.  Because
:exposure events are compressed, this method displays the entire  button
contents and ignores the x, y, width, and height arguments which  define
the region exposed.
    
    (defmethod display ((button button) &optional x y width height &key)
      (declare (ignore x y width height))
      
      (with-slots
        (font label foreground (button-width width) (button-height height))
        button
        
        ;; Get metrics for label string
        (multiple-value-bind
          (label-width ascent descent left right font-ascent font-descent)
            (text-extents font label)
          (declare (ignore ascent descent left right))
    
          ;; Center label in button
          (let ((label-x (round (- button-width label-width) 2))
                (label-y (+ (round
                              (- button-height font-ascent font-descent)
                              2)
                            font-ascent)))
    
            ;; Use an appropriate graphics context from the cache
            (using-gcontext (gc :drawable   button
                                :font       font
                                :foreground foreground)
              (draw-glyphs button gc label-x label-y label))))))

Note that using-gcontext is used to find a graphics context  for drawing
the   label    characters.     using-gcontext    searches   a   cache of
previously-created gcontext objects, locates one with the given font and
foreground attributes, and binds  it to the  symbol gc for  use with the
draw-glyphs function  .   The  advantage  of  using-gcontext is that the
total  number  of  gcontext  objects  created  by  the  program  can  be
minimized.  Saving a gcontext with each button instance is not required,
and slots  are  allocated  only  for  the individual gcontext components
used.  The disadvantage of using-gcontext is that searching the gcontext
cache makes displaying somewhat slower.
    

3.3 Defining a Preferred Size

A button is  not a  composite and  therefore does  not act as a geometry
manager.  However, a  non-composite class  can play  a part  in geometry
management by defining  a preferred  size.  Some  geometry managers will
call the preferred-size function to ask  for a child's advice about  its
best size.  Therefore, defining a preferred-size method for each contact
class is  a  good  practice.   The  preferred-size method for the button
class is shown below.

    (defmethod preferred-size ((button button)
                               &key new-width new-height new-border-width)
      (with-slots (font label border-width) button
        
        ;; Get metrics for label string
        (multiple-value-bind
          (label-width ascent descent left right font-ascent font-descent)
            (text-extents font label)
          (declare (ignore ascent descent left right))
    
          (let* ((margin      2)
                 (best-width  (+ label-width margin margin))
                 (best-height (+  font-ascent font-descent margin margin)))
    
            ;; Return best geometry for this label
            (values
              (if new-width  (max new-width best-width)   best-width)
              (if new-height (max new-height best-height) best-height)
              (or new-border-width border-width))))))

For a button, the preferred size  returned is one big enough  to contain
the entire label  string, including  a margin  of two  pixels around all
sides.  The :new-width and :new-height arguments give the size suggested
by the geometry manager; if it  is big enough, then this  suggested size
is returned.  Note that the border  width of the button is  unimportant;
this method simply  returns either  the suggested  value or  the current
value for border width.

3.4 Handling Contact Input

A button is  a simple  contact that  responds to  user input in just two
ways.  Moving  the  pointer  cursor  onto  a  button  causes  it  to  be
highlighted with a rectangular border.  If the pointer cursor is  inside
a button, then clicking any pointer button will cause the button contact
to be selected.  These responses are implemented by two action functions
--- button-set-highlight and button-select.

button-set-highlight highlights or unhighlights the button, depending on
the on-p argument.  If on-p is  true, then the button is  highlighted by
drawing its border  in the  foreground color;  otherwise, the  button is
unhighlighted by drawing its border in the background color.
    
    (defmethod button-set-highlight ((button button) on-p)
      (with-slots (foreground background) button
        (setf (window-border button) (if on-p foreground background))))

button-select simply invokes  the :select  callback of  the button.  The
effect of this depends on the callback function actually associated with
:select.
    
    (defmethod button-select ((button button))
      (apply-callback button :select))

Notice that the responses performed by these actions are not necessarily
related to any specific type of input event.  For each action, an  event
translation must be established  that will connect  the action with  the
event that triggers it.  The button class uses the following class event
translations to make these connections.  Like add-event, defevent causes
the event-mask of  each button  to select  :button-press, :enter-notify,
and :leave-notify event.
    
    (defevent button :button-press button-select)
    (defevent button :enter-notify (button-set-highlight t))
    (defevent button :leave-notify (button-set-highlight nil))
    
These  class  event  translations  represent  defaults  that  might   be
overridden by  more  specific  instance  translations.  For example, the
event-translations slot of a  contact is declared  as a resource.   This
means that by defining  a value for  event-translations in the  resource
database, a user can initialize a contact with new instance translations
that customize the connections between event types and actions.
    


4. Implementing the Menu Hierarchy

A menu consists of a hierarchy  of contacts, each of which  implements a
specific part of a menu's behavior.  A contact class is defined for each
part of the menu hierarchy.

menu            
    A shell which  acts as  the the  top-level container  for the  menu.
    Provides  the  application  program   interface  for  overall   menu
    behavior.  A menu has a title-frame as its only child.

title-frame     
    Implements the layout and display of the menu title.  A  title-frame
    contains a choices contact as its only child.

choices         
    The manager  for  menu  items.   Allows  the  application program to
    define menu items.  Coordinates the selection of menu items.

column          
    Implements geometry management for a column of menu items.

Most parts of the menu hierarchy are created automatically when the menu
is created (see Section 2.2, Class Initialization).  This section  shows
some of the CLUE features used to implement these classes.


4.1 The Menu Title

A title-frame has  slots that  specify title  text, font, and foreground
color.

    (defcontact title-frame (composite)
    
      ((font
         :accessor title-font
         :initarg  :font
         :initform "fg-16"
         :type     font)
    
       (foreground
         :accessor title-foreground
         :initarg  :foreground
         :initform :black
         :type     pixel)   
       
       (text
         :accessor title-text
         :initarg  :text
         :type     string)
    
       (compress-exposures
         :allocation :class
         :initform   :on
         :reader     contact-compress-exposures
         :type       (member :off :on)))
      
      (:resources
        font
        foreground
        text
        (event-mask :initform #.(make-event-mask :exposure)))
      
      (:documentation
        "A composite consisting of a text title and another contact."))


Unlike many composites, a  title-frame contains displayable  information
--- the  title  string.   This  means  that  a  title-frame  must select
:exposure events  and  must  define  a  display  method.  Defining a new
default value  for  the  event-mask  resource accomplishes the necessary
modification to the composite class defaults.   Note the use of the  CLX
function make-event-mask,  which  converts  a  sequence  of  event  mask
keywords into a bit string.  The same thing might have been accomplished
by using defevent to  define a title-frame  class event translation  for
:exposure events.  However,  this approach  is inefficient  because CLUE
does not need such an event translation to handle :exposure events.


The following title-frame methods allow a title-frame to change its size
and title layout when necesssary.  For example, changing the title  font
to a larger size should cause the content of the title-frame (i.e.   the
choices containing menu items) to be moved slightly so that it does  not
cover up the title.

    (defmethod (setf title-font) (new-value (title-frame title-frame))
      (title-update title-frame :font (convert title-frame new-value 'font)))
    
    (defmethod (setf title-text) (new-value (title-frame title-frame))
      (title-update title-frame :text new-value))
    
    (defmethod title-update ((title-frame title-frame) &key text font)
      (with-slots ((current-text text) (current-font font)) title-frame
                
        ;; Update slots
        (setf current-text (or text current-text)
              current-font (or font current-font))
        
        ;; Update geometry
        (when (realized-p title-frame)
          (change-layout title-frame))))

Note that this method for (setf title-font) replaces the  default method
created by  the  font  slot  :accessor  option.  (setf title-frame) also
calls convert  with  the  new  font  value  to  handle conversion to the
necessary representation type.  This allows a program to specify the new
font either  as  a  font  name  string  or with a previously-opened font
object.
    
title-update  calls  change-layout  to  rearrange  the  geometry  of the
title-frame and  its  content.   change-layout  is a geometry management
function that is discussed later in more detail.


4.2  The Menu Manager

The choices class implements the functions of a menu manager:

        o   Serve as the parent for menu item contacts.

        o   Provide geometry management for menu items. The choices
            geometry management policy is inherited from its column
            superclass, which is described later.

        o   Coordinate menu item selection. 

        o   Record the currently-selected item.

The choices  class  defines  a  single  selection  slot  to  contain the
currently-selected item.  Note that only a :reader is specified for this
slot; selection should  be done  interactively by  the user,  not by the
program.

    (defcontact choices (column)
    
      ((selection
         :reader   choice-selection
         :initform nil
         :type     (or null contact)))
      
      (:documentation
        "A column of items to choose from."))
    
Whenever a contact is created,  the add-child function is  called to add
the contact to  its parent's  set of  children.  The  primary method for
add-child should not  be modified,  but contact  programmers may  define
:after methods for add-child that perform child initializations required
for a specific contact class.  For example, the add-child :after  method
for the choices  class initializes  the :select  callback for  each menu
item.

    (defmethod add-child :after ((choices choices) child &key)
      ;; Initialize child's :select callback
      (add-callback child :select 'choice-select choices child))
    
    
    (defmethod choice-select ((choices choices) child)
      ;; Record current selection
      (with-slots (selection) choices
        (setf selection child))
    
      ;; Invoke selection callback
      (apply-callback choices :select))

When initialized as shown here, the :select callback for each  menu item
will call the choice-select function with the selected item child  as an
argument.  choice-select implements the  choices action for  selecting a
menu item;  it  records  the  current  selection and invokes the :select
callback for the choices menu manager.

4.3 Selection Callbacks

Menu selection relies upon :select callbacks from three different  parts
of the menu hierarchy.

Menu item       
    A menu item contact, such as a button, invokes its :select  callback
    in response to user input.  The associated function  (choice-select)
    lets the menu manager know which item has been selected.

Menu manager    
    The choices menu manager allows only  a single item to be  selected.
    A choices  contact  invokes  its  :select  callback  when an item is
    selected.  The associated function (popup-menu-select) lets the menu
    know that it is time to withdraw the pop-up menu.

Menu            
    A menu invokes its  :select callback when  menu has been  withdrawn.
    The associated function is defined  by the application program.   In
    menu-choose, the associated function is throw-menu-selection,  which
    terminates the  event  loop  and  returns  the label of the selected
    item.

This distribution of  selection control  means that  knowledge about the
entire structure of the  menu hierarchy does  not have to  be built into
the methods of classes that implement menu items and menu managers.   It
also provides the flexibility to implement different selection policies.
For example,  a  menu  manager  that  allowed  more  than one item to be
selected could be substituted easily.

4.4  Menu Geometry Management

choices is a subclass of the column class, which implements its geometry
management policy.

    (defcontact column (composite) ()
      (:documentation
        "Arranges its children in a vertical column."))

With no slots or display content of  its own, column is a pure  geometry
management class.  That is, its purpose is simply to provide methods for
CLUE geometry management  functions.  Here  is what  the column geometry
management policy does:

        o   Item size
                All items are  made to  have the  same size,  namely the
                preferred size of the largest item.

        o   Item layout
                Items are arranged in a vertical column and separated by
                a bit of space.   They are also  positioned horizontally
                so that  they  are  centered  in  the  column, and their
                inside left and right edges are aligned.

        o   Handling item geometry
                If the  biggest  item  gets  bigger,  then all items are
                given the new size.  An item can request a change to its
                border width; this is allowed and it causes the item  to
                move so  that  its  inside  edges  remained aligned with
                other items.  Item position is completely determined  by
                the order of the children list and the column policy; an
                item is not permitted to move itself directly.

        o   Handling menu geometry
                In trying to  arrange its  items, a  column will compute
                the size  needed  for  itself  ---  that  is, a size big
                enough to contain  all items  with a  nice spacing.  The
                column must request this size from its geometry manager,
                then somehow  deal  with  whatever  approved  size it is
                given.

In the case of  a menu, the  geometry manager (i.e.   the parent) of the
choices column is a title-frame.  This title-frame, in turn, is  managed
by its parent,  the menu  shell.  When  the choices  column requests its
size be changed  (based on  its policy  and its  list of item children),
then its title-frame and menu ancestors responds similarly.  For both  a
title-frame and menu, the geometry management policy is to be big enough
to contain its content (the implementation  of this policy is not  shown
here).  As a result, the requested  column size gets propagated back  up
the menu hierarchy until every component finds its right size.  In  this
way, the sizes  for the  top-level menu  and all  the other intermediate
contacts are computed automatically  and do not  need to be  assigned by
the application programmer.

The following  examples  show  how  the  geometry management methods for
column implement this policy.  The method for change-layout defines  the
effect of adding or deleting a new column item.  Also, when a  column is
created, change-layout  is  called  once  to  compute  the  initial item
layout.  In  CLUE,  the  change-layout  method  of a composite is called
whenever its set of managed children changes.

    (defmethod change-layout ((column column) &optional newly-managed)
      (declare (ignore newly-managed))
      (with-slots (width height) column
    
        ;; Compute the maximum preferred size of all children.
        (multiple-value-bind (item-width item-height)
            (column-item-size column)
    
          ;; Compute preferred column size, assuming this item size
          (multiple-value-bind (preferred-width preferred-height)
              (column-preferred-size column item-width item-height)
            
            ;; Try to ensure at least preferred size
            (if
              (or (setf preferred-width
                        (when (< width preferred-width)
                          preferred-width))
                  (setf preferred-height
                        (when (< height preferred-height)
                          preferred-height)))
              
              ;; Ask parent for larger size
              (change-geometry column
                               :width    preferred-width
                               :height   preferred-height
                               :accept-p t)
              
              ;; Else current size is big enough
              (column-adjust column item-width item-height))))))


First, the preferred column size is  computed, based on the current  set
of  items.   This  is  done  using  the  functions  column-item-size and
column-preferred-size.


    (defun column-item-size (column)
      "Return the maximum preferred width and height of all COLUMN children."
      (with-slots (children) column
        (let ((item-width 0) (item-height 0))
          (dolist (child children)
            (multiple-value-bind (child-width child-height child-bw)
                (preferred-size child)
              (setf item-width  (max item-width
                                     (+ child-width child-bw child-bw))
                    item-height (max item-height
                                     (+ child-height child-bw child-bw)))))
          (values item-width item-height))))
    
    
    (defun column-preferred-size (column item-width item-height)
      "Return the preferred width and height for COLUMN, assuming the 
       given ITEM-WIDTH and ITEM-HEIGHT."
      (with-slots (children) column
        (let ((preferred-margin 8))
          (values
            (+ item-width preferred-margin preferred-margin)
            (+ (* (length children) (+ item-height preferred-margin))
               preferred-margin)))))


If the current column size is smaller than its preferred size,  then the
column trys to expand.  The  column requests approval from  its geometry
manager for a  larger size  by calling  change-geometry.  The  :accept-p
argument given to change-geometry is true; that is, any modification  to
the requested change made  by the geometry  manager is accepted  without
any further negotiation.  If the current column size is at least as  big
as its preferred size, then no size change is necessary.  In this  case,
the column simply rearranges its items within its current dimensions  by
calling column-adjust.

    
    (defun column-adjust (column &optional item-width item-height)
      "Rearrange COLUMN items according to current COLUMN size. If
       given, ITEM-WIDTH and ITEM-HEIGHT define the new size for all 
       items."
      (with-slots (children width height) column
        (when children
          ;; Compute preferred item size, if necessary
          (unless item-height
            (multiple-value-setq (item-width item-height)
              (column-item-size column)))
          
          ;; Compute item spacing
          (let* ((number-items (length children))
                 (margin       (max
                                 (round (- width item-width)
                                        2)
                                 0))
                 (space        (max
                                 (round (- height
                                           (* number-items item-height))
                                        (1+ number-items))
                                 0)))
            
            ;; Set size and position of each child
            (let ((y 0))
              (dolist (child children)
                (let ((bw (contact-border-width child)))
                  (with-state (child)
                    (resize child
                            (- item-width bw bw) (- item-height bw bw) bw) 
                    (move child margin (incf y space))))
                (incf y item-height)))))))

The resize  and  move  functions  are  called  to actually relocate each
child.   Notice  that  these  calls   lie  within  a  with-state   form.
with-state is  a  CLX  macro  that  makes  window  reconfiguration  more
efficient by combining the new size  and position into a single  request
to the X server.  Calling resize and move here is very important.   Many
contact classes define :after  methods for these  functions in order  to
implement side-effects  of  geometry  changes.   For example, resizing a
column causes it to rearrange all of its items within the new size.  The
column resize method is called  by change-geometry above when  :accept-p
is true.

    (defmethod resize :after ((column column) width height border-width)
      (declare (ignore width height border-width))
      (column-adjust column))


The other  geometry  management  method  defined  by  column  is for the
manage-geometry function.  manage-geometry is called by  change-geometry
in order to  grant approval  for a  change requested  by a  column item.
Implementing this method  is often  complicated.  A  column has  several
factors to  consider  when  approving  a  change  to an item.  First, no
position change can be approved if it differs from the position  already
determined by column  policy.  Also,  an item  is not  allowed to shrink
because it must maintain the same (maximum) size preferred by all  other
items.  (A  more  complex  policy  implementation  might  allow items to
shrink, resetting all items to any new maximum size.) On the other hand,
if the  requested  item  change  does  not  affect its overall width and
height, then the change can be approved immediately.
    
    (defmethod manage-geometry ((column column) child x y width height border-width &key)
      (with-slots
        ((child-width width)
         (child-height height)
         (child-border-width border-width)
         (child-x x)
         (child-y y))
        child
    
        (let*
          ;; No position change can be approved.
          ((position-approved-p     (not (or (unless (null x) (/= x child-x))
                                             (unless (null y) (/= y child-y)))))
           
           ;; Check if requested size change can be approved.
           (total-width            (+ child-width child-border-width child-border-width))
           (total-height           (+ child-height child-border-width child-border-width))
           (requested-width        (or width child-width))
           (requested-height       (or height child-height))
           (requested-border-width (or border-width child-border-width))
           (new-total-width        (+ requested-width requested-border-width requested-border-width))
           (new-total-height       (+ requested-height requested-border-width requested-border-width)))
    
          ;; Refuse size change immediately if it reduces item size
          (when (or (< new-total-width total-width) (< new-total-height total-height))
            (return-from manage-geometry
              nil
              child-x
              child-y
              (- child-width requested-border-width requested-border-width)
              (- child-height requested-border-width requested-border-width)                 
              requested-border-width))
    
          ;; Approve size change immediately if it does not affect item size
          (when (and (= new-total-width total-width) (= new-total-height total-height))     
            (return-from manage-geometry
              position-approved-p 
              child-x
              child-y
              requested-width
              requested-height
              requested-border-width))
    
          ;; Otherwise, a larger item size has been requested.
          ;; Check if column size can be enlarged sufficiently.
          (multiple-value-bind (column-width column-height)
              (column-preferred-size column new-total-width new-total-height)
    
            ;; Request change to preferred column size
            (multiple-value-bind
              (approved-p approved-x approved-y approved-width approved-height)
                (change-geometry column :width column-width :height column-height)
              (declare (ignore approved-x approved-y))
             
              (when approved-p
                
                ;; Larger column size approved.
                ;; When requested child geometry approved, change column layout to reflect new
                ;; item size(s). Change child size here first before recomputing item layout.
                (when position-approved-p         
                  (with-state (child)
                    (resize child requested-width requested-height requested-border-width))
                  (change-geometry column :width column-width :height column-height :accept-p t))
                
                (return-from manage-geometry
                  position-approved-p 
                  child-x
                  child-y
                  requested-width
                  requested-height
                  requested-border-width))
              
              ;; Larger column size NOT approved. Return best item size that could fit
              ;; approved column size
              (return-from manage-geometry
                nil
                child-x
                child-y
                (- approved-width requested-border-width requested-border-width)
                (- (floor approved-height (length (composite-children column)))
                   requested-border-width requested-border-width)
                requested-border-width))))))
    

What if an item asks to become bigger?  In this case, the column  itself
may need to expand,  so the manage-geometry  method for column  begins a
negotiation  with   the   column's   geometry   manager.    A   call  to
changed-geometry returns the approval from the column geometry  manager.
If approved, the column grows to fit  the new item size and returns  its
own approval for the  changed item geometry.   Otherwise, the column  is
forced to refuse the larger  item size, but manage-geometry  returns the
best item size possible for the column size granted.

5. Using Resources

This section shows how the resource  database can be used to  modify the
appearance  and  behavior  of  an  application  user  interface, without
actually modifying.  the application  program.  Resources offer  users a
way to fine-tune an application user interface in ways that  application
programmers and contact programmers may not have anticipated.

Resources allows user and programmers to cooperate in defining the  user
interface.  Contact programmers declare which contact attributes may  be
specified as resources, by giving the appropriate  resource declarations
to defcontact.  Application programmers,  who instantiate contacts,  can
also control user  access to  resource values.   The application program
can either set  the resource  value initarg  to make-contact,  or it can
leave it to be defaulted from the resource database.  Finally, users can
invoke define-resources to  provide default  resource values  which suit
their preferences.

In order  to  demonstrate  how  resources  are  used,  the resource-menu
function  is   defined.    Similar   to   the   just-say-lisp  function,
resource-menu creates a  menu containing  the given  items, displays the
menu  at  the   pointer  position,   and  returns   the  user's  choice.
resource-menu uses the :name argument to make-contact to assign resource
names to the menu and each item.  The :defaults argument to make-contact
is also used to pass along application-specific resource defaults.


    (defun resource-menu (host menu-name item-defaults &rest buttons)
      (let*
        ((display (open-contact-display 'resource-menu :host host))         
         (menu    (make-contact 'menu :parent display :name menu-name)))    
        
        ;; Create menu items
        (dolist (label buttons)
          (make-contact 'button
                        :parent   (menu-manager menu)
                        :name     (intern (string label))
                        :label    (format nil "~:(~a~)" label)
                        :defaults item-defaults))    
        
        ;; Set menu callback to return chosen item label
        (add-callback menu :select 'throw-menu-selection menu)
        
        ;; Display the menu so that first item is at x,y
        (initialize-geometry menu)
        (multiple-value-bind (x y) (query-pointer (contact-parent menu))
          (menu-present menu x y))
        
        ;; Event processing loop
        (let ((selected (catch :menu-selection
                          (loop (process-next-event display)))))
          
          ;; Close server connection
          (close-display display)
          
          ;; Return selected string
          selected)))


5.1 Defining Resources

The beatlemenuia  function  contains  several  examples  of  the  use of
define-resources.  beatlemenuia itself is simply a wrapper which  allows
one to  set  the  value  of  the  X  server  host and to experiment with
different sets of resource defaults for menu items.

    (defun beatlemenuia (host &optional defaults)
      ;; ... examples of define-resources ...
      )
    
    
Inside  beatlemenuia,  define-resources  is  called  to  store  resource
bindings in the resource database.

    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 1                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+

    (define-resources
      (* beatles title) "Who is your favorite Beatle?")

In Example 1, define-resources binds the resource name (* beatles title)
to a specific value  --- the string  "Who is your  favorite Beatle?" ---
and stores this resource binding in  the resource database given by  the
special variable *database*.   The meaning  of this  resource binding is
that title string for the contact  named beatles should be "Who  is your
favorite Beatle?" and that  beatles may appear  anywhere in the  contact
hierarchy.  Now, if an application creates a menu named beatles  without
specifying its title, then this default  title string will be read  from
*database* and used.

By default, CLUE establishes a top-level binding for *database*, binding
it to  an  empty  resource-database  object.   The  basic  functions for
creating and manipulating  a resource-database  are defined  by CLX.  An
application may manipulate several resource databases, in which case the
binding of  *database*  needs  to  be  carefully  controlled by both the
program and its users when using resources.

Example 2 defines resource  bindings for button  foreground, background,
and border resources.  Note that a resource name may include the name of
a class of contacts, as well as the name of a specific contact instance.
In Example 2,  resource-menu displays  a menu  in which  the buttons are
black rectangles with white labels.  As a result of Example 1, the title
of this menu is "Who is your favorite Beatle?".

    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 2                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+
    
        (format t "~%Buttons are white-on-black ...")
        
        (define-resources (* button foreground) :white
                          (* button background) :black
                          (* button border)     :white)
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* button foreground) :white
                            (* button background) :black
                            (* button border) :white)
        (unless (y-or-n-p "~%Continue?") (return))

After resource-menu returns, undefine-resources is called to remove  the
previously-stored resource bindings  from *database*.   For convenience,
undefine-resources has  the  same  argument  list  as  define-resources;
however, only  the  resource  names  are  significant,  and the resource
values are ignored.

Example 3 demonstrates  the use  of the  display resource  name and  the
power of "wild-card"  matching for  resource names.   The resource  name
(resource-menu *  font)  matches  the  font  resource  for  any  contact
belonging to the  display named  resource-menu.  As  a result,  the menu
title and button  labels all  appear in  the given  font.  Note that the
font value  is  specified  as  a  font  name  string.  When a contact is
created and its font resource value is read from the database, then  the
convert function automatically  converts the  given name  string into an
open font object.
    
    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 3                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+
    
        (format t "~%Use font FG-22 everywhere ...")
        
        (define-resources (resource-menu * font) "fg-22")
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (resource-menu * font) "fg-22")
        (unless (y-or-n-p "~%Continue?") (return))    
    
    
Example 4 shows another "wild-card" resource name used to specify the background
pattern for  all  components  of  the  contact  named  beatles.   The pattern is
specified as a gray-scale  value between 0.0  and 1.0.  CLUE  defines a built-in
convert method that converts the value 0.8 into a two-color background pixmap in
which approximately 80% of the pixels are 1 and 20% are 0.

    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 4                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+
    
        (format t "~%Use gray background in menu ...")
        
        (define-resources (* beatles * background) 0.8)
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* beatles * background) 0.8)
        (unless (y-or-n-p "~%Continue?") (return))

    
In Example 5, resource bindings are given for specific menu  items.  The
resource names therefore contain contact name symbols such as 'John  and
'Ringo.  Only the matching  menu items are  affected.  Note also  that a
background resource  is  specified  with  the  name  of  a  bitmap image
predefined by CLUE.  CLUE defines  a built-in convert method  to convert
image names into a corresponding pixmap.

    
    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 5                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+
    
        (format t "~%Only John uses font FG-22, Ringo uses gray background ...")
        
        (define-resources (* John font)        "fg-22"
                          (* Ringo background) "50%gray")
    
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
    
        (undefine-resources (* John font)        "fg-22"
                            (* Ringo background) "50%gray")    
        (unless (y-or-n-p "~%Continue?") (return))
    
    
In Example 6, resources are used to modify not the visual  appearance of
the button but rather its interactive behavior.  The basic contact class
declares the event-translations slot as a resource.  Therefore, instance
event translations  for  any  contact  can  be specified in the resource
database.  Menu item buttons created in  Example 6 can be selected  only
by pressing pointer  :button-3 (by  default, the  right pointer button).
:button-press events from the other  two pointer buttons are  translated
to the  ignore-action.   This  is  a  generic action function defined by
CLUE; the primary  ignore-action method  uses the  CLX bell  function to
"beep" the X server display.

    ;;;----------------------------------------------------------------+
    ;;;                                                                |
    ;;;                           Example 6                            |
    ;;;                                                                |
    ;;;----------------------------------------------------------------+
    
        (format t "~%Select only with :button-3 ...")
        
        (define-resources (* button event-translations)
                          '(((:button-press :button-3) button-select)
                            ((:button-press :button-1) ignore-action)
                            ((:button-press :button-2) ignore-action)))
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* button event-translations)
                          '(((:button-press :button-3) button-select)
                            ((:button-press :button-1) ignore-action)
                            ((:button-press :button-2) ignore-action)))
        (unless (y-or-n-p "~%Continue?") (return))



5.2 Application Resource Defaults

In describing the  define-resources examples  found in  the beatlemenuia
function, we  have  assumed  that  the  optional  defaults  argument was
omitted.    However,   this   argument   can   be   used   to    specify
application-specific defaults for menu item resources.  Notice that  the
value of defaults is eventually  used in resource-menu as  the :defaults
argument to make-contact when creating item buttons.

The :defaults argument  to make-contact  is a  property list of resource
initargs.  For example:

    (setf item-defaults '(:font "vrb-25" :background 0.5))

When a  contact  is  created,  if  a  resource  value  is not given in a
make-contact initarg and no value can be found in the resource database,
then its value is  looked up in  the :defaults list.   However, resource
defaults found  in  the  resource  database  override  any  value in the
:defaults list.  Therefore, the :defaults  list is a convenient  way for
an application to accept user  preferences in the resource  database but
also to supply application-specific defaults if no user  preferences are
found.

For example,  if  beatlemenuia  is  invoked  with  different application
defaults, then menus displayed may look different.

    (setf item-defaults '(:font "vrb-25" :background 0.5))
    (beatlemenuia 'lm item-defaults)

This example causes  the menu  item labels  to appear  in the font named
"vrb-25" in Example 2.  However, in Example 3, this application-specific
default is  overridden  by  the  user's  font  choice  in  the  resource
database.  Similarly, items have a gray background in Example 3, but not
in Example 2.
