;; TESTER FOR FREEMENU ;; ;; Created By: Jim Blum ;; ;; Creation Date: FEB 20, 1987 ;; ;; Last Update: MAR 5, 1987 ;; ;; Filed As: {ERIS}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?ôƒµô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 ;; ...) ;; ;; 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 ;; ( ; items in first row ;; ) ;; ((PROPS ...) ; props of second row ;; ; items in second row ;; )) ;; ;; 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 ;; ( ; first in row ;; (GROUP ; nested group, second in row ;; (PROPS FORMAT COLUMN) ; optional props ;; ( ) ; first column ;; ( )) ;; )) ; 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™ ˜“€€˜ŒBODYœ˜’Œexpand-DEFINE-TIMER™#˜–ggg@Ah™‚²™˜“˜“˜Œ $$MACRO-FORM˜Œ$$MACRO-ENVIRONMENT™'™$˜’ŒDEFINER™ ˜– gg ™}™˜“€˜•ŒSETF-MACRO-FUNCTION™‚²™'˜–o ¿g ¸H‘Hhc™1˜ŒDEFVAR *ALL-TIMERS*™˜“€ ™[™\ ™1˜“˜ŒSPECIAL™1˜–o ¿lc¿ggo ™2˜ŒDEFPARAMETER *MINIMUM-TESTS*™˜“€™^™\˜ŒVARIABLE™2˜Œ&Run each test at least this many times˜“™‚¾™2˜–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ý¿InoHkoH-¿VoHÉ ™2™1™2˜Œ *PACKAGE*˜Œ*STANDARD-OUTPUT*™8‚ÿÿÿÿ™˜“˜“˜Œ &OPTIONAL˜Œ BENCHMARKS˜Œ DRIBBLE-FILE˜ŒNUMBER-OF-ITERATIONS˜ŒAPPEND-DRIBBLE-FILE‚Ž˜ŒFORMATe˜Œ PACKAGE-NAME˜’ŒARGUMENT-ERROR˜‘˜ŒSYSTEMT˜’Œ{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ýó°aWoOO ¿noIgOgW ¿KŸWoO ¿jK¿j_¿Ol ý󀌿OkÔ_¿°ìOkÔ_¿°™LŸWoO ¿jL¿N¾±ÿ½j@¿M ™‚ä ™2˜’Œ*UNWIND-PROTECT*™‚ï ˜ŒCLOSURE˜“˜“˜ŒG56 ‚3™‚삘•ŒRECLAIM‚þ™‚ì‚𘌠TIME-CALL‚Ô™‚삯™‚ì‚¡™‚ìY™‚ì+™9'˜ŒDRIBBLE˜•Œ PUTWINDOWPROP˜•ŒWFROMDS˜Œ IN-PACKAGE ‚Ꙃ嘌 TIMED-FORM‚“™‚‘‚ˆ™‚”}™‚—r™‚šc™‚™_˜•Œ 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¸Q¸Ho ¿Ho ¿Ho ¿Ho ¿Ho ¿Ho ¿Ho ¿Ho ¿HoR ™‚䘌 *FEATURES*™9‚ÿÿÿÿ™˜“˜“™‚嘌STREAM‚€™‚ìv™‚ìs˜ŒLONG-SITE-NAMEj™‚ìg˜ŒMACHINE-INSTANCE^™‚ì[˜ŒMACHINE-VERSIONR™‚ìO˜Œ MACHINE-TYPEF™‚ìC˜ŒSOFTWARE-VERSION:™‚ì7˜Œ 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É ™‚ ™‚ô˜“€ ˜ŒCLOSE˜ŒABORT ˜ŒGABRIELg™‚ ˜•Œ \PTRHUNK8‚‡˜–¿HÉ ¿Q gh ™‚䙂 ™‚ô˜“€™‚û ™‚ü™‚ý™‚ú™‚ÿ‚ƒ™‚ ˜•Œ \PTRHUNK6œ™?˜–‚Ñejó¥kh ¿gµW¸a¸gµh¹hºƒa¹iºgµ»a»gµk¼a¼h½¾_¿_¿noNO ¿@NOL ½OO ¿JšHoLI ¿HoOii ¿HOK ¿gOgOl gOl gOl h ˜Œ*TRACE-OUTPUT*™? ‚ÿÿÿÿ™˜“˜“˜ŒTIMED-FUNCTION˜Œ&KEY™™‚þ˜Œ DATA-TYPES˜ŒREPEAT‚Ę•Œ \GETBASEFIXP‚¸™‚X‚¬™‚X‚™˜Œ%PRINT-TIMING-INFO‚‘˜Œ%PRINT-TIMING-ITEM‚‚˜Œ TIME-FORMATu˜Œ%STATS-OBJECT-DIFFERENCEm˜•Œ\MVLISTj˜Œ%GET-TIMING-INFOa™‚^N˜ŒMAKE-STATS-OBJECTH™‚_D™‚_/˜•Œ DATATYPES™‚ð‚»˜ŒI/O‚¯˜ŒSWAP‚£˜ŒGC‚˜ŒTOTAL6™‚U(™‚T™‚þ ™‚‡˜Œ Elapsed time|˜Œ&Timing for ~[~;~:;~:* ~D x~]:~20T ~S~&X˜–h˜Œlambda in TIME-CALL™‚ô˜“€T™‚ œ™@˜–>h¸@¹hºI‘I°1ºHJ»h¼h½h¾K‚L°K¾L”MN&½„Nh]¼K»°ç ¸I¹°ÍH™@™˜“˜“˜Œ TIME-LIST3˜ŒUNION˜–o ¿o ¿o ˜Œ3 top-level forms™˜“€˜•ŒPUTPROPS ™‚r™‚r˜“™˜•Œ COPYRIGHT˜“˜ŒXerox Corporation‚ÂÄ ˜“™™K˜“™ ˜ŒXCL™ ˜“™˜ŒGABRIEL˜“™™J˜Œ COMPILE-FILEš‚ÿÿ),QãÊ£ÐëêlPÃ!À¼/ø),Ô â°#+)ÂÍ©€Ê@Ê:~|+ (DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "GABRIEL")) (IL:FILECREATED "12-Aug-88 10:33:17" ("compiled on " IL:{ERIS}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}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}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)) ; @H¹HZ»J¼IdgIgIgI ½gggOho