PDP-10.its/bin/librm1/buf.fbin

'<PCODE "2BUF">

<PACKAGE "BUF"> 

"A buffer is a VECTOR of two STRINGs.  The first points to the buffer,
the second to the first unused character in the buffer.

Entry points:

<ADDCHR buffer character>
	adds the character to the buffer.

<ADDCRLF buffer character>
	adds a line-feed to the buffer after the character.  (used in CHRTABLE).

<ADDFILE buffer channel --count-->
	inserts 'count' characters from file, or whole thing.

<ADDSTRING buffer string --count-->
	inserts 'count' characters or the whole string.

<ADD-OFFSET-STRING buffer string string>
	inserts the first string into the buffer, with the second
	string added as a prefix of each non-empty line.

BPRMPT1
BPRMPT2
	Manifest offsets for accessing prompts in buffer.

BUF-BITS
	A MACRO for playing with the BBITS field.  Takes a buffer, a
	bit, and (optionally) an atom or false.  If only two arguments,
	returns the current value (atom or false); if three, sets/clears
	the specified bit.

BUF-ECHO-FLAG
	If FALSE, echoes happen as usual.  If a fix, instead of echoing
	we erase <fix> characters, and setg buf-echo-flag to false.  If
	atom or applicable, apply to the character typed, the buffer,
	and outchan.

<BUFCLEAR buffer>
	clears buffer.

<BUFGROW buffer count>
	grows buffer by count characters.

<BUFLENGTH buffer>
	return number of characters in buffer.

<BUFMAKE count \"OPT\" prompt1 prompt2>
	makes a buffer of length count, with prompts of prompt1 and prompt2.

<BUFPRINT buffer --channel-- prompt? redisp?>
	efficient buffer printer of buffer to (optional) channel.  The
	characters in the buffer are printed, without regard to MUDDLE
	escape characteristics (i.e., double-quote will not be preceded
	by a back-slash).  For printing as a string, see 'BUFSPRINT'.

BUFSIZE
	free variable, amount to grow by if not given.

<BUFSPRINT buffer --channel-->
	prints a buffer on an (optional) channel (default .OUTCHAN).
	The function prints the buffer as a string, 'escaping' the
	characters double-quote and back-slash so that the the string
	may be read correctly as a MUDDLE object.

<BUFTECO buffer character>
	function which applies TECO to a buffer.  May be used in
	CHRTABLE, and is default control-E function.

<BUFTOS buffer>
	uses EXTRACT to generate a string whose length is the number of
	characters in the buffer.

CHRTABLE
	initial table,
	ESC___	Returns from GETSTR (via GETSTRACT)
	^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
	^P	Undo the last major deletion
	^T	Re-enter TECO without munging its buffer
	^D	Displays the buffer on next line
	^L	Clears the screen and displays the buffer

<DELCHR buffer character>
	returns deleted character or FALSE.  Applies <GVAL DELPRINT> to
	the character, unless DELPRINT is false.  Initial GVAL of DELPRINT
	is IMDEL.

<DELPRINT character>
	GVAL applied to chars when deleted, unless GVAL is FALSE.

<DELTOCH buffer string \"OPT\" <or false string>>
	deletes characters from buffer till member of string is deleted.
	Returns # of chrs deleted.  If optional string present, prints
	it (followed by crlf) rather than echoing deleted characters on
	non-display.

<DEL-TO-EOL>
	sends delete-to-end-of-line stream (ctl-P L) to system.

DISPLAY?
	T if console is an erasable display.

<DLINE buffer>
	deletes the current line from the buffer.  The separator
	(initially ,LINEBRKS contains CR__ only) is not deleted.

<DWORD buffer>
	deletes one 'word' in the buffer back from current point
	till a member of ,WORDBRKS is encountered.  The separator is
	not deleted.

<FILEINP>
	asks for file names, inputs the file.

FORMATEFFS
	string of format-effector chars.

<GET-CPOS \"OPT\" channel>
	Reads the cursor position on the channel (it better be open
	on something where that's meaningful) and updates the channel's
	position indicators.  Used internally after SIOTs and such, which
	don't change the data stored in the channel.

<GETSTR buffer --table-->
	reads a string from the tty into the buffer (arg1).  The
	processing for characters is defined by a dispatch table
	(default .CHRTABLE). This argument is a structured object of
	pairs.  The first element is a character, the second an
	applicable object which is applied to the buffer and the
	character, whenever that character is seen.  GETSTR sets up a
	special activation which is bound to the atom GETSTRACT.  This
	activation marks the repeat loop, and thus may be returned from
	to get out of GETSTR.  GETSTR returns the buffer.

GETSTRACT
	GETSTR's activation, special.

<HPOS-BUF buffer>
	takes a BUFFER and does a horizontal position to the calculated
	end of the last line.  For deletions, etc.

<IBUFCLEAR buffer character>
	clears the buffer and does '<BUFPRINT ..>.

<IBUFPRINT buffer character>
	clears screen if character is Form-feed.  Then prints the buffer.

<IDELCHR buffer character>
	deletes on character and returns it, or FALSE if buffer empty.
	(Used in CHRTABLE).

<IMDEL>
	knows how to delete chars from display.  Uses GVAL of DISPLAY? to
	determine whether applicable.

<INIT>
	initializes defaults, setgs DISPLAY?.

<IOT \"OPTIONAL\" word channel character>
	Does IOT on channel (default ,INCHAN) with bits as given by word.
	Character is only useful on output.  Returns character

<ISDISPLAY?>
	returns T if console is an erasable display.

LINEBRKS

<MY-TTY-OFF>
	see 'TTY ORDER' on .INFO.; also NDR;TTY-ON (et al).

<QUOTECHR buffer character>
	quotes the next character by calling IOT, thus escaping the
	normal dispatch through GETSTR.  The function assumes the TTY
	environment has been set up correctly. (see MY-TTY-OFF).

<RCPOS \"OPT\" channel>
	Returns first value of RCPOS on channel (default ,INCHAN).

REENTER-TECO-CHAR
	character that means reenter TECO without munging its buffer.

<SIOT string \"OPT\" word channel fix>
	Does SIOT on channel of string, with control bits as set by
	word.  Returns string, probably rested.  Interruptable during
	SIOT.  Fix is # chars to print, default to entire string.

TECO-PROGRAM
	a string which is what BUFTECO will use to try to load the
	inferior TECO.

<TTY-GET uv \"OPT\" channel>
	Does TTY-GET into supplied uv.

<TTY-SET uv \"OPT\" channel>
	Does TTY-SET from supplied uv.

<TTY-POS character fix>
	takes a char (H or V) and a FIX, does ctl-P to set cursor
	position in system.

TTY1
TTY2
	these are words which MY-TTY-OFF uses too pass to
		TTY-SET.  TTY-SET sets the way the system handles
		characters for you -- echoing, interrupting and
		activating may be specified for classes of characters.
		each class has a field in either TTY1 or TTY2.

<UNKILL buffer chr>
	Undoes the last `major' deletion (word or more) from the buffer.
	If nothing there, no effect.  CHR is ignored.

WORDBRKS
	strings of breaks to be used in deletion
" 

\ 

<ENTRY ADDCHR ADDCRLF ADDFILE ADDSTRING ADD-OFFSET-STRING BPRMPT1 BPRMPT2 
BUF-BITS BUF-BIT-PROMPT BUF-CTL-G? BUF-CTL-S? BUF-ECHO-FLAG BUFCLEAR BUFFER 
BUFGROW BUFLENGTH BUFMAKE BUFPRINT BUFSIZE BUFSPRINT BUFTECO BUFTOS CHRTABLE 
DELCHR DELPRINT DELTOCH DEL-TO-EOL DISPLAY? DLINE DWORD FILEINP FORMATEFFS 
GET-CPOS GETSTR GETSTRACT HPOS-BUF IBUFCLEAR IBUFPRINT IDELCHR IMDEL INIT IOT 
ISDISPLAY? LINEBRKS LINESTARVE MY-TTY-OFF QUOTECHR RCPOS REENTER-TECO-CHAR SIOT 
TECO-PROGRAM TTY-GET TTY-SET TTY-POS TTY1 TTY2 UNKILL WORDBRKS> 

<USE "MUDTEC" "INFERIOR"> 

<SETG IOT  %<RSUBR!- '[ %<PCODE!- "2BUF" 0> IOT #DECL ("VALUE" CHARACTER 
"OPTIONAL" <PRIMTYPE WORD> CHANNEL CHARACTER) ADDSTRING INF-RESULT 
TECO-READ-BUFFER TECO-BUFFER-SIZE INF-CONTIN TECO-CLOSE TECO-OPEN TECO-ALLOC 
TECO-KILL INF-START TECO-LOAD %<RGLOC INCHAN T> %<RGLOC OUTCHAN T> %<TYPE-W 
BUFFER VECTOR> %<RGLOC BUFSIZE T> %<RGLOC DISPLAY? T> %<RGLOC IMDEL T> %<RGLOC 
DELPRINT T> T OUTCHAN "TTY" "-continued-" "
" (CHANNEL) "\\\"" "\\\\" %<TYPE-W INF VECTOR> ![*BREAK-16 *VALUE!] %<RGLOC 
REENTER-TECO-CHAR T> TECO %<RGLOC TECO T> %<TYPE-C INF VECTOR> "C" 
"You are starting " %<RGLOC TECO-PROGRAM T> 
" for the first time.  If your INIT
is unconventional, you may have to exit with ^C, ^K
or their equivalents (not ^Z!) after it begins listening.
" "Control-Z before ready? " " edit aborted.
" "Back to " "An empty string was returned from " 
".
The buffer has been left unchanged.
" "DONE" ^Z-TYPED "Please return from " 
" with ^C, ^K, or their equivalents.
Please re-enter with ^" ".
You could get yourself into a bad state.
" "An error occurred in returning from " ": " 
" was not able to start up successfully: " (*BREAK-16 :KILL) *VALUE ":KILL" %<
RGLOC TTY1 T> %<RGLOC TTY2 T> %<RGLOC TUV T> GETSTRACT OLD-TTY %<RGLOC 
GLOBL-GETSTR-HAND T> ERROR!-INTERRUPTS INTERRUPT ELSE %<RGLOC GLOBL-GETSTR-CHAND
T> %<RGLOC BUF-CTL-G? T> %<RGLOC BUF-CTL-S? T> #DISMISS T CHRTABLE DELPRINT (
ACTIVATION) %<RGLOC BUF-ECHO-FLAG T> %<RGLOC WORDBRKS T> %<RGLOC LINEBRKS T> 
" XXX?" "X" "S" "R" "L" "U" %<RGLOC GARBS T> "<22>" "File-name: " "READ" "DSK:" "[File-Input Aborted]" "[DONE]" 
ARG-WRONG-TYPE!-ERRORS ADDSTRING ""]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,IOT PGLUE ![715827967 -1 -1 -1 -1 0!]>> 


<SETG SIOT %<RSUBR-ENTRY '[IOT SIOT #DECL ("VALUE" STRING STRING "OPTIONAL" <
PRIMTYPE WORD> CHANNEL FIX)] 38>> 

<SETG RCPOS %<RSUBR-ENTRY '[IOT RCPOS #DECL ("VALUE" FIX "OPTIONAL" CHANNEL)] 
102>> 

<SETG TTY-GET %<RSUBR-ENTRY '[IOT TTY-GET #DECL ("VALUE" <UVECTOR [REST <
PRIMTYPE WORD>]> UVECTOR "OPTIONAL" CHANNEL)] 125>> 

<SETG TTY-SET %<RSUBR-ENTRY '[IOT TTY-SET #DECL ("VALUE" UVECTOR UVECTOR 
"OPTIONAL" CHANNEL)] 149>> 

<NEWTYPE BUFFER VECTOR '<<PRIMTYPE VECTOR> [4 STRING] FIX <PRIMTYPE WORD> STRING
FIX>> 

<SETG BPRMPT1 3> 

<SETG BPRMPT2 4> 

<SETG INITIAL-HPOS 5> 

<SETG BBITS 6> 

<SETG BSAVED 7> 

<SETG BSAVED-MAX 8> 

<MANIFEST BPRMPT1 BPRMPT2 INITIAL-HPOS BBITS BSAVED BSAVED-MAX> 

"If this bit is on, print a new prompt on every cr" 

<SETG BUF-BIT-PROMPT 0> 

<MANIFEST BUF-BIT-PROMPT> 

<SETG TJDIS 2048> 

<MANIFEST TJDIS> 

<SETG REENTER-TECO-CHAR !\> 

<SETG FORMATEFFS <MAPF ,STRING ,ASCII [13 10 14 9 32 8]>> 

<SETG WORDBRKS <STRING <ASCII 13> <ASCII 10> "	, ;:.">> 

<SETG LINEBRKS <STRING <ASCII 13> <ASCII 10>>> 

<SETG BUFSIZE 200> 

<SETG BUF-ECHO-FLAG <>> 

<GDECL (INCHAN) CHANNEL (DISPLAY?) <OR ATOM FALSE> (FORMATEFFS) STRING (BUFSIZE)
FIX (OLD-TTY) UVECTOR> 

<SETG ADDCHR %<RSUBR-ENTRY '[IOT ADDCHR #DECL ("VALUE" BUFFER BUFFER CHARACTER)]
215>> 

<DEFMAC BUF-BITS ('BUF 'BIT "OPTIONAL" 'NEW) <FORM BIND ((B .BUF) (BIT .BIT)) #
DECL ((B) BUFFER (BIT) <PRIMTYPE WORD>) <COND (<ASSIGNED? NEW> <FORM PUT <FORM 
LVAL B> ,BBITS <FORM PUTBITS <FORM BBITS <FORM LVAL B>> <FORM BITS 1 <FORM LVAL 
BIT>> <FORM COND (.NEW 1) (0)>>>) (T <FORM 1? <FORM CHTYPE <FORM GETBITS <FORM 
BBITS <FORM LVAL B>> <FORM BITS 1 <FORM LVAL BIT>>> FIX>>)>>> 

<SETG BUFGROW %<RSUBR-ENTRY '[IOT BUFGROW #DECL ("VALUE" BUFFER BUFFER 
"OPTIONAL" FIX)] 244>> 

<SETG INIT %<RSUBR-ENTRY '[IOT INIT #DECL ("VALUE" ATOM)] 320>> 

<SETG BUFTOS %<RSUBR-ENTRY '[IOT BUFTOS #DECL ("VALUE" STRING BUFFER)] 341>> 

<SETG DELCHR %<RSUBR-ENTRY '[IOT DELCHR #DECL ("VALUE" <OR CHARACTER FALSE> 
BUFFER)] 364>> 

<SETG BUFPRINT %<RSUBR-ENTRY '[IOT BUFPRINT #DECL ("VALUE" FIX BUFFER "OPTIONAL"
CHANNEL <OR ATOM FALSE> <OR ATOM FALSE>)] 465>> 

<SETG DOSPRINT %<RSUBR-ENTRY '[IOT DOSPRINT #DECL ("VALUE" STRING STRING ANY 
"OPTIONAL" <OR ATOM FALSE> FIX)] 679>> 

<SETG GET-CPOS %<RSUBR-ENTRY '[IOT GET-CPOS #DECL ("VALUE" CHANNEL "OPTIONAL" 
CHANNEL)] 752>> 

<SETG BUFSPRINT %<RSUBR-ENTRY '[IOT BUFSPRINT #DECL ("VALUE" BUFFER BUFFER 
"OPTIONAL" CHANNEL)] 791>> 

<SETG FIRST-OF %<RSUBR-ENTRY '[IOT FIRST-OF #DECL ("VALUE" <OR FALSE STRING> 
STRING STRING "OPTIONAL" FIX)] 918>> 

<SETG BUFLENGTH %<RSUBR-ENTRY '[IOT BUFLENGTH #DECL ("VALUE" FIX BUFFER)] 992>> 

<SETG BUFCLEAR %<RSUBR-ENTRY '[IOT BUFCLEAR #DECL ("VALUE" BUFFER BUFFER)] 1007>
> 

<SETG DELTOCH %<RSUBR-ENTRY '[IOT DELTOCH #DECL ("VALUE" FIX BUFFER STRING 
"OPTIONAL" <OR STRING FALSE>)] 1024>> 

<SETG SAVE-KILL %<RSUBR-ENTRY '[IOT SAVE-KILL #DECL ("VALUE" BUFFER BUFFER <OR 
STRING FALSE>)] 1231>> 

<SETG UNKILL %<RSUBR-ENTRY '[IOT UNKILL #DECL ("VALUE" BUFFER BUFFER CHARACTER)]
1330>> 

<SETG TECO-PROGRAM "T"> 

<SETG BUFTECO %<RSUBR-ENTRY '[IOT BUFTECO #DECL ("VALUE" BUFFER BUFFER 
"OPTIONAL" CHARACTER)] 1365>> 

<SETG TTY1 #WORD *020202020202*> 

<SETG TTY2 #WORD *030202020202*> 

<SETG TUV <IUVECTOR 3 #WORD *000000000000*>> 

<SETG MY-TTY-OFF %<RSUBR-ENTRY '[IOT MY-TTY-OFF #DECL ("VALUE" UVECTOR 
"OPTIONAL" WORD WORD)] 1830>> 

<SETG ERRFCN %<RSUBR-ENTRY '[IOT ERRFCN #DECL ("VALUE" ANY FRAME "TUPLE" ANY)] 
1872>> 

<SETG BUF-CTL-G? T> 

<SETG BUF-CTL-S? T> 

<GDECL (BUF-CTL-G? BUF-CTL-S?) <OR ATOM FALSE>> 

<SETG CHARFCN %<RSUBR-ENTRY '[IOT CHARFCN #DECL ("VALUE" <OR DISMISS FALSE> 
CHARACTER CHANNEL)] 1956>> 

<OFF <SETG GLOBL-GETSTR-HAND <ON "ERROR" ,ERRFCN 3 0>>> 

<OFF <SETG GLOBL-GETSTR-CHAND <ON "CHAR" ,CHARFCN 7 0 ,INCHAN>>> 

\ 

<SETG GETSTR %<RSUBR-ENTRY '[IOT GETSTR #DECL ("VALUE" BUFFER BUFFER "OPTIONAL" 
<OR <LIST [REST VECTOR]> VECTOR> <OR STRING FALSE> STRING)] 2070>> 

<SETG SPECIAL-CHAR? %<RSUBR-ENTRY '[IOT SPECIAL-CHAR? #DECL ("VALUE" <OR FALSE 
VECTOR> CHARACTER <OR VECTOR <LIST [REST VECTOR]>>)] 2370>> 

<SETG DWORD %<RSUBR-ENTRY '[IOT DWORD #DECL ("VALUE" FIX BUFFER CHARACTER)] 2433
>> 

<SETG DLINE %<RSUBR-ENTRY '[IOT DLINE #DECL ("VALUE" FIX BUFFER CHARACTER)] 2453
>> 

<SETG QUOTECHR %<RSUBR-ENTRY '[IOT QUOTECHR #DECL ("VALUE" BUFFER BUFFER 
CHARACTER)] 2475>> 

<SETG ADDCRLF %<RSUBR-ENTRY '[IOT ADDCRLF #DECL ("VALUE" BUFFER BUFFER CHARACTER
)] 2520>> 

<SETG IDELCHR %<RSUBR-ENTRY '[IOT IDELCHR #DECL ("VALUE" <OR CHARACTER FALSE> 
BUFFER CHARACTER)] 2587>> 

<SETG IMDEL %<RSUBR-ENTRY '[IOT IMDEL #DECL ("VALUE" <OR CHARACTER FIX> BUFFER <
OR CHARACTER FIX>)] 2602>> 

<SETG DEL-TO-EOL %<RSUBR-ENTRY '[IOT DEL-TO-EOL #DECL ("VALUE" STRING)] 2734>> 

<SETG LINESTARVE %<RSUBR-ENTRY '[IOT LINESTARVE #DECL ("VALUE" STRING)] 2750>> 

<SETG IBUFCLEAR %<RSUBR-ENTRY '[IOT IBUFCLEAR #DECL ("VALUE" BUFFER BUFFER 
CHARACTER)] 2766>> 

<SETG IBUFPRINT %<RSUBR-ENTRY '[IOT IBUFPRINT #DECL ("VALUE" FIX BUFFER 
CHARACTER)] 2789>> 

<SETG GARBS "H"> 

<SETG TTY-POS %<RSUBR-ENTRY '[IOT TTY-POS #DECL ("VALUE" FIX CHARACTER FIX)] 
2834>> 

<SETG BACKS %<RSUBR-ENTRY '[IOT BACKS #DECL ("VALUE" <OR FALSE STRING> STRING 
STRING)] 2887>> 

<SETG HPOS-BUF %<RSUBR-ENTRY '[IOT HPOS-BUF #DECL ("VALUE" FIX BUFFER "OPTIONAL"
<OR ATOM FALSE>)] 2937>> 

<SETG FILEINP %<RSUBR-ENTRY '[IOT FILEINP #DECL ("VALUE" BUFFER BUFFER 
"OPTIONAL" CHARACTER)] 3058>> 

<SETG PADDSTRING %<RSUBR-ENTRY '[IOT PADDSTRING #DECL ("VALUE" BUFFER BUFFER 
STRING)] 3318>> 

<SETG ADDSTRING %<RSUBR-ENTRY '[IOT ADDSTRING #DECL ("VALUE" BUFFER BUFFER 
"TUPLE" <TUPLE [REST <OR STRING CHARACTER FIX>]>)] 3341>> 

<SETG ADD-OFFSET-STRING %<RSUBR-ENTRY '[IOT ADD-OFFSET-STRING #DECL ("VALUE" 
BUFFER BUFFER STRING STRING)] 3459>> 

<SETG ADDFILE %<RSUBR-ENTRY '[IOT ADDFILE #DECL ("VALUE" BUFFER BUFFER CHANNEL 
"OPTIONAL" FIX)] 3554>> 

<SETG ISDISPLAY? %<RSUBR-ENTRY '[IOT ISDISPLAY? #DECL ("VALUE" <OR ATOM FALSE>)]
3721>> 

<SET CHRTABLE [!\ ,BUFTECO !\ ,BUFTECO !\ ,FILEINP !\<5C>,IDELCHR <ASCII 13>
,ADDCRLF <ASCII 12> ,IBUFPRINT !\ ,IBUFPRINT !\ ,UNKILL !\ ,QUOTECHR !\ 
<FUNCTION (BUF CHR) <RETURN .BUF .GETSTRACT>> !\ ,DLINE !\ ,DWORD !\ ,
DLINE <ASCII 0> ,IBUFCLEAR]> 

<SETG BUFMAKE %<RSUBR-ENTRY '[IOT BUFMAKE #DECL ("VALUE" BUFFER FIX "OPTIONAL" 
STRING STRING)] 3739>> 

<SETG BUFFER-PRINT %<RSUBR-ENTRY '[IOT BUFFER-PRINT #DECL ("VALUE" ANY BUFFER)] 
3805>> 

<PRINTTYPE BUFFER ,BUFFER-PRINT> 

<ENDPACKAGE>