'<PCODE "EUTL">
<PACKAGE "EUTL"> 

<ENTRY DECLEXTRACT N-GET-RID-OF PARSEABLE MAKE-COPY PUSHRET PUSH-T NO-DUPES 
KEYWORD-CHARS PRINT-STATUS POS SYM-SORT MAKE-TABLE MYPPRINT CALL/APPLY AFIND 
AUTOBACKUP LOAD-ACTION OPEN-ACTION> 

<USE "EHACK" "CALSYM" "BUF" "TTY" "CALRDR" "NSTRUC" "STR" "LEVEL" "COMMAND"> 

<OR <LOOKUP "MULT" <ROOT>> <INSERT "MULT" <ROOT>>> 

<SETG LOAD-ACTION '<CALICO-COMMAND #FUNCTION ((TYP "TUPLE" X) <APPLY <1 <3 <MEMQ
.TYP ,TYPE-TABLE>>> !.X>) '[<COND (<LENGTH? <2 ,TYPE-COM-TABLE> 3> <PROG () <
COND (<NOT <GASSIGNED? OBJTYPE>> <ERROR USE-A-PACKAGE-DEFINING-A-TYPE!-ERRORS 
E.G.-AHACK-OR-IIEDIT!-ERRORS> <AGAIN>)>> <PRINT "of type"> <PRINC <PNAME ,
OBJTYPE>> <CHTYPE (,OBJTYPE) FALSE>) (,TYPE-COM-TABLE)> "of type" '[
"name the sort of object(s) you wish to load" ""] '["SYM"] [] "named" '[
"
Name of a file of objects to be loaded for composing" ""] '["FILE"] '[] 
"with group name (opt)" '[
"
Optional group name (as in GROUP-LOAD). This may be useful for dumping
your completed objects when you are finished" ""] '["ATOM"]]>> 

<SETG OPEN-ACTION '<CALICO-COMMAND ,OPEN-SOME-OBJECT [,OBJONLYTAB 
"of unique name" '["
Open the designated object for composing" ""] '["SYM"]]>> 

<SETG DECLEXTRACT  %<RSUBR!- '[ %<PCODE!- "EUTL" 0> DECLEXTRACT #DECL ("VALUE" 
LIST <OR VECTOR ATOM FORM> "OPTIONAL" <OR ATOM FALSE>) MAKE-COPY BUFCLEAR NPUT 
UPPERCASE BUFTOS ADDCHR BUFLENGTH ADD-WORDS RETYPE-BUFFER!-ICALRDR NNTH 
DECL-TEST SEARCH APPEND-NODE ADDSTRING TTY-SET BUFMAKE TTY-GET VERIFY LEVEL 
READER PPRINT BUFPRINT T () #FALSE () VECTOR (OR REST) MULT AUTO-MODE-ACT 
OUTCHAN "C" SCNAME " scratch (BUFFER): " ABUF NODE " (BUFFER): " %<TYPE-W 
BUFFER VECTOR> %<RGLOC OBJVECT T> %<TYPE-C SYMBOL VECTOR> OBJOPEN 
" first get objects: " %<RGLOC LOAD-ACTION T> LOAD " must open an object" %<
RGLOC OPEN-ACTION T> GROUP-LOOP #SYMTABLE [SSTOPS ["Group.automatic.mode" T 
"Open object" #FALSE ()] "LEAVERS" #FALSE ()] "Leave" [
"
If Group.automatic.mode, the entire group.automatic.mode will be flushed.
Otherwise, the open object will be flushed and the group.automatic mode will continue."
""] ["SYM"] "Illegal activation to GROUP.AUTOMATIC.MODE. Report to MARC." 
PSTATUS #FALSE ("Can't pop") STAT PUSH/POP-ACT %<TYPE-C BUFFER VECTOR> %<RGLOC 
OBJOPEN T> AUTONAME (ACTIVATION) (ANY) EDTD-STR LEVEL-BUF %<RGLOC TYPE-TABLE T> 
APPEND " scratch (BUFFER):
" CHRTABLE %<RGLOC CHARCATCHER T> %<RGLOC OBJTYPE T> EHACKBUFFER XKEYBREAKS 
PARSE-BREAKS STRING "Current LISTEN level: " "	Open abstract: " %<RGLOC 
UNAMEPOS T> "-none-" "Returning to " "LISTEN level: " "	Group automatic mode: " 
"Default" "	Automatic mode: " "	Node: " "	Scratch: "]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLEXTRACT PGLUE ![0 0 0 0 0 0!]>> 

