Google
 

Trailing-Edge - PDP-10 Archives - steco_19840320_1er_E35 - 10,5676/teco/macros/iteco.tco
There is 1 other file named iteco.tco in the archive. Click here to see a list.
!; written by Robert Holden	Oct. 1981				!
!; This is a demo TECO macro which uses FC tables to implement an	!
!; immediate mode TECO.							!
!; Many extra editting commands are included when this is EI'ed.	!
!; To actually turn immediate mode on, type "ME$$" after "EIfile".	!
!; There are several modes of operation:				!
!;	FC_TABLE_NORMAL	- Normal teco commands to execute immediately	!
!;	FC_TABLE_INSERT	- Implements INSERT mode with editting		!
!;	FC_TABLE_SEARCH	- Implements immediate searches			!
!;	FC_TABLE_PSEUDO	- extended commands for this macro		!
!;									!
!; The routine name stored in Q-reg % will be called with the		!
!; arguments m,n when the user uses "s", "^W", or "^E" commands.	!
!; One such routine is "case_inversion"					!
!;									!
!;Programming notes:							!
!;  There are two different ways of using this macro.  When it is first	!
!;  EI'ed, it only enables the extended editing characters in q-regg	!
!;  (fc_table_pseudo), and loads Q-register E for a possible ME command.!
!;  As much as possible has been delayed for execution, by placing it	!
!;  into E, making the initial EI more efficient, and the core size	!
!;  smaller.  The unfortunate disadvantage is that is tends to make the	!
!;  code unintelligible. 						!
!;									!
!;  As error-messages are displayed on the bottom of the screen, we must!
!;  set up auto-buffer to clear the messages.  As it is extra overhead,	!
!;  we disable it by zeroing auto-count while in "insert" mode.		!
!;									!
!;  "Insert" & "Change" modes are different sides of the same thing.	!
!;  When one is selected, the master FC table is edited as necessary	!
!;  by fc_change_change(for change mode) & fc_change_insert(for insert)	!
!;									!
!;									!
!;  Selecting modes, like INSERT,SEARCH,etc. is accomplished by PUSHing	!
!;  the current FC table, and enabling another(FC(q-reg)PUSH).  As TECO	!
!;  has a fair amount of work to do interpretting tables, we take as	!
!;  much advantage as possible of saving "compiled" tables.		!  
!;									!
!; Recall single letter Q-regs are allowed inside of long Q-reg names.	!

!; Initialize!
0U* -1EC			!; Clear Q-reg *, and make TECO smaller!
E?current-text-buffer$U1	!; Save name of current text buffer!
0,0Xa				!; Initialize text Q-regs, initialize A!
0,0X%				!; 'routine' q-reg!
0,0Xk				!; and K - kill buffer!

E.(separator)	!; Default screen separator, if needed!
Z"E I`	-`	^(.)`	-`	-`	|`	-`	-`	(..)v`	-$'

!;
Define the FC tables, NORMAL first:!

