mirror of
https://github.com/PDP-10/its.git
synced 2026-02-07 00:47:06 +00:00
175 lines
7.9 KiB
Plaintext
175 lines
7.9 KiB
Plaintext
'<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>
|