<SETG AUTOBACKUP %<RSUBR-ENTRY '[DECLEXTRACT AUTOBACKUP #DECL ("VALUE" ANY 
"OPTIONAL" ANY ANY)] 349>> 

<SETG PBUFHEAD %<RSUBR-ENTRY '[DECLEXTRACT PBUFHEAD #DECL ("VALUE" FIX BUFFER 
CHARACTER)] 404>> 

<SETG N-GET-RID-OF %<RSUBR-ENTRY '[DECLEXTRACT N-GET-RID-OF #DECL ("VALUE" 
STRUCTURED STRUCTURED FIX FIX)] 478>> 

<SETG MAKE-TABLE %<RSUBR-ENTRY '[DECLEXTRACT MAKE-TABLE #DECL ("VALUE" VECTOR 
STRUCTURED)] 537>> 

<SETG AEXPAND %<RSUBR-ENTRY '[DECLEXTRACT AEXPAND #DECL ("VALUE" <LIST [REST <
PRIMTYPE VECTOR>]> <LIST [REST FIX]>)] 601>> 

<SETG SYM-SORT %<RSUBR-ENTRY '[DECLEXTRACT SYM-SORT #DECL ("VALUE" LIST LIST)] 
661>> 

<SETG AFIND %<RSUBR-ENTRY '[DECLEXTRACT AFIND #DECL ("VALUE" STRUCTURED ANY 
STRUCTURED)] 760>> 

<SETG MYPPRINT %<RSUBR-ENTRY '[DECLEXTRACT MYPPRINT #DECL ("VALUE" ANY ANY 
CHANNEL)] 831>> 

<SETG CALL/APPLY %<RSUBR-ENTRY '[DECLEXTRACT CALL/APPLY #DECL ("VALUE" ANY FORM 
ATOM)] 857>> 

<SETG AUTORET %<RSUBR-ENTRY '[DECLEXTRACT AUTORET #DECL ("VALUE" ANY "OPTIONAL" 
ANY ANY)] 935>> 

<SET PSTATUS ()> 

<SETG PUSHRET %<RSUBR-ENTRY '[DECLEXTRACT PUSHRET #DECL ("VALUE" FALSE 
"OPTIONAL" ANY CHARACTER)] 1062>> 

<SETG PUSH-T %<RSUBR-ENTRY '[DECLEXTRACT PUSH-T #DECL ("VALUE" <OR ATOM FALSE 
FIX STRING> "OPTIONAL" BUFFER CHARACTER)] 1178>> 

<SET PREFIX-CHRTABLE [!" ,PBUFHEAD !" ,AUTOBACKUP !" ,PUSH-T !" ,PUSHRET !"
 
,AUTORET !" <FUNCTION (BUF CHR) <PRINC 
"
     Standard Buffer Commands
   	ESC___	Returns from buffer
	^Q	Quotes the next character
	^X	Deletes current line
	^W	Deletes word back to separator
	^@	Clears buffer
	^E	Edit the buffer
	^F	Inserts a file into the buffer
	^D	Displays the buffer on next line
	^L	Clears the screen and displays the buffer
     Editing Commands
	
	Causes automatic mode to terminate, if running
		Causes automatic mode to backup one step, if running
		PUSHes (call to LISTEN)
		POPs (returns to last  call, printing current status)
		Prints this information (would you believe Verbose??)">>]> 

<SET PREFIX-XSPCCHARS '[!" <PUSH-T> !" <COND (<ASSIGNED? NODE> <PRINT <NNTH ,
OBJOPEN <1 <SEARCH .NODE>>>> <RETYPE-BUFFER!-ICALRDR T>) (<
RETYPE-BUFFER!-ICALRDR T>)> !" <AUTOBACKUP> !" <PUSHRET> !"
 <AUTORET> !" <
COND (<ASSIGNED? NODE> <EDIT-NODE .NODE> <ASSIGNED? FILLER-ACT> <LEGAL? .
FILLER-ACT> <RETURN T .FILLER-ACT>)>]> 

<SETG POS %<RSUBR-ENTRY '[DECLEXTRACT POS #DECL ("VALUE" <OR FALSE FIX> ANY 
STRUCTURED)] 1705>> 