E.(fc_table_normal)		!; Make fc_table_normal the text-buffer!
HK @I#^T			!; Clean it, use powerful, delimited insert!

 ANY:("C","c")	: {$FC(fc_save_insert)PUSH$		!; Enable new FC table!
		   ^R^R{Change^R^R}U(command-prompt)	!; set new prompt!
    		   0U(insert_flag)			!; Set flag for change!
		   Q(auto-count)U(save_count) 0U(auto-count) !; Disable auto command!
		   FC(fc_change_change)REPLACE$}	!; Edit FC table for change mode, rather than insert!

 ANY:("I","i")	: {$FC(fc_save_insert)PUSH$		!; Enable new FC table!
		   ^R^R{Insert^R^R}U(command-prompt)	!; Set new prompt!
		   1U(insert_flag)			!; Set flag for insert!
		   Q(auto-count)U(save_count) 0U(auto-count) !; disable!
		   FC(fc_change_insert)REPLACE$}	!; Edit table do insert chars, rather than change them!

 "`	"	: {I					!; Insert the <tab>!
		  ^R^R{I^R^R}U(terminal-input-buffer)}	!; force an insert command!

 ANY:("S","s")	: {$.U(search_start)			!; save start point!
		  0U(search_length) 0,0X(search_string) !; Clear these!
		  FC(fc_save_search)PUSH$		!; Enable new FC table!
		  ^R^R{Search^R^R}U(command-prompt)}	!; and set the prompt!

 "^Z"		: {$42U(command-prompt)			!; Restore prompt "*"!
		   FCREMOVE$				!; Remove FC table!
		  :M(screen)"F 21,24E`$(command-buffer)'} !; Restore screen!

 ANY:("A","D","J","K","L","R","a","d","j","k","l","r") |
  ANY:("+","-","0"-"9")+ ANY:("D","J","K","L","R","d","j","k","l","r") |
  ANY:("Z","z") ANY:("J","j") |
  ANY:("G","g") ALPHABETIC | ANY:("X","x") ALPHABETIC |
  ANY:("M","m") ALPHABETIC
		: {M(execute)}		!; execute these as normal commands!

 ANY:("V","v")	: {$0,0X% ^R^R{case_flag^R^R}M(toggle_flag)"N	!; Toggle flag,routine!
			  ^R^R{case_inversion ^R^R}U%'
			M(tell_status)			!; Update status!
		}

 "^W"		: {$.U0 :FW$ :Q0,.W(^G%)}	!; Move word with optional routine call!

 "^X?"		: {$:EP DSKB:ITECO.HLP[34,43,TEC]/NODEFAULT$"S
		  EVREFRESH$ EVOFF$ Q*=  0U* ^A--cont--^A ^R^T$ :EVON$'}
#$				!; Terminate the insert!


!;
Define FC tables: INSERT/CHANGE					!
!;									!

E.(fc_table_insert) HK @I#^T	!; Start the insert!
	"$"		: {$Q(save_count)U(auto-count)	!; Exit command!
			  FCPOP$ M(tell_status)		!;  restore state!
			  300,-1^R^T-^R^O33"E ^R^T$'}	!; If $$, eat one!

	"^B"		: {$R}				!; Back character!

	"^D"		: {$^D}				!; Down line!

	DELETE | "^H"	: {$-D}				!; Delete character!

	"^G" ALPHANUMERIC |				!; Fetch Q-register!
		"^G(" ANY:(" "-"(","+"-"z")+ ")"
			: {U0 I^G0$}

	"^W"		: {$.U0 :R$:0FW"S .,Q0K'}	!; Delete word!

	VALUE:22	: {$:-3^R^T ^R^TI:-4^R^T}	!; "^R" quote char!

	VALUE:25	: {$0K}				!; "^U" Delete line!

	VALUE:30 ANY:("O","o") :{$			!; "^XO" Open line!
		I^M^J$ 2R}

	VALUE:30 VALUE:30 : {$Q(insert_flag)"N		!; "^X^X" Toggle modes!
	  ^R^R{Change^R^R}U(command-prompt) 0U(insert_flag) FC(fc_change_change)REPLACE$'"F
	  ^R^R{Insert^R^R}U(command-prompt) 1U(insert_flag) FC(fc_change_insert)REPLACE$'}

	OTHER		: {}				!; Will be REPLACED!

	!; EMACish commands!
	"^E"		: {$L 2R}			!; Move to EOL!
	"^F"		: {$C}				!; advance a character!
	"^X^L"		: {$ EVrefresh$}		!; refresh command!
#$		!; End the insert!

!;
Define FC tables: SEARCH						!
!;									!
E.(fc_table_search) HK @I#^T				!; Start the insert!
	"$"		: {$ FCPOP$ Q(search_length)"E :S$ $'
			:Q(search_start),.M(^R^G%) M(tell_status)
			  300,-1^R^T-^R^O33"E ^R^T$'}	!; If $$, eat one!

	"^G^G"		:{$ ^R^R{HK^R^R}W(edit_search_string)}

	"^G" ALPHANUMERIC |				!; Fetch Q-register!
		"^G(" ALPHANUMERIC+ ")"
			: {U0 ^R^R{I^G0$^R^R}W(edit_search_string)}

	"^B" | "^H" | DELETE: {$^R^R{:-D$^R^R}W(edit_search_string)}

	"^U"		: {$^R^R{0K^R^R}W(edit_search_string)}

	"^W"		: {$ ^R^R{:R$:0FWZK^R^R}W(edit_search_string)}

	OTHER		: {U0 ^R^R{^G(search_string)^G0^R^R}U(search_string)
			 %(search_length) W(do_search)}
			!; Note use of string concatenation!
#	!; End the insert!

!;
Define FC tables: PSEUDO	Extended TECO commands			!
!;									!

E.(fc_table_pseudo) HK @I@^T	!; Start the insert!

 !; Cursor Movement functions!
	"^R^R"	: {$:R:0FW}			!; Move back one word	!

 !; Change display functions						!
	"#"	: {$				!; Toggle split screen!
		^R^R{flag_split^R^R}M(toggle_flag)	!; Toggle the flag!
		"N E.(..) 1,9E`$(.) 10,10E`$(separator) 11,20E`$(..) 1U(flag_|)
		'"F E.(.) 1,20E`$(text-buffer) 0U(flag_|)'}

	"|"	: {$				!; Toggle E.(.)/E.(..)!
		E.(..)				!; Back to (..), just in case!
		^R^R{flag_|^R^R}M(toggle_flag)	!; Toggle flag, and check it!
		"E E.(.)'}			!; Suppose to be (.)?  Do it!

 !; Move pointer functions!
	"^E"	: {$				!; Go to end of line!
		.U0				!; Save current position!
		L 1A"N R'			!; Move up to EOL char!
		0A-13"E R'			!; If a ^M^J, backup over ^M!
		:Q0,.W(^G%)' }			!; Invoke user function!

	"^X^E"	: {$				!; Go to end of sentence!
	       .U(0)				!; Save where we are!
	       S^N^E[^ED,^EL]			!; Find NOT(digit,eol)!
		^E[.,!,?,:]$			!;  following punc. char!
	       :Q0,.M(^R^G%)}			!; Perform user function!

	"'"	: {$				!; Move down 1 screen	!	
		E?display-lines$U1U2		!; Get current screen position!
		E?screen-address$U3U4		!; Get pointers screen address!
		(Q2-Q3)+			!; Cursor distance from bottom!
		((Q2-Q1)/2)+			!; plus 1/2 screen size!
		1^D}				!; and move down enough to!
						!; center new position!

	""""	: {$				!; Move up 1 screen	!
		E?display-lines$U1U2		!; Get current screen position!
		E?screen-address$U3U4		!; Get pointers screen address!
		(Q1-Q3)-			!; Cursor distance from top!
		((Q2-Q1)/2)-			!; plus 1/2 screen size!
		1^D}				!; and move up enough to!
						!; center new position!

	ANY:("B","b") "^J" : {$			!; Move pointer to top	!
		E?display-lines$U1U2		!; Get current screen position!
		E?screen-address$U3U4		!; Get pointers screen address!
		Q1-Q3^D}			!; Move up to top!

	".^J"		: {$			!; Move pointer to middle!
		E?display-lines$U1U2		!; Get current screen position!
		E?screen-address$U3U4		!; Get pointers screen address!
		((Q2-Q1)/2			!; Calculate 1/2 screen size!
		+Q1+1)				!; Get desired screen line!
		-Q3^D }				!; Move delta distance!

	ANY:("Z","z") "^J" : {$			!; Move pointer to bottom!
		E?display-lines$U1U2		!; Get current screen position!
		E?screen-address$U3U4		!; Get pointers screen address!
		Q2-Q3^D}			!; Move necessary amount!

 !; Common editting functions!
	"~"	: {$:R"S:.-1,.X0"S -D C G0''}	!; twiddle characters	!
	"&"	: {$ 0L -1X0 -K L G0 -L}	!; twiddle lines	!
	"^A"	: {$X0 ^R^R{^Ga^G0^R^R}Ua L}	!; Append this line to A!
	"^K"	: {$X0 ^R^R{^Gk^G0^R^R}Uk K}	!; Kill line, save in A!
	"^X" ANY:("C","c") : {$			!; Up case 1rst letter	!
		<1A"A 0;' C>			!;  Locate start of next word!
		.U0 :FW$ Q0,.X1			!;  Make copy of word!
		-FS^G1$^V^V^W^G1$}		!;  Fix casing of word!
	"^X" ANY:("L","l") : {$		 	!; Lower case word	!
		.U0 :FW$ Q0,.X1			!;  Make copy of word!
		-FS^G1$^V^V^G1$}		!;  Fix casing of word!
	"^X" ANY:("U","u") : {$			!; Upper case word	!
		.U0 :FW$ Q0,.X1			!;  Make copy of word!
		-FS^G1$^W^W^G1$}		!;  Fix casing of word!

 !;***Adjust screen!
 "B^V" | "b^V"	: {$ 0,.V 0V}			!; Make pointer top	!
 ".^V"	: {$E?display-lines$U0U1 Q1-Q0/2,.V 0V}	!; Center screen	!
 "Z^V" | "z^V"	:
	{$ E?display-lines$U0U1 Q1-1,.V 0V}	!; Make pointer bottom	!


!; Strange ones!
	"/"	:{$ Q(error-text)=}		!; Make "/" type out error!

@	!; End insert of extended commands!


!;
Support routines!

	!; (toggle-flag)!
	{U0 Q(^R0)"E 1U(^R0)'"F 0U(^R0)' Q(^R0)}U(toggle_flag)

	E.(compile) HK @I#	!; macro to "compile" and save FC tables!
				!; It will be deleted when no longer needed!
		U0			!; Save argument, which is table name!
		FC(fc_table_^R^G0)PUSH$!; Fetch table!
		FC(fc_save_^R^G0)SAVE$!; Save table!
		FCPOP$			!; Undo effect of the fetch!
		0U(fc_table_^R^G0)	!; Delete textual copy of table!
	#	!; End the insert!

!;									!
!; Set up the FC tables							!
!;									!

	!; Setup base FC table!

	FC(fc_table_pseudo)REPLACE$ FCON$	!; Enable extended commands!

!;
Load Q-register (E) for actually starting the immediate modes.	!
!; User types ME$$ when he wants to invoke them.			!
!; Here we will define the rest of the Q-registers needed to support	!
!; these modes.								!
!;									!
0Ue E.(E) @I~^T 0Ue

!; Initialize Q-registers!
	E?current-text-buffer$U1	!; Save name of current text buffer!

	!; Initialize status line with hello message!
	{Teco`	[`^X? for help. MAIL 42 bugs/suggestions]^M^J}U(command-prompt)
	E.(command-prompt)			!; Finish status line!
		:1,8^R^T"S :EP(0)TMP:EDS./NODEFAULT$ $-2D I`	^G0$'

!; Set up support routines!
	E.(tell_status) HK @I#
		{^R^R^G%Teco>}U(command-prompt)
		#

	E.(case_inversion) HK @I#
		U1U0 .U2 Q0J Q1-Q0<	!; Get args, iterate that many times!
		.,.+1X3 1A		!; Get the next character to text it!
		"W :FS^R^R^X$^R^R^V^R^R^V^R^R^G3$ $
					!; Uppercase? make it lower!
		'"F :FS^R^R^X$^R^R^W^R^R^W^W^R^R^G3$ $';>
					!; lowercase? make it Upper!
		 Q2J			!; Restore pointer!
	#

	!; Create text for editting on a "?????" command!
	E.(fc_replace_insert) HK @I#
		OTHER	:{I$ :.-1,.M^R^R^G%}
	#

	!; Create temporary text for editting FC tables!
	E.(fc_change_insert) HK @I#OTHER : {I$}#$
	E.(fc_change_change) HK @I# ^R^T
		OTHER		: {U0			!; Save character!
		  ^R^R^R^R{^G0^R^R^R^R},^R^R^R^R{^J^R^R^R^R}"E K G0 OEND$ ' !; If type <CR>, kill line!
		  1A-13"N :FS^X$^G0$"S			!; Not EOL,try replace!
		  OEND$''				!; Success? goto end!
		  G0					!; Else, insert char!
		  !END!}				!; finished!
#

	!; (execute)!
	{U0 W0}U(execute)	!; Directly execute the commands supplied!

	E.(do_search) HK @I#
		$:.-Q(search_length)+1,ZS^R^R^G(search_string)$"S
		{Search:^R^R^G(search_string)}U(command-prompt)
		'"F{Search failed:^R^R^G(search_string)}U(command-prompt)'
	#

	E.(edit_search_string) HK @I#	!; This macro takes string arguments!
			U1 E?CURRENT-TEXT-BUFFER$U0 E.(search_string)
			M1 ZU(search_length)  E.(^R^R^G0)
			Q(search_start)+Q(search_length)J W(do_search)}
	#

	2U(auto-count)	!; Flag to do auto command every 2 user command!

	!; Load auto command to clear error text!
	{0,0X(error-text)}U(auto-buffer)

!; "compile" fc tables!
	:{insert}M(compile)		!; "Compile" and save the insert table!
	:{search}M(compile)		!; . . . search!

	0U(compile)			!; Delete support text!

!; Set up (E) for multiple reentrys!
!; (Since we have already set up everything, repeated ITECO enable/disable!
!;  can be done by simply setting the screen, and enable an FC table	!

 !; Put text into E by using string argument, easier than the I command!
{
	!; Set up screen!
	1,20E`$(text-buffer) 21,21E`$(error-text)
	22,23E`$(command-buffer) 24,24E`$(a)

	!; Turn it on!
	FC(fc_table_normal)OVERLAY$ FCON$
}UE

ME	!; Now do the reentrant code!
	!; i.e. (E) modified itself, and called itself!

	0U(insert_delete)		!;Always delete the editting text!

	0U(fc_table_pseudo)	!; Delete text copy of FC table	!

E.(^G1)	!; Back to original editting buffer!
-1EC	!; Cause teco to garbage collect!

~	!; End insert of (E)!

!;									!
!; Finish up								!
!;									!

	E.(^G1)			!; Restore editting buffer!
	0U* -1EC		!; Clean up core!