Update Muddle pretty printer.

src/rrs/pprint.3

@@ -28,7 +28,7 @@ PP	;"OBLIST"
 
 <ENDBLOCK>
 
-<BLOCK (<MOBLIST PP 37> <ROOT>)>
+<BLOCK (<MOBLIST PP 37> <ROOT>)>
 
 
 <SETG FRAMES	;"Prints FUNCT and ARGS for -n- frames down" 
@@ -86,7 +86,7 @@ PP	;"OBLIST"
 <SETG PAGPOS	;"Page position selector"	16>
 <SETG PAGLNT	;"Page length selector"		15>
 <SET QUICKPRINT	;"Speed selector."		T>
-<SETG TABS	;"The n'th element is a string of n-1 tab characters"
+<SETG TABS	;"The n'th element is a string of n-1 tab characters"
      ["" "	" "		" "			"
 "				"
 "					"
@@ -114,7 +114,7 @@ PP	;"OBLIST"
 	<COND (<G? .N .NOW>
 		<PRINC <<- </ .N 8> </ .NOW 8 > -1> ,TABS>>
 		<PRINC <<- .N <LINPOS .OUTCHAN> -1> ,SPACES>>)>>>
-<SETG COMPONENTS	;"Print the components of a structure in a column" 
+<SETG COMPONENTS	;"Print the components of a structure in a column" 
       <FUNCTION (L "OPTIONAL" (OM <+ .M 1>) (STOP 0))
 	<REPEAT ((N <LINPOS .OUTCHAN>) (M 0))
 		<AND <EMPTY? <REST .L>> <SET M .OM>>
@@ -166,7 +166,7 @@ PP	;"OBLIST"
 				<PRIN1 <TYPE .L>>
 				<FASTFORMS <CHTYPE .L <PRIMTYPE .L>>>)>>)>>>
 
-<SETG COMMENTS <FUNCTION ("AUX" MARG CMNT) ;"Prints comments.  If no comment, returns false"
+<SETG COMMENTS <FUNCTION ("AUX" MARG CMNT) ;"Prints comments.  If no comment, returns false"
 	<COND (<SET CMNT <GET <REST .L 0> COMMENT>>
 		<SET MARG <COND (<EMPTY? <REST .L>> .M) (0)>>
 		<COND (<NOT <FLATSIZE .CMNT <- <LINLNT .OUTCHAN>
@@ -186,7 +186,7 @@ PP	;"OBLIST"
 	<OR <ASSIGNED? QUICKPRINT> <SET QUICKPRINT T>>
 	<SETG FORMS <COND (.QUICKPRINT ,FASTFORMS)
 			  (ELSE ,SLOWFORMS)>>>>
-"The following functions define the way to pprint a given data type"
+"The following functions define the way to pprint a given data type"
 "They are PUT on the appropriate type name"
 "FORM is a special case - see next page."
 
@@ -224,7 +224,7 @@ PP	;"OBLIST"
 	<SET M <+ .M 1>>
 	<<GET VECTOR PPRINT>>
 	<PRINC ">">>>
-<DEFINE FUNCBODY FBA (L P "AUX" (M <+ .M 1>) (TEM %<>))
+<DEFINE FUNCBODY FBA (L P "AUX" (M <+ .M 1>) (TEM %<>))
 	<COND (<EMPTY? .L>)
 	      (ELSE
 		<COND (<==? <TYPE <1 .L>> ATOM>
@@ -270,7 +270,7 @@ PP	;"OBLIST"
 			<COND (<EMPTY? ..ATM> %<>)
 			      (<==? <TYPE <1 ..ATM>> STRING> %<>)
 			      (ELSE <SET T <1 ..ATM>> <SET .ATM <REST ..ATM>>)>>)>>
-"How to print FORM and its special cases."
+"How to print FORM and its special cases."
 "Special cases for FORM are PUT on the appropriate function."
 
 <PUT FORM PPRINT <FUNCTION () <<GET <1 .L> SPECFORM ',NORMFORM>>>>
@@ -295,7 +295,30 @@ PP	;"OBLIST"
 	      (<PRINC !" > <.COMELE <REST .L>>)> >>
 
 
+
 <DEFINE FORMAHEAD (ML "AUX" (AVSP <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>))
+	<COND (<AND <==? <TYPE <1 .ML>> FORM>
+		    <NOT <EMPTY? <REST .ML>>>
+		    <NOT <FLATSIZE <1 .ML> <MIN 59 .AVSP>>>>
+	       T)
+	      (ELSE
+	       <REPEAT ()
+		  ;"<COND (<L=? <LENGTH .ML> 2> <RETURN #FALSE ()>) old code"
+ 		  <COND (<L? <LENGTH .ML> 2> <RETURN #FALSE ()>)
+			(<NOT <==? <TYPE <2 .ML>> FORM>> <RETURN #FALSE ()>)
+			(<EMPTY? <2 .ML>> <RETURN #FALSE()>)
+			(<FLATSIZE <1 <2 .ML>>
+				   <- <SET AVSP
+					   <- .AVSP
+					      3
+					      <FLATSIZE <1 .ML> 99999999>>>
+				      3>>
+			 <SET ML <2 .ML>>)
+			(ELSE <RETURN T>)>>)>>
+
+
+
+;<DEFINE FORMAHEAD (ML "AUX" (AVSP <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>))
 	<COND (<AND <==? <TYPE <1 .ML>> FORM>
 		    <NOT <EMPTY? <REST .ML>>>
 		    <NOT <FLATSIZE <1 .ML> <MIN 59 .AVSP>>>>
@@ -349,7 +372,7 @@ PP	;"OBLIST"
 	<INDENT-TO .CPOS>
 	<.COMELE <REST .L 2>>
 	<PRINC ">">>>
-<SETG PPRINT <FUNCTION PPRINT  (L "OPTIONAL" (OUTCHAN .OUTCHAN))
+<SETG PPRINT <FUNCTION PPRINT  (L "OPTIONAL" (OUTCHAN .OUTCHAN))
 	<COND (<NOT <==? <TYPE .L> ATOM>> <EPRINT .L>)
 	      (<GASSIGNED? .L>
 		<COND (<==? <TYPE ,.L> FUNCTION>
@@ -401,4 +424,4 @@ PP	;"OBLIST"
 <COND (<LOOKUP "FRAMES" <1 .OBLIST>> <SETG FRAMES ,FRAMES!-> <REMOVE FRAMES>)>
 <COND (<LOOKUP "FRM" <1 .OBLIST>> <SETG FRM ,FRM!-> <REMOVE FRM>)>
 <COND (<LOOKUP "PPRINF" <1 .OBLIST>> <SETG PPRINF ,PPRINF!-> <REMOVE PPRINF>)>
-
+