Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - emacs/ivory.emacs
There are no other files named ivory.emacs in the archive.
!* EMACS "Purifier" and "Compressor".			-*-TECO-*-
[]DXX:<EMACS>IVORY.EMACS.192,  5-Apr-96 17:43:37, Edit by ALDERSON

 Modification history:
 9/02/81  188 ECC	Added Change PURIFY Format to IVORY Format.
 4/05/96  192 RMA	Changed naming convention for libraries from :EJ to
			ELIB for Tops-20.

The Compressor takes a file of macros such as this one and deletes
comments and whitespace around these comments.  It also creates the
documentation strings and the ~DIRECTORY~.  Nothing else is changed
(unlike PURIFY).  It is intended that macros written for IVORY be
executable without being compressed;  i.e. that the compression will
effect no semantic changes on the code. 

The Purifier turns a compressed file in the buffer into a file that
can be :EJ'ed, creating the loader macro and other cruft that is
required for proper operation.

A special hack has been implemented to allow PURIFY format libraries
to be compressed in with IVORY libraries.  For a library FOO, if
variable PURIFY Library FOO exists and is non-zero, the library will
be treated as a PURIFY library.  IVORY knows about a number of common
PURIFY libraries already -- see MM Generate Library.!

!~FILENAME~:! !Macros for maintaining EMACS libraries!
!TECO Mode:! !C Set up commands for editing TECO code.
Makes Rubout the Tab-hacking Rubout.  Tab does ^R Indent Nested.
M-' and M-" move forward and back over conditionals.!

 m(m.m& Init Buffer Locals)
 1,1m.lSpace Indent Flag
 1,40m.lComment Column
 1,(:i*!* )m.lComment Start
 1,(:i*!)m.lComment End
 1,(:i*)m.lParagraph Delimiter
 1,(m.m^R Indent Nested)m.qI
 1,q(1,q.m.qw)m.q.	!* Exchange rubout flavors.!
 1,0m.lDisplay Matching Paren
 m.m^R Backward TECO Conditionalm.q.."
 m.m^R Forward TECO Conditionalm.q..'
 0fo..qTECO ..Df"n u..d'		!* Select the TECO-mode syntax table!
 "# w :g..du..d				!* creating it if doesnt exist.! ..D
    1m(m.m& Alter ..D)[A]A"(')<(>);A'
    1m(m.m& Set Mode Line)TECO 
!& Compress Buffer:! !S Compress a file of macros, in the buffer.
Removes comments, and makes the documentation and directory strings.
Documentation will be added to the buffer passed in Q8.
Function names will be added to the buffer passed in Q9.!
If  > 0, then we are working on the first library
    in a sequence of libraries.  If it is = 0, we are after the first
    library in a sequence.
This first one's ~FILENAME~ is used for the whole object file.
    1st ~FILENAME~ Name is set to that filename, for use by the caller.
All other's ~FILENAME~ are turned into "& Compressed foo Library:",
    where foo is the filename.  (Thus Apropos etc. can show how a file
    breaks up into source files.)
& SetUp Compressed Libraries will accumulate code to call the
    &Setups that are in the various compressed files, as well as code
    to set default variables.  It will be prepended to the &Setup
    macro in the first library (such a &Setup will be created if one
    doesn't already exist).
& Kill Compressed Libraries behaves analogously.
Some syntax notes:
    - A macro may have multiple names.  These must precede the macro
    documentation string.  They may be on separate lines if desired.
    - FF-CRLFs start macros.  If you need one inside a macro, you can
    quote the FF with Control-Q (if in a search) or Control-] Control-Q in
    general. I.e. ^]^Q^L^M^J.
    - Blank macros are ok, e.g. for formatting/commenting source files.
    These macros must ONLY contain comments.  No macro names, no code...
    - We remove all comments and surrounding whitespace BEFORE checking
    the major syntax, and thus you may have comments, e.g. before a macro
