(defform ("paper" "employee" . "form") ()
  "This form displays an employee record, and allows simple scrolling"
  (gm 'packed-gm)
  (background "gray75")
  (constants (title-font (make-font :name "9x15bold"))
	     (helv12 (make-font :name "7x13"))
	     (helv12b (make-font :name "8x13bold")))
  (children (make-gadget :value "Employee" 
			 :font #!title-font
			 :geom-spec '(:top 50))
	    (make-collection-gadget
	     :geom-spec '(:top :top-pad 20)
	     :gm 'anchor-gm
	     :children '((picture-gadget
			  (make-image-gadget 
			   :geom-spec '(.55 0 .45 .99)))
			 (name-field
			  (make-text-gadget :label "Name:" 
					    :mask t
					    :label-font #!helv12
					    :font #!helv12b
					    :geom-spec '(.15 0 .35 .33
							     :arrow (:horiz))))
			 (age-field
			  (make-text-gadget :label "Age: " 
					    :mask t
					    :label-font #!helv12
					    :font #!helv12b
					    :geom-spec '(.15 .33 .35 .34
							     :arrow (:horiz))))
			 (dept-field
			  (make-text-gadget :label "Dept:" 
					    :mask t
					    :label-font #!helv12
					    :font #!helv12b
					    :geom-spec '(.15 .67 .35 .33
							     :arrow (:horiz))))
			 ))
	    (col 
	     (make-collection-gadget
	      :geom-spec :fill
	      :gm 'anchor-gm
	      :children '((pb (make-button :value "Previous"
					   :release-func 
					   '(get-emp :dir :prev :key #!key)
					   :base-size '(75 40)
					   :geom-spec '(0 0 .4 1)))
			  (nb (make-button :value "Next"
					   :release-func 
					   '(get-emp :dir :next :key #!key)
					   :base-size '(75 40)
					   :geom-spec '(.6 0 .4 1)))
			  (kb (make-pop-button :value "Name"
					       :label "Search Key"
					       :label-type :bottom
					       :geom-spec '(.4 0 .2 1)
					       :base-size '(50 40)
					       :items '("Name" 
							"Age"
							"Dept")))))))
  (setup-code
   (progn
    ;; Fix small bug in collection gadgets...
    (setf (label-type #!col) nil)
    (blet (dimmed #!nb)
	  :var ((e #!employee)
		(k #!key))
	  (not (and e
		    k
		    (or
		     (and (eql k :name)
			  (next_name e))
		     (and (eql k :age)
			  (next_age e))
		     (and (eql k :dept)
			  (next_dept e))))))
    (blet (dimmed #!pb)
	  :var ((e #!employee)
		(k #!key))
	  (not (and e
		    k
		    (or
		     (and (eql k :name)
			  (prev_name e))
		     (and (eql k :age)
			  (prev_age e))
		     (and (eql k :dept)
			  (prev_dept e))))))
    (bind (value #!name-field) #!name)
    (bind (value #!age-field) #!age)
    (bind (value #!picture-gadget) #!picture)
    (bind-var #!key `(read-from-string
		      (concatenate 'string
				   ":"
				   (var value ,#!kb))))
    (bind-slot 'value #!kb `(symbol-name (var #!key)))
    (bind (value #!dept-field) #!dname))))

