Interlisp.medley/internal/test/env/FreeMenu/Auto/FREEMENU.TEST

;; TESTER FOR FREEMENU
;;
;; Created By:   Jim Blum
;;
;; Creation Date: FEB 20, 1987
;;
;; Last Update:  MAR 5, 1987
;;
;; Filed As:      {ERIS}<LISPCORE>TEST>FREEMENU>FREEMENU.TEST
;;
;; A Free Menu is built from a description of the contents and layout of the
;;  menu.  As a Free Menu is simply a group of items, a Free Menu Description 
;; is simply a specification of a group of items.  Each group has properties 
;; associated with it, as does each Free Menu Item.  These properties specify 
;; the format of the items in the group, and the behavior of each item.  The 
;; function  FREEMENU takes a Free Menu Description, and returns a closed
;;  window with the Free Menu in it.
;;
 ;; The easiest way to make a Free Menu is to define a function which calls 
;;  FREEMENU with the Free Menu Description right there in your function.
;;   This function can then also set up the Free Menu window as required by 
;; the application.  The Free Menu Description is then saved as part of the 
;; function when you save an atplication.  
;;
;; Alternatively,  the Free Menu Description can be saved as a variable in a 
;; file.   FREEMENU can be called with the name of the variable. 
;; See the real documentations &hr more details 
;;
;; Call  format: (FREEMENU description title background border)
;; 
;; Arguments: 
;;    description - A Free Menu Description, specifying a group of items, is a
;;	 list structure. The first thing in the list is an op‚ §õõº¾µxÃõÿõʵôõ©çç¿z?<04>ôƒµôxõÿõʵµxõ÷?¤ÀÍõÿõƒô´x·ººõʵôõñ?å©çç©çç¿“
€
˜•ŒPUTPROP˜•ŒGABRIEL-TIMERSCOMS˜•Œ	FILEDATES
˜•ŒGABRIEL-TIMERS˜“˜“˜•Œ
*˜•Œ;;˜Œ?Main file for running [Gabriel] Benchmark suites in Xerox Lisp:˜“˜•ŒCOMS˜“™™˜Œ:Definitions for the TIMERS type, and the definer for them:˜“˜•ŒDEFINE-TYPES˜’ŒTIMERS˜‘˜ŒGABRIEL˜“˜•Œ	FUNCTIONS˜’ŒDEFINE-TIMER™#˜“™˜“™™˜ŒCONTROL VARIABLES˜“™™˜ŒD *ALL-TIMERS* - List of all the benchmark definitions you've loaded.˜“™™˜ŒB *MINIMUM-TESTS* - Min # of times to run each test, defaults to 2.˜“˜•Œ	VARIABL <ITEM DESCRIPTION>
;;	 <ITEM DESCRIPTION> ...)	
;;
;;	When using ROW or TABLE formatting, the rest of the description is 
;;	any number of item groups, each group corresponding to a row in the
;;	menu.  These groups are identical in syntax to an EXPLICIT group
;;	description,  with an optional PROPS list and then any number of
;;	Item Descriptions, except that the items need not have LEFT and
;;	BOTTOM properties, as the location of each item is figured out by the 
;;	formatter.  But the order of the rows and items is important.  The 
;;	menu is layed out top to bottom by row, and left to right withi 
;;	each row. The syntax is (the comments qre not part of the description):
;;	
;;	((PROPS FORMAT ROW)		; props of this group
;;	(<ITEM FESCRIPTION>	; items in first row
;;	 <ITEM DESCRIPTION>)
;;	((PROPS ...)				; props of second row
;;	 <ITEM DESCRIPTION>	; items in second row
;;	  <ITEM DESCRIPTION>))
;;
;;	When using COLUMN formatting, the syntax is identical to that of
;;	ROW formatting.  However each group of items corresponds to a 
;;	column in the menu, rather than a row. The menu is layed out left to
;;	right by column, top to bottom within each column.
;;
;;	Finally, a Free Menu Description can have recursively nested groups. 
;;	Anywhere the description can take an Item Description, it can take a 
;;	group, marked by the key word GROUP. A nested group inherits all
;;	of the properties of its mother group, by default.  However, any of 
;;	these properties can be overridden in the nested groups PROPS list, 
;;	including the FORMAT.  The syntax is:
;;
;;	(			; no PROPS list, default row format
;;	 (<ITEM DESCRIPTION>		; first in row
;;	  (GROUP					; nested group, second in row
;;	     (PROPS FORMAT COLUMN)	; optional props
;;	     (<ITEM DESCRIPTION> )		; first column
;;	     (<ITEM DESCRIPTION> ))
;;	<ITEM DESCRIPTION>))		; third in row
;;
;;  title - The title can be a string or atom which goes in the window title
;;
;;  background - The background shade of the entire Free Menu.
;;
;;  border - The window border size, which must be 4 or greater when a Free
;;	 Menu	background is used, due to the way the Window System handles
;;	 window borders.
;;
;;
;; Returns - a window, when then can be opened for display and use
;;
;; 
;;  Here is an example of a simple Free Menu Description, for a menu which 
;; might provide access to a simple data base:
(DO-TEST "Simple name and address freemenu example" 
  (TEST-DEFUN MYLOOKUPFN  (ITEM WIN POS) 
    (COND ((EQUAL (IL:FM.ITEMPROP (IL:FM.GETITEM 'NAME NIL WIN) 'IL:LABEL) "Perry")
             (IL:FM.CHANGELABEL 'NAME "Herbert Q Perry" WIN)
 	(IL:FM.CHANGELABEL 'ADDRESS  "13 Middleperry Dr" WIN)
 	(IL:FM.CHANGELABEL 'PHONE "(411) ÷67-1òó:" WIN))
	(T (IL:FM.CHANGELABEL 'NAMEÀ **not found**" WIN))
    )
  )
 (TEST-DEFUN MYEXITFN (ITEM WIN POS) (IL:CLOSEW WIN))
 (TEST-SETQ FM-WIN (IL:OPENW (IL:FREEMENU '(((IL:LABEL LOOKUP IL:SELECTEDFN MYLOOKUPFN) 
   (IL:LABEL EXIT IL:SELECTEDFN MYEXITFN))
    ((IL:LABEL Name\: IL:TYPE IL:DISPLAY) 
     (IL:LABEL "" IL:TYPE IL:EDIT IL:ID '’ŒPPRINT-DEFINER™
˜“€€˜<E282AC>ŒBODYœ˜’Œexpand-DEFINE-TIMER™#˜–ggg@Ah™‚²™˜“
˜“˜Œ$$MACRO-FORM˜Œ$$MACRO-ENVIRONMENT™'™$
˜’ŒDEFINER™
<00>˜–gg
™}™˜“
€
˜•ŒSETF-MACRO-FUNCTION™‚²
™'<00>˜–
o	¿g	¸H‘Hhc
™1˜ŒDEFVAR *ALL-TIMERS*

™˜“
€™[™\
	™1

˜“˜<>ŒSPECIAL™1<00>˜–
o	¿lc¿ggo™2˜ŒDEFPARAMETER *MINIMUM-TESTS*
™˜“
€™^™\˜<>ŒVARIABLE™2˜Œ&Run each test at least this many times
˜“™‚¾™2<00>˜–
o	¿g	¸H‘Hoc
™3˜ŒDEFVAR *MOST-TIMERS*

™˜“
€™[™\
	™3˜“˜’ŒTAKR™#˜’ŒTAKL™#˜’ŒTAK™#˜’ŒSTAK™#˜’ŒCTAK™#˜’ŒTRIANG™#˜’Œ
TRAVERSE-INIT™#˜’ŒTRAVERSE™#˜’ŒTPRINT™#˜’ŒPUZZLE™#˜’ŒFPRINT™#˜’ŒFREAD™#˜’ŒFFT™#˜’ŒDIV2-2™#˜’ŒDIV2-1™#˜’ŒDESTRU™#˜’ŒDERIV™#˜’ŒDDERIV™#˜’ŒBROWSE™#˜’ŒBOYER™#˜’ŒTRAVERSE-INIT*™#˜’Œ	TRAVERSE*™#˜’ŒBROWSE*™#
˜“™‚¾™3œ™8˜–‚’n¸emÿó”eló–jl
¿edjð³3kaHý¿kÙdjð³+laHý¿kÙdjð³$la¹kÙjð³laHý¿°SHý¿gHý¿T¹hHý¿U	Hý¿I
noHkoH-¿VoHÉ™2™1™2˜<>Œ	*PACKAGE*˜<>Œ*STANDARD-OUTPUT*™8‚ÿÿÿÿ™˜“
˜“˜<>Œ	&OPTIONAL˜Œ
BENCHMARKS˜ŒDRIBBLE-FILE˜ŒNUMBER-OF-ITERATIONS˜ŒAPPEND-DRIBBLE-FILE‚Ž˜<C5BD>ŒFORMATe˜<65>ŒPACKAGE-NAME˜’ŒARGUMENT-ERROR˜‘˜ŒSYSTEM
T˜’Œ{DSK}GABRIEL.BENCHMARKS™#‚‡˜Œ~%~%Output on ~s~%˜–‚
HnHY¿o	¿W	gg¿HÉHÉ
¿¿hIý¿hºh»h¼h½Hɾh_¿N‘Nƒh±÷
_¿WoO¿OÁÉg'Iý¿OÁÉg'ºOÁÉg'»OÁÉg'¼OÁÉg'½MšWoM¿JŸWoO¿jJ¿W_¿j_¿OOýó<C3BD><C3B3>°aWoOO¿noIgOgW
¿KŸWoO¿jK¿j_¿Ol
ýó<EFBFBD>€Œ¿OkÔ_¿°ìOkÔ_¿°™LŸWoO¿jL¿N¾±ÿ½j@¿M™‚ä™2˜’Œ*UNWIND-PROTECT*™‚ï
˜<>ŒCLOSURE˜“
˜“
˜ŒG56
‚
3™‚ì‚
˜•ŒRECLAIM‚þ™‚ì‚ð˜<C3B0>Œ	TIME-CALL‚Ô™‚삯™‚ì‚¡™‚ìY™‚ì+™9'˜<>ŒDRIBBLE˜•Œ
PUTWINDOWPROP˜•ŒWFROMDS˜<>Œ
IN-PACKAGE	‚Ꙃå˜<C3A5>Œ
TIMED-FORM‚“™‚‘‚ˆ™‚”}™‚—r™‚šc™‚<00>™_˜•Œ
PAGEFULLFN‚
-˜Œ$~%Evaluating after function for ~a~%‚ø˜Œ*~%Evaluating after every function for ~a~%‚ܘ–jHɘŒlambda in *UNWIND-PROTECT*
™‚ô˜“
€‚̘Œ~%Iteration ~s of ~a~%‚©˜Œ~%Evaluating setup for ~a~%‚œ˜Œ~%~A~%~%S˜Œ~%~%***** ~A Benchmark ***~%
˜ŒGABRIEL‚ؘ•ŒCOMPILED-CLOSURE
˜•Œ	\PTRHUNK2u˜–
¿HÉ	¿Q	gh
™‚䘌Clean-up forms

™‚ô˜“
€™‚û
™‚ü™‚ý
™‚ú
™‚ÿq™‚


˜•Œ	\PTRHUNK4œ™9˜–‚„emÿó“ekó•jk
¿ejð£ka¸<61>Q¸Ho¿Ho¿Ho¿Ho¿Ho¿Ho¿Ho¿Ho¿HoR
™‚ä˜<>Œ
*FEATURES*™9
‚ÿÿÿÿ™˜“
˜“™‚嘌STREAM‚€™‚ìv™‚ìs˜<73>ŒLONG-SITE-NAMEj™‚ìg˜<67>ŒMACHINE-INSTANCE^™‚ì[˜<>ŒMACHINE-VERSIONR™‚ìO˜<4F>ŒMACHINE-TYPEF™‚ìC˜<43>ŒSOFTWARE-VERSION:™‚ì7˜<37>Œ
SOFTWARE-TYPE.™‚ì+˜<>ŒLISP-IMPLEMENTATION-VERSION"™‚ì˜<>ŒLISP-IMPLEMENTATION-TYPE™‚ð	{˜Œ~&Features:~20T~So˜Œ
~&Site:~20T~Ac˜Œ~&Machine Instance:~20T~AW˜Œ~&Machine Version:~20T~AK˜Œ~&Machine Type:~20T~A?˜Œ~&Software Version:~20T~A3˜Œ~&Software Type:~20T~A'˜Œ~&Lisp Version:~20T~A˜Œ~&Lisp Type:~20T~Aœ™>˜–ottom offset for this group, pushing the group up.
;;
;;ROWSPACE - The number of bits between rows in this group.
;;
;; COLUMNSPACE - The number of bits between columns in this group,
;;
;;  BOX  -	The number of bits in the box around this group of items.
;;
;;BOXSHADE - The shade of the box.
;;
;;BOXSPACE - The number of bits between the box and the items.
;;
;;BACKGROUND - The background shade of this group.  Nested groups will
;;		inherit this background shade, but items in this group and
;;		nested groups will not. This is because in general it is difficult 
;;		to read text on a background, so items appear on white 
;;		background by default. This can be overridden by the 
;;		BACKGROUND Item Property.
;;
;;  ITEMS  -	A list of the items in the group.
;;
;;  REGION -	The region that is the extent of the items in the group.
;;
;;MOTHER - The ID of the group that is the mother of this group.
;;
;;DAUGHTERS - A list of ID of groups which are daughters to this group.


	
(DO-TEST "Test Group Properties"	
 (AND (EQUAL '(IL:MODERN 10)
    		 (IL:FM.GROUPPROP FM-WIN 'GROUP1 'IL:FONT))
	(EQUAL  '(GROUP6 GROUP5 ROW3 ROW4)
		(IL:FM.GROUPPROP FM-WIN 'GROUP1 'IL:DAUGHTERS))
	(EQUAL 'GROUP1 
		(IL:FM.GROUPPROP FM-WIN 'ROW4 'IL:MOTHER))
	(EQUAL 'IL:COLUMN 
		(IL:FM.GROUPPROP FM-WIN 'GROUP2 'IL:FORMAT))
‰EQUAL 'GROUP2
		(IL:FM.GROUPPROP FM-WIN 'GROUP3 'IL:MOTHER))
	(EQUAL  '1
		(IL:FM.GROUPPROP FM-WIN 'ROW3 'IL:BOX))

  )
)

û;*Each Free MenuÀItem is stored as an instance of the Data Type
;; FREEMENUITEM. Free Menu Item˜Œ~%~%***** ~A Benchmark ***~%
‚¤™‚

k˜–HÉgHÉ™‚


™‚ô˜“
€

˜<EFBFBD>ŒCLOSE
˜<>ŒABORT
˜ŒGABRIELg™‚


˜•Œ	\PTRHUNK8‚‡˜–
¿HÉ	¿Q	gh
™‚䙂



™‚ô˜“
€™‚û
™‚ü™‚ý
™‚ú
™‚ÿ‚ƒ™‚


˜•Œ	\PTRHUNK6œ™?˜–
‚Ñejó¥kh
¿gµW¸<>a¸gµh¹hºƒa¹iºgµ»<>a»gµk¼<6B>a¼h½¾_¿_¿noNO¿@NOL	½OO
¿JšHoLI¿HoO
ii
¿HOK¿gO
gO
l
gO
l
gO
l

h	˜<>Œ*TRACE-OUTPUT*™?	
‚ÿÿÿÿ™˜“
˜“˜ŒTIMED-FUNCTION˜<4E>Œ&KEY™™‚þ˜<C3BE>Œ
DATA-TYPES˜<53>ŒREPEAT‚Ę•Œ\GETBASEFIXP‚¸™‚
X‚¬™‚
X‚™˜<E284A2>Œ%PRINT-TIMING-INFO‚‘˜<E28098>Œ%PRINT-TIMING-ITEM‚‚˜<E2809A>ŒTIME-FORMATu˜<75>Œ%STATS-OBJECT-DIFFERENCEm˜•Œ\MVLISTj˜<6A>Œ%GET-TIMING-INFOa™‚
^N˜<4E>ŒMAKE-STATS-OBJECTH™‚
_D™‚
_/˜•Œ	DATATYPES™‚ð‚»˜<C2BB>ŒI/O‚¯˜<C2AF>ŒSWAP‚£˜<C2A3>ŒGC‚<00>˜<EFBFBD>ŒTOTAL6™‚
U(™‚
T™‚þ™‚‡˜ŒElapsed time|˜Œ&Timing for ~[~;~:;~:* ~D x~]:~20T ~S~&X˜–h˜Œlambda in TIME-CALL™‚ô˜“
€
T™‚

œ™@˜–>h¸@¹hºI‘I<E28098>°1
ºHJ»h¼h½h¾K<C2BE>‚L°K
¾L”MN&½„Nh]¼K»°ç
¸I¹°ÍH™@
™˜“
˜“
˜Œ	TIME-LIST
3˜<33>ŒUNION<00>˜–o	¿o	¿o	˜Œ3 top-level forms™˜“
€˜•ŒPUTPROPS
™‚
r™‚
r˜“™˜•Œ	COPYRIGHT˜“˜ŒXerox Corporation‚ÂÄ	˜“™™K˜“™	˜ŒXCL™˜“™˜ŒGABRIEL
˜“™™J˜<4A>ŒCOMPILE-FILEš‚
ÿÿ),Qã
Ê£ÐëêlPÃ!À<>¼
/ø),Ô
â°#+)ÂÍ©€Ê@Ê:~|+































































































































































































































































































































































































































































































































(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "GABRIEL"))
(IL:FILECREATED "12-Aug-88 10:33:17" ("compiled on " IL:{ERIS}<LISPCORE>GABRIEL>TOOLS>GABRIEL-TIMERS.\;7
) "31-Jul-88 18:51:57" "COMPILE-FILEd" IL:|in| "Lispcore 31-Jul-88 ..." IL:|dated| 
"31-Jul-88 19:14:03")
(IL:FILECREATED "12-Aug-88 10:32:50" IL:{ERIS}<LISPCORE>GABRIEL>TOOLS>GABRIEL-TIMERS.\;7 17901 
IL:|changes| IL:|to:| (IL:FUNCTIONS RUN-BENCHMARKS) IL:|previous| IL:|date:| "28-Jul-88 03:21:26" 
IL:{ERIS}<LISPCORE>GABRIEL>TOOLS>GABRIEL-TIMERS.\;6)
(IL:RPAQQ IL:GABRIEL-TIMERSCOMS ((IL:* IL:|;;| 
"Main file for running [Gabriel] Benchmark suites in Xerox Lisp:") (IL:COMS (IL:* IL:|;;| 
"Definitions for the TIMERS type, and the definer for them:") (IL:DEFINE-TYPES TIMERS) (IL:FUNCTIONS 
DEFINE-TIMER)) (IL:COMS (IL:* IL:|;;| "CONTROL VARIABLES") (IL:* IL:|;;| 
" *ALL-TIMERS* - List of all the benchmark definitions you've loaded.") (IL:* IL:|;;| 
" *MINIMUM-TESTS* - Min # of times to run each test, defaults to 2.") (IL:VARIABLES *ALL-TIMERS* 
*MINIMUM-TESTS* *MOST-TIMERS*)) (IL:COMS (IL:* IL:|;;| 
"Functions for running benchmarks.  RUN-BENCHMARKS is the main entry; DESCRIBE-IMPLEMENTATION is a sub-function."
) (IL:FUNCTIONS RUN-BENCHMARKS DESCRIBE-IMPLEMENTATION)) (IL:COMS (IL:* IL:|;;| 
"Functions for running benchmarks and saving the results in a database of benchmarks.  RUN-BENCHMARKS-TO-DATABASE is the main entry; DESCRIBE-IMPLEMENTATION is a sub-function."
) (IL:FUNCTIONS RUN-BENCHMARKS-TO-DATABASE TIME-CALL ALL-TIME-INDICATORS)) (IL:DECLARE\: IL:DONTCOPY 
IL:DOEVAL@COMPILE (IL:LOCALVARS . T)) (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:GABRIEL-TIMERS
)))
(IL:SET-DOCUMENTATION (QUOTE TIMERS) (QUOTE IL:DEFINE-TYPES) (QUOTE "Gabriel Benchmarks"))
(IL:SETQ IL:PRETTYDEFMACROS (ADJOIN (QUOTE (TIMERS XCL::X (IL:P IL:* (XCL::%DEFINE-TYPE-FILE-DEFINITIONS
 (QUOTE TIMERS) (QUOTE XCL::X))))) IL:PRETTYDEFMACROS :TEST (QUOTE EQUAL)))
(IL:SETQ IL:PRETTYTYPELST (ADJOIN (QUOTE (CHANGEDTIMERSLST TIMERS "Gabriel Benchmarks")) 
IL:PRETTYTYPELST :TEST (QUOTE EQUAL)))
(PROCLAIM (QUOTE (XCL:GLOBAL CHANGEDTIMERSLST)))
(OR (BOUNDP (QUOTE CHANGEDTIMERSLST)) (SETQ CHANGEDTIMERSLST NIL))
(COND ((NOT (GETHASH (QUOTE TIMERS) XCL:*DEFINITION-HASH-TABLE*)) (CL::PUTHASH (QUOTE TIMERS) 
XCL:*DEFINITION-HASH-TABLE* (MAKE-HASH-TABLE :TEST (QUOTE EQUAL) :SIZE 50 :REHASH-SIZE 50))))
(IL:SETQ IL:FILEPKGTYPES (ADJOIN (QUOTE TIMERS) IL:FILEPKGTYPES))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE IL:GETDEF) (QUOTE XCL::%DEFINE-TYPE-GETDEF))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE IL:DELDEF) (QUOTE XCL::%DEFINE-TYPE-DELDEF))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE IL:PUTDEF) (QUOTE XCL::%DEFINE-TYPE-PUTDEF))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE IL:FILEGETDEF) (QUOTE XCL::%DEFINE-TYPE-FILEGETDEF))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE IL:FILEPKGCONTENTS) (QUOTE IL:NILL))
(IL:PUTPROP (QUOTE DEFINE-TIMER) (QUOTE :DEFINER-FOR) (QUOTE TIMERS))
(IL:PUTPROP (QUOTE TIMERS) (QUOTE :DEFINED-BY) (ADJOIN (QUOTE DEFINE-TIMER) (GET (QUOTE TIMERS) (QUOTE
 :DEFINED-BY))))
|definition-expander-DEFINE-TIMER| :D5
(IL:L (1 SI::$$MACRO-ENVIRONMENT 0 SI::$$MACRO-FORM)) 
;
@<11>H
¹HZ
»J¼Id<03>
gI
gI
gI
½gggOho