Special Hack:  if we are given a non-zero arg, then the buffer is assumed to
    be in PURIFY format, and we will autoload the PURIFY library to perform
    the compression.!

 m(m.m& Declare Load-Time Defaults)
    & SetUp Compressed Libraries, setup-caller: ||
    & Kill Compressed Libraries, kill-caller: ||
    1st ~FILENAME~ Name, 1st found: 0

 [..o[0[1[2[3[4[5[6[7			!* Save regs!
 q..ou7					!* Save source buffer.!

 "N	!* PURIFY compatibility hack.  Since IVORY will eventually take over!
	!* ..the world, we provide for upward compatibility from old (PURIFY)!
	!* ..libraries here, just because we are nice guys.!

     0fo..qSilent Running"E ft(PURIFY format file)
     m(m.mRun Library)PURIFY& Compress Bufferw   !* Call in the marines.!

    j< :s; -3c-2d >			!* Clean up after marines are gone.!
     0s:!  j< :s; -c @f k >	!* ...!

!~DOC~  0l				!* Find where doc-strings start.!
     .,( s
!~DIRECTORY~:!0l ).fx1		!* Pick them up,!
     q8u..o g1 q7u..o			!* and copy into doc-buffer.!

     :k i~FILENAME~ 0l			!* Put this back into directory, as we!
					!* ..may need it later.!
     .,( < .-z; i! :l i:! k > )zfx1   !* Coerce PURIFY directory into!
					    !* ..the form we like.!
     q9u..o g1 q7u..o			!* Append it to our directory.!
     '				    !* (Done with PURIFY source compression.)!

 "#				    !* IVORY source compression!


 j <  :s!*;				!* find comment!
      .-2(s! @f	 l),.k		!* kill comment and whitespace after!
	 k			    !* along with spaces & blank lines before!
"e 2c @f
	 k'			    !* and all but one of blank lines after!

!*** First, an error check:  make sure that there are no FF-CRLFs
 *** without a following macro name because that will screw up
 *** the alignment of the numbers and the names in the dispatch table.
 *** Delete all blank macros (no name or anything).
 *** Also, empty macro bodies will lose so check for them.!

 j <				    !* At beginning of macro.!
    <				    !* Make sure it is not blank...!
k     3f=
:@;					!* If no more lines left in macro,!
       3d >				!* then kill macro and try again.!

    .-z;				!* Quit if end of buffer.!
    0u1					!* Q1 will count number of names on!
					!* this macro!

    <  1a-!"n :i*Macro name or documentation missingfsErr'	!* Plausible!
								!* ..start of!
       :fb:!; %1w		    !* find end of macro name,!
				    !* increment macro name count!
 k				    !* Flush whitespace after this name.!
       >			    !* ...and go back for next name.!
    q1"e :i*Macro name missingfsErr'	!* No names encountered.!

				    !* At this point, we have found the excl!
				    !* ..that starts the doc-string...!

    0x1 q9u..o g1 q8u..o g1 fkc		!* copy macro names line to!
					!* dir buffer and to doc buffer!
    <ci~DOC~  s:! .-z;>		!* put ~DOC~ in front of each name!
					!* put in CRLF to end name line!
    q7u..o d .(s!r),.fx1 d q8u..o g1 i
 q7u..o				!* back to source, delete excl, find!
					!* end of doc string, and move to doc!
					!* buffer with ^L CRLF!
"n :i*Text after documentationfsErr'	!* Check to see if luser embedded an!
					!* ..excl inside of the doc.!
    2c @f
	 k				!* Step over the crlf and flush any!
					!* ..additional whitespace.!

    1f~m(m.m& Declare Load-Time Defaults)
"e	k .-b(s),.-b(qzu..o)f(-1g7q7u..o):d
					!* add variable definitions to QZ!
	 k'				!* kill following whitespace.!

    14.,1a-14."e :i*Macro body emptyfsErr'	!* Null macros lose.!
: :cw				!* find end of this macro!
	 k				!* delete whitespace at end of macro!
    .-z; 3c >				!* Move to beginning of next macro!
					!* and go do it.!
 '					!* Done with IVORY compression!

!*** Allow for concatenations of compressed files, without conflicts
 *** among ~FILENAME~s.  If this is the first library, we keep the
 *** ~FILENAME~, and set 1st ~FILENAME~ Name.  If not, we rename
 *** ~FILENAME~ to & Compressed foo Library:;  also we check for an &
 *** SetUp, and if one, append a call to it in & SetUp Compressed
 *** Libraries.!

 :"l					!* Variable non-neg, so we must be!
					!* compressing one of a sequence of!
					!* files.!
    "n				!* This is 1st library in sequence.!
      j :s!~FILENAME~:!"e		!* Find ~FILENAME~.!
	:i*1st file compressed MUST have ~FILENAME~fsErr'
      l					!* Down to actual filename.!
	 l).x* m.v1st ~FILENAME~ Namew	!* Set for our caller.!
      '					!* End of 1st library hacking.!

    "#					!* Not 1st library.!
      0u1				!* 1: filename of this library!
      j :s!~FILENAME~:!"l		!* If this file has ~FILENAME~...!
	.( l .,(@:f
l).x1					!* 1: Actual filename.!
	    :i2& Compressed 1 Library !* 2: Funny version of ~FILENAME~.!
	    )-2j-10dg2			!* Replace ~FILENAME~ with funny name.!
	q8u..o -s!~DOC~ ~FILENAME~:! 7c10dg2 zj  !* Fix DOC-string name,!
	q9u..o -s!~FILENAME~:! 1c10d g2 zj	!* as well as Directory entry.!
	q7u..o'				!* (reselect source buffer).!

      q1"n				!* If ~FILENAME~, check for &SetUp and!
					!* ..&Kill functions.!
	j :s!& SetUp 1 Library:!"l	!* Found a &Setup.!
	  q& SetUp Compressed Librariesu2	!* 2: Setup caller.!
	  @:i& SetUp Compressed Libraries|2m(m.m& SetUp 1 Library)
|'					!* Append another call.  Note that!
					!* &Setup calls come last, after!
					!* any M.Cs, in case the &Setup wants!
					!* to use a M.C-created variable.!
	j :s!& Kill 1 Library:!"l	!* Found a &Kill.!
	  q& Kill Compressed Librariesu2	!* 2: Kill caller.!
	  @:i& Kill Compressed Libraries|m(m.m& Kill 1 Library)
2|					!* Prepend another call.!
	  ''				!* Done with &SetUp and &Kill.!
      '					!* Done non-1st library hacking.!
    '					!* Done ~FILENAME~, & Setup hacking.!
 zj -3f=
"n i
' 					!* add ^L CRLF at end!
!& Declare Load-Time Defaults:! !S Called only if interpreting source
that hasnt been generated into a library.
Otherwise, IVORY will when compressing, simply look for this subroutine to
    be called, and create something for an & Setup to run.!

 f[BBind i			!* put declarations into buffer! Make Load-Time Default Setup)	!* turn into code!
 m(hfx*) 				!* execute code!
!& Make Load-Time Default Setup:! !S Make specs in NUMARG buffer into code.!
Each variable declaration is of the form:
    <w> <variable name> "," <w> <comment> ":" <w> <value>
    <w> is any horizontal or vertical whitespace.
    <value> may be either a number or string surrounded by delimiters.
    Sample specification:
	Test Foo, * foo fah: 123
	Test Oof, * fah foo: |hello there|
	Test Num, Random string variable: |123|
    String values may be more than one line long.
    Quote a colon with Control-] Control-Q.
    Quote an Altmode or Control-] with Control-].
Returns a constructed macro that will call .C for each of
    these variables specified.  The macro will not contain any redundant
    setups, i.e. if a variable has been previously recorded and its setup
    macro returned, it won't be included in the macro returned.!

 [..o [0[1[2[3[4
 @fn|q..q[..o :fo..qIvDVar *5,(:fo..qIvDVar!*5)k |
					!* cleanup handler to delete all!
					!* variables beginning with IvDVar!
 j< @f
	 k .-z; .u0			!* Past whitespace, check if done.!
					!* 0: start of declaration!
    :s,"e :i*No comma ending default variable name fsErr'
    -d q0,.x1 27i @f
	 k				!* replace comma with ESC and delete!
					!* whitespace!
					!* 1: variable name!
    .(r :s:"e c :i*No colon ending default variable comment fsErr'
    -d),.x2 27i @f
	 k				!* replace colon with ESC and delete!
					!* whitespace!
    .-z"e :i*No value for default variable fsErr'
    (1a--"'e)(1a"'d)"n .(:\:\u3),.k'	!* Digit or minus sign follows!
						!* this is a number value.!
					!* 3: Pick up the number as a string.!
    "# 1au3				!* String delimiter follows.!
					!* 3: The delimiter.!
       .,(c :s3"e :i*No end delimiter for string default value fsErr'
	  ).fx3				!* 3: String value with delimiters.!
       @:i3|@:i*3|'			!* 3: String value setter.!
    @f	 k			!* Past horizontal whitespace.!
    15.,1a-15."n :i*Something follows default value on line fsErr'

					!* Now check for compatibility.!
    0fo..qIvDVar 1 IvDValf"nu4	!* 4: Previously used default value.!
      f=43"n :i*Incompatible value for 1: 4 vs 3 fsErr'
      f~IvDVar 1 IvDCom2"n :i*Incompatible comment for 1: 4 vs 2 fsErr'
      q0,.k'				!* kill this declaration!
    "#w					!* Variable not previously used.!
      q3 m.vIvDVar 1 IvDValw		!* Record value.!
      q2 m.vIvDVar 1 IvDComw		!* Record comment.!
      z-.(q0j g3 im.C),zj l'
    >					!* On to next variable specified.!
!& Purify Buffer:! !S Convert macros in buffer to :EJ'able format.
Assumes compression has been done already, if desired.!

    [0[1[2[3[4[5[6[7[8[9	    !* save regs!

!*** Now put an ~INVERT~ macro in the file.!
!*** The ~INVERT~ macro is the inverse of the loader macro:  given!
!*** <object> and <ptr to file>, it returns the name of the object as a string!
    zj @i|
+8+fq(+4)[2 0[3			!* 2: FO table!
					!* 3: index into table!
< %3,-q2f2u3 q3&1@; q3"l 0' >	!* search FO table, exit if even,!
					!* return 0 if not found!
f[BBind q3-1*5,q3*5g2 q:..o(0)+q2|	!* get string pointer from pure!
					!* string, and return!
    j @i|[0 +8+fq(+4)[1		!* Q0 string arg, Q1 FO table.!
	0fo10f"g+q1'		!* If found, get value, relocate and return!
	+fq()+4u1			!* Lost, get pointer to next file!
        fq1"l 0'			!* No more files =) return 0!
        ,q1:m(q1+4(]1]0))|		!* Else pass rqs to next file!
    .+8u1 q1+4/5*5+1-q1,0i		!* Follow loader with nulls, making!
					!* table eventually come out on word!
					!* boundary!
    .+4u5 j 177.i q5&177.i q5/200.&177.i q5/40000.&177.i q5j
					!* add loader string header!
					!* 5: start of table!

!*** now, for each macro, convert it into a string,!
!*** and accumulate in buffer in Q9 the data for the table, in ascii: !
!*** For each name, the first line is the name, and the second!
!*** Has the two numbers that will go in the table eventually.!
    0u6 0u7				!* 6: function strings length!
					!* 7: no. of functions!
    q..ou8 f[BBind [..o q..ou9 q8u..o	!* 8: source buffer,!
					!* 9: auxillary buffer!
    <	.-z; .u3 :x2 q9u..o g2		!* put function names in Q9!
					!* 3: start of function!
	fkc <	1a-!"n :i*Missing namefsErr'	!* insure format!
		d .(s:!
),.+2u2 q2-2r			!* put function name on line!
					!* 2: function name length + 4!
	177.i q2&177.i q2/200.&177.i q2/40000.&177.i
					!* add string header!
	l q6+q2u6 q3-q5\i
 %7w .-z;>				!* put function name on own line !
	q8u..o l q3,.k			!* kill name line!
	zu4 :s
"l -3d .u4 q3j'			!* Q4 points at end.!
	q4-.+4u4 177.i q4&177.i q4/200.&177.i q4/40000.&177.i
	q4-4c >

    q5j q7*10+5+4u4 177.i q4&177.i q4/200.&177.i q4/40000.&177.i
					!* insert table string header!
    q4-4,0i				!* make space for table!
    .u4 q6,0i .-q5u6			!* make space for function names!
					!* 4: name table!
					!* 6: offset of no.s in auxiliary!
					!* buffer!

!*** Now pad whole file to even # of K, and make the header for the whole file!
    z+4+5120-1/5120*5120u2		!* ultimate size of file, in chars.!
    j 177.i q2&177.i q2/200.&177.i q2/40000.&177.i
					!* turn the file into one big string.!
    zj q2-(h),0i			!* fill file out to a K boundary!
    1f?					!* Flush gap now or else would!
					!* destroy low bits!
    q4+4u4 q5+4u5			!* relocate pointers to tables!

!*** Now sort the ascii table-precursor in q9!
    1f[^PCase 4c:l2l f]^PCase

!*** Now put the numbers in the table precursor into the space allocated!
    q5+4u1				!* Get addr of table data (skip table!
					!* headers)!
    q1/5*5-q1"n @feDSI fsErr'		!* We supposedly made table data!
					!* start on word boundry!
    q1/5u1				!* Get word address to index into q8!
    2u:8(q1)				!* Start the table with a 2 (# wds!
					!* per entry)!
    j < .-z; .(4cl),.-2x2 q4:f82	!* add name string!
	q4-q5u:8(%1) q4+fq2u4		!* put name address in table!
	\+q6u:8(%1) l>			!* get function address, relocate,!
					!* and add to table!

    q8u..o j 				!* the end!
!1Generate:! !C Make one ELIB file from just one source file.
Takes one string argument which is the source filename.  If no string
    argument is given, it defaults to the buffer filenames.!

 [1[2 -1f[FnamSyntax		    !* Lone fn means fn1.!
 qBuffer Filenamesf"ew'f[DFile   !* default to buffer filenames if any!
 4,4fLibraryu1 et1 fsDFileu1 !* get string argument as full filename!
 et ELIB fsDFileu2		    !* replace FN2 with ELIB!
 m(m.mGenerate Library)21   !* do MM GEN$ FOO $ FOO $$!
!Generate Library:! !C Make one ELIB file from several source files.
Takes desired name for ELIB file as first string argument, followed by
    the names of the input files.  A null string argument
    (altmode-altmode) ends the argument list.
The input files are all compressed and purified together.  You are
    told as each is compressed etc.  However, if $Silent Running$ is
    non-0 nothing is printed.  (Good for ^Z ^Ping.)
Filename defaulting is sticky; input FN2's default to >; the output
    FN2 to ELIB. 
The defaults are restored after the macro is finished.
~FILENAME~ is taken from first file's ~FILENAME~.  It must have one.
Other ~FILENAME~s are turned into "& Compressed foo Library:"s.
All "hidden" & SetUps (i.e. not of same name as object ~FILENAME~)
    will be accumulated, and code to call them will be inserted at the
    beginning of the first file's &Setup.  If that file has no &Setup,
    one will be created.
Also, the &Setup documentation will have a record (as part of its
    documentation string) telling who generated the object, when, and
    from what source files.
All "hidden" & Kills (i.e. not of same name as object ~FILENAME~) will
    be accumulated and called from the main &Kill in a similar manner.
Note that all source libraries are always compressed, no COMPRS files
    are created, and the destination library is always created.
For a given FN1, if variable PURIFY Library FN1 is non-zero, then
    the file is assumed to be a PURIFY library.!

 m(m.m& Declare Load-Time Defaults)
    & SetUp Compressed Libraries, setup-caller: ||
    & Kill Compressed Libraries, kill-caller: ||
    1st ~FILENAME~ Name, 1st found: 0

 [0[1[2[3[6[7[8[9 f[FNamSyntax	    !* save regs, flags!
 f[BBind f[DFile		    !* save buffer, default file name!
 fsURead"n e[  fn e]'		    !* push input file if one open!
 fsUWrite"n e\  fn e^'	    !* push output file if one open!

 1fsFNamSyntax			    !* lone filename defaults to FN1!
 etFOO ELIB 4,1fLibraryu2	    !* set default, read first file name!
 et2 fsDFileu2		    !* Q2: output filename!

 -1fsFNamSyntax			!* FN2 defaults to > on ITS!
 et EMACS 0fsDVersionw		!* FN2 defaults to EMACS on 20X!

 1[F					!* first flag!
 fsBCons				!* Z: buffer of variable declarations!
 :i*[& SetUp Compressed Libraries	!* & Compress Buffer will!
					!* accumulate calls to & Setups.!
 :i*[& Kill Compressed Libraries	!* & Kills, too.!
 0[1st ~FILENAME~ Name		!* 0 while no ~FILENAME~ found.!
 :i* m.vCompressed Library Filenamesw	!* We will accumulate full!
					!* filenames that were compressed and!
					!* default variable setups.!
 fsBConsu9 fsBConsu8			!* 9: directory buffer!
					!* 8: documentation buffer!
 < 4,4fSourceu0		    !* 0:  Next filename STRARG.!
   -fq0;			    !* Stop after null argument.!
   er0			    !* Barf if it does not exist!
   fsIFileu0			    !* 0: Real, full file name of input file!
   fsIFCDate:fsFDConvertu7	    !* 7: Date of file creation.!
   fsIFFN1:f6u3		    !* 3: FN1 of input file.!
   @y				    !* Append this source to those in buffer.!
				    !* (They are before virtual buf.)!
   qCompressed Library Filenamesu1	    !* 1: Names and filedates so far.!
   :iCompressed Library Filenames1
   0,	7			    !* Append this next filename and its date.!
   0fo..qSilent Running"E FT Compressing file	0
   qF,(0fo..qPURIFY Library 3)m(m.m& Compress Buffer)
					!* Compress the source library!
   .fsVBw				!* Put this and other compressed files!
   0uF					!* Indicate not 1st library.!
   >					!* end of compress loop!

 0fsVBw				!* Look at entire buffer for a while.!

 m(m.m& Combine Compress Data)		!* add documentation, etc.!

 0fo..qSilent Running"e ft Purifying...
'					!* progress report!

 m(m.m& Purify Buffer)			!* Make a :EJ file of them.!

 et2 eih@pef			!* Write to specified place!
 0fo..qSilent Running"e fsOFileu2 ft Pure file is		2
!& Combine Compress Data:! !S ...!
 [1[2					!* save regs!
 q1st ~FILENAME~ Nameu1		!* 1: ~FILENAME~!

 j :s!& Setup 1 Library:!"e	!* If there is no &Setup function...!
    zj .fsVBw				!* ...then make one.!
    @i|!& Setup 1 Library:! !S IVORY-Generated Setup -- Calls hook.!
0fo..q1 Setup Hookf"n[0m0w'|	!* Add to end of buffer.!
    -1,m(m.m& Compress Buffer)		!* Compress it as usual.!
    0fsVBw -l'"# l'			!* widen bounds, back to &setup line.!

 qzm(m.m& Make Load-Time Default Setup)
 qz[..o 0u2 j<:sM.C; %2w> ]..o		!* 2: variable count!
 q2-4"l gz'				!* if 4 or less M.Cs, skip hack!
 "# fsDate:\u2 i0fo..q1 Loaded-2"n
 gz g2 im.v1 Loaded'
'					!* otherwise conditionalize M.Cs on!
					!* never having been loaded before.!
					!* Use current date as a unique id so!
					!* that loading another version of!
					!* the same library wins!
 qzfsBKill				!* kill declaration buffer!
 q& SetUp Compressed Librariesu2	!* 2: calls to other &setups!
 fq2"g g2'				!* add after variable setup!

 q8[..o					!* select documentation buffer!
 j s!~DOC~ & Setup 1 Library:!	!* Find DOC for the &Setup.!
 3r					!* Go to end of the DOC.!
This object file was compressed on m(m.mInsert Date)li
by fsXUNamef6i on fsMachinef6i from the following source libraries:
 gCompressed Library Filenames	!* Append source-file information.!
 zj ]..o				!* reselect source!
 q& Kill Compressed Librariesu2 fq2"g	!* If there is some extra kill...!
    j :s!& Kill 1 Library:!"l :l g2'	!* Then add to existing &Kill.!
    "# zj .fsVBw			!* Or make a &Kill if none exists.!
       i!& Kill 1 Library:! !S IVORY-Generated Kill.!
					!* Add to end of buffer.!
       -1,m(m.m& Compress Buffer)	!* Compress it as usual.!
       0fsVBw''			!* then open up the bounds again.!

 zj .(g8)j q8fsBKill			!* add documentation!
 <:s; !>				!* convert ^^ to excl!

 zj i!~DIRECTORY~:!
 .u2 g9 q9fsBKill			!* add directory!
 q2j <	1a-!"n :i*Missing excl???fsErr'	!* make sure begin with excl!
	d s
	.-z;>				!* put each on own line!
 q2j <:s~; l-k>			!* Throw away names containing ~!
!No Key Test Load:! !C Test Load with Test Load Sets Keys bound to 0.
Thus Test Load will not offer to set any keys.  Useful if running Test
    Load over an entire library with many ^R commands.
Numeric arguments are passed along to Text Load.!

 m(m.m& Declare Load-Time Defaults)
    Test Load Sets Keys, * Non-0 allows key-setting: 1

 0[Test Load Sets Keys	    !* Bind to 0.!
 f:m(m.mTest Load)
!Key Test Load:! !C Test Load with Test Load Sets Keys bound to 1.
Thus Test Load will offer to set keys.
Numeric arguments are passed along to Test Load.!

 m(m.m& Declare Load-Time Defaults)
    Test Load Sets Keys, * Non-0 allows key-setting: 1

 1[Test Load Sets Keys	    !* Bind to 1.!
 f:m(m.mTest Load)
!Test Load:! !C Load any modified macros into MM-variables and ^R-keys.
A library source is in the buffer.
Compares each macro (compressed) with M.M-found version;  if
    different, puts the new macro (uncompressed) in an MM-variable.
If Test Load Sets Keys is non-0 (the default) and if the macro is an
    ^R one, user is asked which key to put it on.  Rubout means do not
    put it on any key.  (any better?)
If a positive NUMARG is given, compressed macros are put into
    MM-variables when differences are found.  Negative NUMARG means
    make uncompressed, without checking difference.
If a pre-comma ARG is given, the library is searched for a & Setup...
    macro, which if found is macroed.!

 m(m.m& Declare Load-Time Defaults)
    Test Load Sets Keys, * Non-0 allows key-setting: 1

 .u7 FN q7j 			    !* 7, ..N: Restore orig point.!
 [7				    !* 7: Free for use now.!
 qTest Load Sets Keysu0	    !* 0: Non-0 allows key-setting.!
 q..ou1				    !* 1: Uncompressed buffer.!
 f[BBind q..ou2		    !* 2: Compressed buffer (will be).!
 g1				    !* Copy uncompressed library.!

 fsBCons				!* Z: variable declarations!
 fsBConsu8 fsBConsu9			!* 8: documentation buffer!
					!* 9: directory buffer!
 -1,m(m.m& Compress Buffer)		!* compress buffer!

 q9fsBKill			    !* throw away directory!
 zj .(g8)j q8fsBKill		    !* get documentation!
 0s <:s;!>		    !* turn ^^ into excl in documentation!

 qzm(m.m& Make Load-Time Default Setup)	!* turn into code!
 mz qzfsBKill				!* execute code, kill declarations!

 m.mKill VariableuK		    !* K: Kill Variable.!
 m.m& Read Q-Reg NameuR	    !* R: & Read Q-Reg Name.!

 < :s:!; 2r .u3 0f:fb! c    !* Next macro label, at start of!
				    !* function name.!
   .,q3f=~FILENAME~"e q3+2j !<!>'	!* ignore filename!
   .,q3f=~DOC~ ~FILENAME~"e q3+2j !<!>''	!* Ignore filename doc!
   .,q3x3			    !* 3: macro name.!
   l .(:s
"e zj'"# 3r'),.x4		    !* 4: macro body.!
   "l :i5'			    !* 5: Null forces a difference quickly.!
   "# 1,m.m3f"ew :i*'u5'	    !* 5: Null or ptr to pure macro.!

   f=45"n			    !* Compare old and new macros.!
				    !* Different, probably make MM-var.!
      0u7			    !* 7: 0 means havent made MM-var.!
      0:g3-~"e oCOMP'	    !* ~DOC~s are compressed sorta.!
      "l oUNCOMP'		    !* Negative NUMARG like no NUMARG.!
      ff&1"E !UNCOMP!	    !* No ARG, or only pre-comma ARG, !
				    !* make MM-var uncompressed.!
	 q1[..o			    !* Switch to uncompressed buffer.!
	 bj s!3:!		    !* Find macro in uncompressed buf.!
	 0l .,(:s
	       "e zj'"# 3r'
	       ).x6		    !* 6: Possible new uncompressed macro.!

	 "l :i5'		    !* 5: If negative NUMARG, force!
				    !* quick difference.!
	 f=56"N		    !* If uncompressed is also different,!
	    0fo..qMM 3u.0	    !* .0: 0 or former MM-variable.!
	    mkMM 3		    !* Kill variable, in case prefix problems.!
	    q6 m.vMM 3 (TEST)w   !* ...make the MM-var.!
	    ftMade uncompressed MM-variable MM 3 (TEST).

	    1u7'		    !* 7: MM-var made flag.!
	 ]..o			    !* Back to compressed buffer.!
	 '			    !* Done making uncompressed MM-var.!

      "# !COMP!			    !* Non-negative NUMARG or ~DOC~.!
				    !* make MM-var compressed.!
	 0fo..qMM 3u.0	    !* .0: 0 or former MM-variable.!
	 mkMM 3		    !* Kill var in case prefix problems.!
	 q4 m.vMM 3 (TEST)w	    !* Make the MM-var.!
	 ftMade compressed MM-variable MM 3 (TEST).
	 1u7'			    !* 7: MM-var made flag.!

      q7"N q0"n			    !* If made an MM-variable, and ok!
       f~(0,3:g3)^R "E		    !* And if ^R-command, ask which key.!
	 ft   Put on which key (rubout means no key)? 	    !* !
Key: 				    !* For prompting.!
	 mRu4		    !* 4: Read q-reg key name.!
	 f=4"E ft None.
	 "# ft4

	    0u5				!* 5: Will be 0 if OK to smash key.!
	    q4"n			!* If key non-0, and!
	     q.0-q4"n			!* different from the former!
					!* MM-variable, then must check it.!
	      q4fp"l			!* It is a builtin.!
		m(m.m& Load BARE)'	!* Now we can find its name.!
	      1:< q4m(m.m& Macro Name)u5 >w	!* 5: Function name.!
	      q5"e q4fp"g :i5an unnamed function''	!* ...!
	      q5"n f~53"e		!* New name is same as old one.!
		    0u5'		!* That is ok.!
		   "#			!* Different -- ask user.!
		    ft   4 runs 5  -- Ok to replace?	!* ...!
		    m(m.m& Yes Or No)"l 0u5''''' !* 5: 0 if ok.!
	    q5"e m.m3 (TEST)u4''	    !* Install on key.!
      ''''			    !* End of different macro.!
   >				    !* Done all macros in library.!

 ff-1"G			    !* If pre-comma ARG, look for an !
				    !* ...& Setup ... to macro.!
    q2u..o			    !* Select compressed buffer.!
    bj :s
!& Setup"L 0l .u4		    !* 4: & Setup macro beginning.!
	"e zj'"# 3r'		    !* At its end.!
	ftMacroing & Setup
	m( q4,.x* )		    !* Macro the & Setup.!
	'			    !* End of & Setup found.!
    '				    !* End of no-pre-comma arg.!


!Flush Test Functions:! !C  mode on all (TEST) function names, then kill.
This is for killing sets of impure test functions created by
    M-X Test Load.
String argument, if non-null, prunes the list.
The user is put into a recursive  mode on the list of all
    MM-variable names which contain "(TEST)" and the string argument
    if any.
The user may then trim the list further.
When the  is exited, those names that are left are killed.!

 [1[k :i1			    !* 1: STRARG keep-lines match string.!
 f[BBind m(m.m& Insert Prefixed Variable Names)MM 
				    !* Get all MM-variables.!
 j m(m.mKeep Lines) (TEST)	    !* Keep only the test functions.!
 j fq1"g m(m.mKeep Lines)1'	    !* Prune the list if need be.!
 :i*When exit ^R mode, remaining ones will be killed.[..j
				    !* Set up a mode line for the .!
 @:i*|m(m.mDescribe)Flush Test Functions|f[HelpMacro	    !* Set up HELP.!
 				    !* Let user trim things if wants to.!
 m.mKill Variableuk		    !* K: Killer.!
 j <@f
	 l .-z;		    !* Past any whitespace.!
    :x1				    !* 1: Next variable name.!
    mk1w l>			    !* Kill it and move on.!
!Compress File:! !C Generate a PURIFY style COMPRS file from a source file.
STRARG1 is the COMPRS file.
STRARG2 is the source file.  Filename defaulting is sticky left to
(The second filename of the COMPRS file MUST be COMPRS.)
This command is useful for creating COMPRS files so people using the
    standard EMACS purify package can GEN them into their libraries.
One tricky thing:  it always leaves ^Ls on their own lines, even if
    not there to begin with, since PURIFY will change CRLF ^L to ^L,
    and CRLF CRLF ^L to CRLF ^L.!

 [1[2[3 [7[8[9
 :i* m.vCompressed Library Filenames	!* We will accumulate the full!
					!* filename for Setup function!
 4,4fCOMPRS filef[DFile
 fsDFile( 4,1fSource fileu2 )u1	!* 2: STRARG2, the source.!
					!* 1: STRARG1, the COMPRS.!
 f[BBind -1f[FnamSyntax		!* <  Default fn2s to >.!
 er2					!* read in file!
 fsIFileu3				!* 3: Source file name complete.!
 fsIFCDate:fsFDConvertu7		!* 7: Date of file creation.!
 @y					!* REALLY read in file!
 :iCompressed Library Filenames
 3, 7				!* Insert filename and its date!
 ft Compressing file	3
					!* Type it.!
 fsBCons				!* Z: variable declaration buffer!
 fsBConsu9 fsBConsu8			!* 8: documentation buffer!
					!* 9: directory buffer!
 1,m(m.m& Compress Buffer)		!* compress the buffer!

 j < :s
;					!* Find ^Ls between functions, !
      fk+1c i
 l >					!* and put an extra CRLF in front.!

 m(m.m& Combine Compress Data)		!* add documentation, etc.!

 f6COMPRSfsDFN2w 1fsFnamSyntaxw	!* Set defaults for COMPRS file.!
 et1 eihpef				!* write out!
 fsOFileu3				!* 3: COMPRS file name complete!
 ft Compressed file is	3
 					!* Type it.!
!Change PURIFY Format to IVORY Format:! !C Changes Buffer to IVORY Format.
This function is a good starting place -- but you will need to finish the
    conversion by carefully checking the code yourself.  A warning message to
    this effect, and some hints, will be printed.
The conversion warning message is suppressed if you supply a numeric argument.!

!* This function was written by P.J.Gergely of the Canadian Defense Research!
!* Establishment Atlantic.  ECC@MIT-AI added the warning message!
!* after checking it on some typically (devillishly?) tricky PURIFY!
!* constructs.  Note that the indentation and CRLF problems are not handled!
!* since that would result in ugly looking code on the whole.!

[A [B [C [D [E			    !* Push temporary registers!
J<.-Z; 0UD 0UD			    !* For the whole buffer!
  .,(:L.)@F 	F:UA	    !* Search line for first non-space or!
				    !* non-tab!
  QA,. FSBOUNDARIES		    !* Set boundary to this part of the line!
  J :S:! "N .UB 2R		    !* If TECO label, back up and check for!
    -:S!* "E QBJ
      :S! "N			    !* Start of comment on the label line!
        .,FSZFSBOUNDARIES	    !* Expand bounds to rest of file!
	S! '			    !* Find matching exclamation point!
      "# ZJ'			    !* No comment, skip to end of line!
      OLOOP' '			    !* a comment or true label (then skip)!
  J :S!* "L 2R		    !* Search for start of comment!
    .(.,FSZFSBOUNDARIES	    !* Open bounds to search for end comment!
    2:S!"L.UD'W)J		    !* Keep QD as reference to end of comment!
    .,QA@F 	F:UB	    !* Back over the whitespace!
    QA,QB FSBOUNDARIES'	    !* Bounds covers only main part of line!
  ZJ FSHPOSITIONUC		    !* QC gets the orig. horizontal position!
  J  <:S 	;		    !* Search for space or tab!
    .-B-1"E -D %E'		    !* If first character then delete it!
    "# -1A-"N -D %E'	    !* If not quoted then delete it!
      "# R -D C %E		    !* Otherwise delete quote!
        .-B-1"N			    !* And if not at the beginning!
	-1A-29"E R -D C %E' ' ' ' > !* and superquote if any.!
  ZJ QC-FSHPOSITION F"G,32I' '	    !* Pad out to orig hor. pos. with spaces!
  !LOOP!			    !* If a TECO label, then come right here!
  .,FSZ FSBOUNDARIES		    !* Open bounds to rest of file!
  QDF"N-QE-.F"G+. J' '		    !* For comment not terminating on same line!
  1L>				    !* Next line!
0,FSZ FSBOUNDARIES		    !* Open bounds to full!
J 0S_ <:S;			    !* Replace underscore by spaces unless!
    .-B-1"E .-1F '		    !* If first character on line then replace!
    "# -1A-"N .-1F '	    !* quoted or superquoted (then remove!
      "# R -D 1C		    !* quote character and!
        .-B-1"N			    !* If not at beginning of line, the!
	  -1A-29"E R -D C' ' ' ' >  !* superquote character if any)!
 ff&1"e				!* If no arg, warn user.!
  ftNote that this is approximate -- you should check the result carefully,
especially for conversions that can only be done by understanding the
    1.  PURIFY files sometimes have comments in the middle of string args.
	Those will be ok in IVORY if compressed, but not if run uncompressed.
    2.  Similarly, " or ' in comments should be avoided if you want to run the
	code uncompressed.
    3.  Line indentation within string args will be wrongly retained.  You
	will have to remove it by hand.
    4.  PURIFY compresses n successive CRLFs into just one, which again will
	require you to correct any within string args.
 Also, things like 1u1 2u2 will become the uglier 1u12u2, which you may want
 to correct.
 We suggest that you write the new IVORY source to a file different from the
 PURIFY source, then compress both files -- using the PURIFY function
 & Compress File and the IVORY function Compress File -- and then compare the
 resulting COMPRS files.
J W 				    !* Back to the top and Return!
!^R Ivory-Bound This Page:! !^R Even if already bounded.
Thus calling this always results in the same thing, unlike the normal
    EMACS ^R Mark Page, which moves forward a page if already
Uses IVORY-style definition of what a page is, i.e.:

 .:\u1 fn1j				!* Auto-restoring point.!
 fsWindow+bfsWindoww			!* Relocate for wide bounds,!
					!* so we dont get redisplay if!
					!* already had bounds set and!
					!* point stays on screen.!
 0,fsZ fsBoundariesw			!* Open wide.!
:					!* Back to start of this page.!
 .:					!* MARK this place.!
"e zj'"# 3r'			    !* Forward to end, just before ^L if one.!
 @m(m.m^R Set Bounds Region)
!^R Forward TECO Conditional:! !^R Move past the ' matching the following ".
This ignores "s or 's inside comments.!
    0[1 .[3
    .( :s
: fsZ-.f[VZ )j		    !* Don't look past end of this macro.!
    < :s"'!*;
      0a-" "e %1' !'!		    !* Count "'s and ''s.!
!"!   0a-' "e q1-1u1 q1-1"l 0''
      0a-* "e s!' >		    !* Ignore insides of comments.!
    q3j fg 0
!^R Backward TECO Conditional:! !^R Move back past the " matching the preceding '.
This ignores "s or 's inside comments.!
 0[1 [2 .[3
 .( -:s
   : .f[VB )j		    !* Dont look past start of this macro.!
 < -:s"'!
   1a-" "e q1-1u1 q1-1"l 0'' !'!	    !* Count aposs and dblquotes.!
!"!   1a-' "e %1'
      1a-! "e .u2 -s!	    !* On finding <excl><cr>, look for the!
				    !* matching excl!
      		2a-*"n q2j''	    !* And if it has a start after it,!
				    !* skip the whole thing!
    q3j fg 
!TecDoc:! !C Look up information on Teco commands.
String arg is command, e.g. MM TecdocF^B or MM TecdocFS HPOS.
Represent a control character with a "^" not followed by a space.
Spaces elsewhere are ignored.
For speed (of another TecDoc) it keeps TECORD in an EMACS buffer,
    named *TECORD*.  If you are worried about space, kill that buffer.
    Giving TecDoc a numeric argument will inhibit use of the buffer.
The format of INFO;TECORD is understood.  Type "?" for help.!

!* Warning:  this doesnt run uncompressed -- too many quotes in!
!* comments.  Someday one of us should fix it up -- the trouble with!
!* taking purify source...!

    [0 [1 [2 [3 [4 [5 [6
    1,fCommand: u1			!* Get arguments and stuff!
    f[BBind Q..OU4 [..o g1		!* 4: Temporary buffer with!
					!* teco command in it.!
    :i*Teco Doc[..J 0f[^RStart	!* Display med school diploma!
    f[DFile etDSK:INFO;TECORD INFO 0fsDVersionw	!* Set file!
					!* name fdefault for tecord.!
    0fo..qTecord Bufferu3		!* 3: 0, dead buffer, or good one.!
    q3fp"e				!* 3: Usable buffer.!
      0[..f f[BBind q3[..o'		!* [..o prevents KCB.!
    "#					!* Dont already have tecord.!
      ff&1"n			!* NUMARG, so no buffer hacking.!
	0[..F				!* Cant hack files.!
	f[BBind Q..OU3 [..O		!* [..O prevents KCB !
	er @y'				!* 3: Temporary buffer with!
					!* tecord in it.!
      "#				!* No NUMARG, use *TECORD*.!
	[Previous Buffer qBuffer Nameu3 @fn|m(m.mSelect Buffer)3|
					!* Will come back to this buffer.!
	fsDFileu3			!* 3: Filename default.!
	-1,m(m.mFind File)3		!* Find tecord in its buffer,!
					!* without auto saving on.! Bufferw		!* Save it for next time.!
	q..ou3 [..o''			!* 3: Buffer with tecord.!

!* Digest arg in buffer in Q4.!
    :FT Q4U..O
    J <:S^ ; -DR>		    !* remove spaces except after circumflex (not uparrow)!
    J :S "N B,.-1K '		    !* remove leading spaces !
    J <.-Z; 1A-32"L 1A-33."N 1A( D I^)+100.I 2R'' C>    !* Turn ctl-chars to ^ and 100+ char.!
    Z"E OGET ARG'		    !* no argument =) use mini buffer to get one!
    J :< 1A F :@"G C!<!>'	    !* Skip over : and @ modifiers.!
	 1A-^"E 2AF: +1"N CDI@!<!> '' 0; >    !* Turn ^ modifier into @.!
    .( 1:< 1A-F"E C 1A-S"E
		  .-Z"N C 40.I 1A-^"E 2C 40.I '''' !* FSHPOS =) FS H, FS^RHPOS =) FS ^R H!
		 "# 1A-E"E C '' 1A-^"E C ' >    !* Skip over Fs, Es, ^s!
       :CW 0A-<"E 9I'		    !* If command is "<", look for "< Tab".!
       B,.X2			    !* Q4 has whole string, Q2 has first character or two!
       ),.X5			    !* Q5 has Q2 less modifying colons and circumflexes!
    0A-9"E -D'
    J<:S ;-D>			    !* If we put spaces in, take them out again!
    Q3U..O BJ S)		    !* Get to beginning of command descriptions!

!* Given an arg in Q4,, digested into Q2 and Q5, search for it from point.!
5"E FG FTNot found. OASK '	    !* Find section on this command group !
    1A-:"E :L '"# 0:L '	    !* skip section tag; get to beginning of section!
    .U6				    !* Q6 has start of section in case can't find subsection.!
    < :S
<>,<>2"E Q6J 0;'		    !* Find subsection for spec'd set of modifiers.!
				    !* Specific modifiers not present, show all!
      FQ2R :I0			    !* Found possibility, check it out!
      :<			    !* Scan buffer putting entire command name in Q0.!
	1A-40.F"L :; '"E 0,0A-^"N C !<!> ''	    !* Skip spaces, stop on CR or TAB.!
	1@X0 C >		    !* And accumulate command name in Q0!
      0,FQ4:G0U0		    !* Truncate to length of spec'd arg so abbreviations win!
      F~04"E :0L 0;'	    !* Matches => display starting from CRLF before this line.!
      >				    !* Loop back if full command fails to match arg.!

!* Display starting at point, which should be before the CRLF before the start of the section!
    .(				    !* Find how long this command description is!
     < LS
	 FKC .,.+4F=

:@;>				    !* It ends before 1st nonblank line not starting with tab.!
     ),.T			    !* Type it out!

!* Say "More? " and lt user exit see next section, or give new command.!
    0fsFlushedw FT
More (
    .u0 s
 r				    !* Find the next non-blank line!
	 .,(.s 0:l	    !* Show user what is coming up next!
    @:FIU0 33.FS^RInit-Q0"E FIW 0U..H '    !* Char that would exit ^R exits.!
XQNQ0F+1"G -fsReReadw 0U..H '	    !* CR, Rubout, X Q and N exit.!
    Q0-40."e OMORE'		    !* Space => print more!
    Q0-12."E FT
 OSEARCH AGAIN '		    !* Linefeed => search again for same arg.!
    Q0-33."E			    !* Altmode => read new arg and search for it.!
       FR 1f[Typeout		    !* So M.I won't do a @V.!
       1,m(m.m& Read Line)Teco Command: U0
       FQ0"G Q4U..O HKG0  oARG'    !* User gave us an arg => search for it.!
       O ASK'			    !* If user rubs out of & Read Line, ask again.!
				    !* Here if answer to question not recognized.!
Responses at this point are:
X, Q, N exit
Rubout  exit
Space   type more
Line    search again for same arg
Altmode read another arg and search
!^R TQuote:! !^R Quote with ^] all altmodes and ^]'s in the region.
This is to aid quoting inside a string argument to a Teco command.!

    f[VB f[VZ				!* save virtual boundaries!
    :,. f fsBoundw			!* put virtual bounds around region!
    j< @:fl .-z;
       i c>
    h					!* return (for ^R) entire region scanned!
!List TECO FS Flags:! !C List names of all TECO FS flags.!
    :fe j  :LL		    !* Get and sort the Flag Names!
      fsWidth/9<		    !* Put this many columns!
	  .-z; :LK I    >
      -@f k i
    .-z; >
    ht :fv 
!& File PURIFY Loaded:! !? If this is defined, PURIFY is loaded.
This is to prevent some functions (e.g. Teco Mode) from loading it.
Even though we arent in fact PURIFY.....(We're better...)!
 0					!* Note macro bodies arent allowed to!
					!* be empty.!
 * Local Modes:
 * Comment Column:40
 * End: