PDP-10.its/bin/librm4/tailor.fbin

'<PCODE "TAILOR">
<PACKAGE "TAILOR"> 

<ENTRY TAILOR TAILOR-COMMANDS OK-TO-APPLY OK-TO-EVAL OK-TO-RUN> 

<USE "CALRDR" "COMMAND" "CALSYM" "CALCOM" "CALUTL"> 

<SET ADDCOM-PROMPT 
"Type the name to be given to the new command or
the name of the command to be redefined."> 

<SET SPCCHR-PROMPT 
"Type the name of the special character that is
to be changed."> 

<SET SPCCHR-CPROMPT 
"Type the character to be used as the named
special character from now on."> 

<SET GET-STRING ["STRING"]> 

<SET GET-CHAR ["CHARACTER"]> 

<SET GET-SYM ["SYM"]> 

<SET INPCHR-NAMES <MAKEBST "Input.character.names" ["buffer.erase.character" 
BUFFERKILL "clear.screen-retype.buffer.character" CRETYPE "help.character" 
HELPCHAR "input.from.tty.character" INTTYCHAR "line.erase.character" LINEKILL 
"master.break.character" MASTER "multiple.value.character" MULTCHAR 
"new.line-retype.buffer.character" DRETYPE "possible.match.character" POSCHAR 
"quote.character" QUOTCHAR "return.to.previous.argument.character" ABORTCHAR 
"rubout.character" RUBCHAR "word.erase.character" WORDKILL]>> 

<SET OUTCHR-NAMES <MAKESST "output.character.names" ["exact.match.character" 
EXACT-MATCH-CHAR "partial.match.character" PARTIAL-MATCH-CHAR 
"no.match.character" NO-MATCH-CHAR]>> 

<SET BCHAR-NAMES <MAKESST "Break.group.names" ["confirmation.group" 1 
"completion.group" 2 "termination.group" 3 "non-symbol.termination.group" 4]>> 

<SET BREAK-LISTS [CONFIRMS COMPLETES TERMINS NSTERMS]> 