<SETG KEYWORD-CHARS %<RSUBR-ENTRY '[DECLEXTRACT KEYWORD-CHARS #DECL ("VALUE" ANY
ANY "TUPLE" <TUPLE [REST LIST]>)] 1747>> 

<SETG CHARCATCHER %<RSUBR-ENTRY '[DECLEXTRACT CHARCATCHER #DECL ("VALUE" <OR 
BUFFER FALSE> BUFFER CHARACTER)] 1853>> 

<SETG DESEX %<RSUBR-ENTRY '[DECLEXTRACT DESEX #DECL ("VALUE" BUFFER BUFFER 
"OPTIONAL" BUFFER)] 1905>> 

<SETG ADD-WORDS %<RSUBR-ENTRY '[DECLEXTRACT ADD-WORDS #DECL ("VALUE" BUFFER ATOM
)] 2020>> 

<SETG PARSEABLE %<RSUBR-ENTRY '[DECLEXTRACT PARSEABLE #DECL ("VALUE" <OR FALSE 
ATOM> STRING)] 2100>> 

<SET PARSE-BREAKS <STRING <ASCII 0> <ASCII 9> <ASCII 10> <ASCII 13> <ASCII 27> <
ASCII 33> <ASCII 32>>> 

<SET XKEYBREAKS <MAPF ,STRING ,ASCII (13 9 10 32 <ASCII !",> <ASCII !".>)>> 

<SETG NO-DUPES %<RSUBR-ENTRY '[DECLEXTRACT NO-DUPES #DECL ("VALUE" ANY 
STRUCTURED)] 2189>> 

<SETG MAKE-COPY %<RSUBR-ENTRY '[DECLEXTRACT MAKE-COPY #DECL ("VALUE" ANY ANY)] 
2260>> 

<SETG PRINT-STATUS %<RSUBR-ENTRY '[DECLEXTRACT PRINT-STATUS #DECL ("VALUE" <OR 
ATOM FALSE> "OPTIONAL" <OR FALSE 'T>)] 2354>> 

<AND <ASSIGNED? GLUE> .GLUE <PUT ,DECLEXTRACT GLUE ![336613392 13757072401 
22085633 21475119375 21211988036 1376513 4299231573 1895825409 17825795 
-8854432432 4563404096 17251176516 22898017404 4369498176 18275635217 68230916 
4428926977 4294967296 18539872256 267280 22620934484 3260924 268436501 
18048905216 12898475123 -13957856452 -16336814076 0 1094713344 20480 5637144577 
0 32506885 65791 1409548480 262145 18589155344 4278452292 30408756 4294968336 
17246978053 21815644160 263105 22817030144 4101 17252226304 1049664 4304404496 
3317781772 -3488866435 20758712112 3242228992 17516483669 17180917760 
18017797628 471613439 -8518111217 -17150296975 -16647188480 4379120913 
17252548608 203223900 3295674880 7529242388 25220362245 66820 5659251716 815152 
4299620865 2150632451 7529235228 12852288 8594133056 24826552092 33405475964 
30586724592 30316429320 17322432 5638582272 -17179868196 3429941248 -17127640316
21944643623 4367447808 826752017 -17170382717 808193032 537658343 7633648640 
12889431040 -21433008127 21549286720 23555223552 12633168 1 1342177348 64 
1074249733 4195072 18022417 202129456 1073745920 5641338880 269533184 1141054464
4769071104 21543273920 -16970153727 5637144576 29470720 34076 7247893872 8406786
3292987394 2048 24696062976 738721857 22615932932 262175 22551724157 -2947279073
33554432256 22817030148 5368709120 16778240 335544336 18052284416 4362097664 
16777249 269488389 16 21543277888 -13941751028 -3757309172 -3460251520 
12892489484 -3237915391 22283264 -34351514617 3275493379 51179521 1191182400 768
7767855364 30281826576 18254725168 485736449 4366732528 285491217 50339059 
-17178753936 -13153267709 69703 3472888064 12885017557 17469362176 16777215 
262160 524300 372 262509 524651 524698 786918 262749 262809 525054 525125 525151
962 263099 525237 1085 263222 525364 1205 263340 525480 525999 526147 264063 
526205 264248 264337 2373 264511!]>> 

<ENDPACKAGE>