<SET TAILOR-COMMANDS <MAKEBST "Tailoring.commands" ["add.break.characters" '<
CALICO-COMMAND ,ADDBCHAR '[#SYMTABLE [SSTOPS ["confirmation.group" 1 
"completion.group" 2 "termination.group" 3 "non-symbol.termination.group" 4] 
"Break.group.names" #FALSE ()] "to" 
"Type the name of the break group to which the
new characters should be added." ["SYM"] [] "characters" 
"Type a string of characters to be added to
the named break group." ["STRING"]] '[1 ""]> "allow.applications" '<SETG 
OK-TO-APPLY T> "allow.evaluations" '<SETG OK-TO-EVAL T> "allow.inferiors" '<SETG
OK-TO-RUN T> "change.special.input.character" '<CALICO-COMMAND ,CHSPICHR '[#
SYMTABLE [BSTOPS ["buffer.erase.character" BUFFERKILL 
"clear.screen-retype.buffer.character" CRETYPE "help.character" HELPCHAR 
"input.from.tty.character" INTTYCHAR "line.erase.character" LINEKILL 
"master.break.character" MASTER "multiple.value.character" MULTCHAR 
"new.line-retype.buffer.character" DRETYPE "possible.match.character" POSCHAR 
"quote.character" QUOTCHAR "return.to.previous.argument.character" ABORTCHAR 
"rubout.character" RUBCHAR "word.erase.character" WORDKILL] 
"Input.character.names" #FALSE ()] "called" 
"Type the name of the special character that is
to be changed." ["SYM"] [] "to" 
"Type the character to be used as the named
special character from now on." ["CHARACTER"]]> 
"change.special.output.character" '<CALICO-COMMAND ,CHSPOCHR '[#SYMTABLE [SSTOPS
["exact.match.character" EXACT-MATCH-CHAR "partial.match.character" 
PARTIAL-MATCH-CHAR "no.match.character" NO-MATCH-CHAR] "output.character.names" 
#FALSE ()] "called" 
"Type the name of the special character that is
to be changed." ["SYM"] [] "to" 
"Type the character to be used as the named
special character from now on." ["CHARACTER"]]> "define.command.name" '<
CALICO-COMMAND ,ADDCOMMAND ['[] "named" .ADDCOM-PROMPT .GET-STRING ,COMTABLE 
"to act like" 
"Type the name of the old command that this new
command should behave like." .GET-SYM] '["" #FALSE ()]> "define.new.command" '<
CALICO-COMMAND ,ADDCOMMAND '[[] "named" 
"Type the name to be given to the new command or
the name of the command to be redefined." ["STRING"] [] "defined as" 
"Type the MUDDLE object that should be evaluated
whenever this command is executed." ["FORM"]] '["" #FALSE ()] "DON'T-EVAL"> 
"don't.allow.applications" '<SETG OK-TO-APPLY <>> "don't.allow.evaluations" '<
SETG OK-TO-EVAL <>> "don't.allow.inferiors" '<SETG OK-TO-RUN <>> 
"print.break.characters" '<PRTBCHAR> "print.special.characters" '<PRTSCHAR> 
"remove.break.characters" '<CALICO-COMMAND ,REMBCHAR '[#SYMTABLE [SSTOPS [
"confirmation.group" 1 "completion.group" 2 "termination.group" 3 
"non-symbol.termination.group" 4] "Break.group.names" #FALSE ()] "from" 
"Type the name of the break group from which
characters are to be removed." ["SYM"] [] "characters" 
"Type a string of characters to be removed
from the named break group." ["STRING"]] '[1 ""]> 
"set.command.level.full.prompt" '<CALICO-COMMAND <FUNCTION (A) <SETG PROMPT2 .A>
> '[[] "to" 
"Type the new string to be used as a top level prompt
at CALICO command level." ["STRING"]] '[""]> "set.command.level.normal.prompt" '
<CALICO-COMMAND <FUNCTION (A) <SETG PROMPT1 .A>> '[[] "to" 
"Type the new string to be used as the normal CALICO
command level prompt." ["STRING"]] '["@"]> "set.muddle.prompt" '<CALICO-COMMAND 
<FUNCTION (A) <SETG MUDPRM .A>> '[[] "to" 
"Type the new string to be used as the prompt for
the MUDDLE reader." ["STRING"]] '[":"]>]>> 

<SETG TAILOR  %<RSUBR!- '[ %<PCODE!- "TAILOR" 0> TAILOR #DECL ("VALUE" ATOM) 
ADDBCHAR RDBLOUT ADDTABLE READER-SILENCE OUTCHAN "Tailoring commands available."
 TAILOR-COMMANDS T BREAK-LISTS #FALSE () TEM " is not in that group." 
"Confirmation group contains: " %<RGLOC CONFIRMS T> 
"Completions group contains: " %<RGLOC COMPLETES T> 
"Termination group contains: " %<RGLOC TERMINS T> 
"Non-symbol termination group contains: " %<RGLOC NSTERMS T> MASTER (2 3 4) %<
RGLOC MASTER-STRING T> MULTCHAR %<RGLOC MULT-CR-MASTER T> %<RGLOC 
SPCCHAR-TEMPLATE T> %<RGLOC XSPCCHARS T> %<RGLOC SPCCHARS T> INPCHR-NAMES 
"Special input characters" "   " "Special output characters" OUTCHR-NAMES]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,TAILOR PGLUE ![0 0 0!]>> 

<SETG ADDBCHAR %<RSUBR-ENTRY '[TAILOR ADDBCHAR #DECL ("VALUE" ATOM FIX STRING)] 
37>> 

<SETG REMBCHAR %<RSUBR-ENTRY '[TAILOR REMBCHAR #DECL ("VALUE" ATOM FIX STRING)] 
100>> 

<SETG PRTBCHAR %<RSUBR-ENTRY '[TAILOR PRTBCHAR #DECL ("VALUE" FALSE)] 201>> 

<SETG CHSPICHR %<RSUBR-ENTRY '[TAILOR CHSPICHR #DECL ("VALUE" ATOM <OR ATOM 
FALSE> <OR LIST CHARACTER>)] 270>> 

<SETG CHSPOCHR %<RSUBR-ENTRY '[TAILOR CHSPOCHR #DECL ("VALUE" ATOM <OR ATOM 
FALSE> <OR LIST CHARACTER>)] 452>> 

<SETG PRTSCHAR %<RSUBR-ENTRY '[TAILOR PRTSCHAR #DECL ("VALUE" ATOM)] 472>> 

<AND <ASSIGNED? GLUE> .GLUE <PUT ,TAILOR GLUE ![17536586179 16310611200 
6174015488 5246976 5243920 201326659 16 -4293918720 3292529408 17103 12974034176
274009139 -13947056336 11865473200 -13102825216 68436993 -15035183087 787733 
30064836437 17251172400 9753074800 4468736 4764729344 12884914176 851968 4195331
17248372675 4346147589 21563971023 1074462720 -17167269817 25514163395 83887103 
2 524394 203 524564 524746 474!]>> 

<ENDPACKAGE>