MUDDLE/pprint.1

   1  "MUDDLE PRETTY-PRINT, FRAME-SCANNER, AND OTHER ROUTINES"
   2 <PRINC "/PPRINT/FRAMES">
   3 <BLOCK (<ROOT>)>
   4
   5 "These atoms are placed in the ROOT oblist to allow general
   6         access to their functions"
   7 M
   8 <COND (<NOT <GASSIGNED? NULL!->> <SETG NULL <INTERN <ATOM <ASCII 127>> <GET INITIAL OBLIST>>>)>
   9 PPRINF
  10 SPECBEF
  11 SPECAFT
  12 FORMS
  13 PPRINT
  14 EPRINT
  15 FRAMES
  16 FRATM
  17 FRM
  18 INDENT-TO
  19 LINPOS
  20 LINLNT
  21 PAGPOS
  22 PAGLNT
  23 QUICKPRINT
  24 PP      ;"OBLIST"
  25
  26 <ENDBLOCK>
  27
  28 \f<BLOCK (<MOBLIST PP 37> <ROOT>)>
  29
  30
  31 <SETG FRAMES    ;"Prints FUNCT and ARGS for -n- frames down"
  32     <FUNCTION ("OPTIONAL" (HOW-MANY 999) (FIRST 1))
  33         <SPEEDSEL>
  34         <SET SPECBEF 0>
  35         <SET SPECAFT 0> ;"To make compatible with MEDDLE."
  36         <REPEAT ((F <FRM .FIRST>) M (COMELE ,COMPONENTS))
  37                 <COND (<0? .HOW-MANY>  <RETURN "FUNCT---ARGS">)
  38                         (<==? <FUNCT .F> TOPLEVEL> <RETURN TOPLEVEL>)>
  39                 <AND <==? <TYPE <VALUE <FUNCT .F>>> FSUBR>
  40                         <==? <FUNCT <FRAME .F>> EVAL>
  41                         <==? <TYPE <1 <ARGS <FRAME .F>>>> FORM>
  42                         <==? <FUNCT .F> <1 <1 <ARGS <FRAME .F>>>>>
  43                                 <GO SKIPIT>>
  44                 <PRINT .FIRST>
  45                 <PRINC <FUNCT .F>>
  46                 <PRINC "        ">
  47                 <SET M 0>
  48                 <FORMS  ;"Calling an internal PPRINT routine"   <ARGS .F>>
  49         SKIPIT  <SET F <FRAME .F>>
  50                 <SET HOW-MANY <- .HOW-MANY 1>>
  51                 <SET FIRST <+ .FIRST 1>>
  52         >>>
  53
  54 <DEFINE FRATM!- ("OPTIONAL" (HOW-MANY 9999) (FIRST 1))
  55         <REPEAT ((F <FRM .FIRST>) (DEPTH!-FR 1) AF)
  56                 <COND (<L? .HOW-MANY .DEPTH!-FR> <RETURN "FRAME---FUNCTION">)
  57                       (<==? <FUNCT .F> TOPLEVEL> <RETURN TOPLEVEL>)>
  58                 <AND    <==? <FUNCT .F> EVAL>
  59                         <1? <LENGTH <ARGS .F>>>
  60                         <==? <TYPE <SET AF <1 <ARGS .F>>>> FORM>
  61                         <==? <TYPE <1 .AF>> ATOM>
  62                         <==? <TYPE <OR <AND <GASSIGNED? <1 .AF>> ,<1 .AF>>
  63                                         <AND <ASSIGNED? <1 .AF> .F> <LVAL <1 .AF> .F>>>>
  64                                 FUNCTION>
  65                         <PRINT .DEPTH!-FR>
  66                         <PRINC !"       >
  67                         <PRIN1 <1 .AF>>>
  68                 <SET F <FRAME .F>>
  69                 <SET DEPTH!-FR <+ .DEPTH!-FR 1>> >>
  70
  71 <SETG FRM <FUNCTION (I)
  72         <REPEAT ((F <FRAME>))
  73                 <COND   (<0? .I> <RETURN .F>)
  74                         (<==? <FUNCT .F> TOPLEVEL>
  75                          <PRINT .I>
  76                          <PRINC "FRAMES FROM ">
  77                          <RETURN .F>)>
  78                 <SET F <FRAME .F>>
  79                 <SET I <- .I 1>>>>>
  80
  81 <SETG LINPOS    ;"Line position selector"       14>
  82 <SETG LINLNT    ;"Line length selector"         13>
  83 <SETG PAGPOS    ;"Page position selector"       16>
  84 <SETG PAGLNT    ;"Page length selector"         15>
  85 <SET QUICKPRINT ;"Speed selector."              T>
  86 \f<SETG TABS     ;"The n'th element is a string of n-1 tab characters"
  87      ["" "      " "             " "                     "
  88 "                               "
  89 "                                       "
  90 "                                               "
  91 "                                                       "
  92 "                                                               "
  93 "                                                                       "
  94 "                                                                               "
  95 "                                                                                       "
  96 "                                                                                               "]>
  97
  98
  99
 100
 101 <SETG SPACES    ;"The n'th element is a string of n-1 space characters"
 102      ["" " " "  " "   " "    " "     " "      " "       "]>
 103
 104
 105
 106
 107
 108
 109 <SETG INDENT-TO <FUNCTION ( N "EXTRA" (NOW <LINPOS .OUTCHAN>))
 110                         ;"Print tabs and spaces to get to column -n-"
 111         <COND (<G? .N .NOW>
 112                 <PRINC <<- </ .N 8> </ .NOW 8 > -1> ,TABS>>
 113                 <PRINC <<- .N <LINPOS .OUTCHAN> -1> ,SPACES>>)>>>
 114 \f<SETG COMPONENTS       ;"Print the components of a structure in a column"
 115       <FUNCTION (L "OPTIONAL" (OM <+ .M 1>) (STOP 0))
 116         <REPEAT ((N <LINPOS .OUTCHAN>) (M 0))
 117                 <AND <EMPTY? <REST .L>> <SET M .OM>>
 118                 <FORMS <1 .L>>
 119                 <COMMENTS>
 120                 <COND (<EMPTY? <SET L <REST .L>>><RETURN DONE>)>
 121                 <AND <==? .STOP .L> <RETURN DONE>>
 122                 <TERPRI>
 123                 <INDENT-TO .N>>>>
 124
 125 <SETG ELEMENTS  ;"Print the components of a structure in a line."
 126      <FUNCTION (L "OPTIONAL" (M <+ .M 1>) (STOP 0))
 127         <COND (<EMPTY? .L>)
 128               (.QUICKPRINT
 129                 <REPEAT ()
 130                         <PRIN1 <1 .L>>
 131                         <AND <OR <EMPTY? <SET L <REST .L>>> <==? .L .STOP>> <RETURN T>>
 132                         <PRINC !" >>)
 133               (ELSE
 134                 <REPEAT ((N <LINPOS .OUTCHAN>) COM)
 135                         <FORMS <1 .L>>
 136                         <SET COM <COMMENTS>>
 137                         <COND (<OR <EMPTY? <SET L <REST .L>>> <==? .L .STOP>> <RETURN DONE>)>
 138                         <COND (.COM <TERPRI> <INDENT-TO .N>)>
 139                         <PRINC !" >>)>>>
 140
 141
 142
 143 <SETG SLOWFORMS <FUNCTION (L "AUX" (COMELE ,COMPONENTS))        ;"Pprint an object."
 144         <COND   (<MONAD? .L> <PRIN1 .L>)                        ;"If its a MONAD, just print it."
 145                 (ELSE
 146                  <COND  (<FLATSIZE .L <MIN 59 <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>>>
 147                           <SET COMELE ,ELEMENTS>)> ;"If it fits, use ELEMENTS, else COMPONENTS."
 148                  <<GET <TYPE .L> PPRINT ;"Snarfed from BKD."
 149                         '#FUNCTION (()
 150                                 <PRINC "#">
 151                                 <PRIN1 <TYPE .L>>
 152                                 <SLOWFORMS <CHTYPE .L <PRIMTYPE .L>>>)>>)>>>
 153
 154
 155 <SETG FASTFORMS ;"Pprint one item at the current page location"
 156       <FUNCTION (L)
 157         <COND (<MONAD? .L> <PRIN1 .L>)
 158               (<FLATSIZE .L <MIN 59 <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>>>
 159                 <PRIN1 .L>)
 160               (ELSE <<GET <TYPE .L> PPRINT
 161 \r                  '#FUNCTION ( ()
 162                                 <PRINC "#">
 163                                 <PRIN1 <TYPE .L>>
 164                                 <FASTFORMS <CHTYPE .L <PRIMTYPE .L>>>)>>)>>>
 165
 166 \f<SETG COMMENTS <FUNCTION ("AUX" MARG CMNT) ;"Prints comments.  If no comment, returns false"
 167         <COND (<SET CMNT <GET <REST .L 0> COMMENT>>
 168                 <SET MARG <COND (<EMPTY? <REST .L>> .M) (0)>>
 169                 <COND (<NOT <FLATSIZE .CMNT <- <LINLNT .OUTCHAN>
 170                                                 <LINPOS .OUTCHAN>
 171                                                 .MARG
 172                                                 2>>>
 173                                 <TERPRI>)>
 174                 <INDENT-TO <- <MAX 2 <- <LINLNT .OUTCHAN>
 175                                         <FLATSIZE .CMNT 9999>
 176                                         .MARG>>
 177                                 2>>
 178                 <PRINC " ;">
 179                 <PRIN1 .CMNT>)>>>
 180
 181
 182 <SETG SPEEDSEL <FUNCTION ()     ;"Check QUICKPRINT and select speed."
 183         <OR <ASSIGNED? QUICKPRINT> <SET QUICKPRINT T>>
 184         <SETG FORMS <COND (.QUICKPRINT ,FASTFORMS)
 185                           (ELSE ,SLOWFORMS)>>>>
 186 \f"The following functions define the way to pprint a given data type"
 187 "They are PUT on the appropriate type name"
 188 "FORM is a special case - see next page."
 189
 190 <PUT LIST PPRINT
 191         <FUNCTION () <PRINC "("> <.COMELE .L > <PRINC ")">>>
 192
 193 <PUT VECTOR PPRINT
 194         <FUNCTION () <PRINC "[">  <.COMELE .L > :L<PRINC "]">>>
 195
 196 <PUT FUNCTION PPRINT
 197         <FUNCTION () <PRINC "#FUNCTION (" >
 198                      <FUNCBODY .L <LINPOS .OUTCHAN>>
 199                      <PRINC ")">>>
 200
 201
 202 <PUT UVECTOR PPRINT
 203         <FUNCTION ()    <PRINC %<STRING !"! !"[>>
 204                         <.COMELE .L <+ .M 2>>
 205                         <PRINC %<STRING !"! !"]>>>>
 206
 207 <PUT SEGMENT PPRINT
 208         <FUNCTION () <PRINC !"! > <FORMS <CHTYPE .L FORM>>>>
 209
 210 <PUT STRING PPRINT
 211         <FUNCTION () <PRIN1 .L>>>
 212
 213 <PUT TUPLE PPRINT <GET VECTOR PPRINT>>
 214
 215 <PUT ARGUMENTS PPRINT <GET VECTOR PPRINT>>
 216
 217 <PUT LOCD PPRINT <FUNCTION () <PRINC "#LOCD "> <FORMS <IN .L>>>>
 218
 219 <PUT RSUBR PPRINT <FUNCTION ()
 220         <PRINC "<RSUBR '">
 221         <SET M <+ .M 1>>
 222         <<GET VECTOR PPRINT>>
 223         <PRINC ">">>>
 224 \f<DEFINE FUNCBODY FBA (L P "AUX" (M <+ .M 1>) (TEM %<>))
 225         <COND (<EMPTY? .L>)
 226               (ELSE
 227                 <COND (<==? <TYPE <1 .L>> ATOM>
 228                         <OR <CHECK <1 .L> -1> <TERPRI> <INDENT-TO .P>>
 229                         <PRIN1 <1 .L>> <PRINC !" >
 230                         <AND <EMPTY? <SET L <REST .L>>> <EXIT .FBA T>>)>
 231                 <COND (<==? <TYPE <1 .L>> LIST> <SET TEM <PRINARGL <1 .L> .P>> <SET L <REST .L>>)>
 232                 <COND (.TEM <COMPONENTS .L .M>)
 233                       (<CHECK .L -1> <PRINC !" > <ELEMENTS .L .M>)
 234                       (ELSE <TERPRI> <INDENT-TO .P> <COMPONENTS .L .M>)>)>>
 235
 236 <DEFINE CHECK (IT FUDGE) <FLATSIZE .IT <MIN <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M .FUDGE>>>>
 237
 238 <DEFINE PRINARGL (L PB "AUX" POS Q (OL .L))
 239         <COND (<CHECK .L -2> <PRINC "("> <ELEMENTS .L> <PRINC ")"> %<>)
 240               (ELSE
 241                 <OR <CHECK <SET Q <ABUNCH L>> -1> <TERPRI> <INDENT-TO .PB>>
 242                 <PRINC "(">
 243                 <SET POS <LINPOS .OUTCHAN>>
 244                 <REPEAT ((NOTFIRST %<>) (N <+ .M 1>))
 245                         <OR .Q <RETURN T>>
 246                         <COND (<==? <TYPE .Q> STRING>
 247                                 <COND (.NOTFIRST <TERPRI> <INDENT-TO .POS>)>
 248                                 <PRIN1 .Q>
 249                                 <PRINC !" >)
 250                               (<CHECK .Q -2> <ELEMENTS .OL .N .L>)
 251                               (ELSE <COMPONENTS .OL .N .L>)>
 252                         <SET NOTFIRST T>
 253                         <SET OL .L>
 254                         <SET Q <ABUNCH L>>>
 255                 <PRINC ")">
 256                 <TERPRI>
 257                 <INDENT-TO .PB>)>>
 258
 259 <DEFINE ABUNCH (ATM "AUX" T)
 260         <COND (<EMPTY? ..ATM> %<>)
 261               (<==? <TYPE <1 ..ATM>> STRING>
 262                 <SET T <1 ..ATM>>
 263                 <SET .ATM <REST ..ATM>>
 264                 .T)
 265               (ELSE
 266                 <STACKFORM ,LIST .T
 267                         <COND (<EMPTY? ..ATM> %<>)
 268                               (<==? <TYPE <1 ..ATM>> STRING> %<>)
 269                               (ELSE <SET T <1 ..ATM>> <SET .ATM <REST ..ATM>>)>>)>>
 270 \f"How to print FORM and its special cases."
 271 "Special cases for FORM are PUT on the appropriate function."
 272
 273 <PUT FORM PPRINT <FUNCTION () <<GET <1 .L> SPECFORM ',NORMFORM>>>>
 274
 275 <DEFINE NORMFORM ("AUX" (PN <+ 1 <LINPOS .OUTCHAN>>))
 276                         <PRINC "<" >
 277                         <FORMS <1 .L>>
 278                         <COND (<==? .COMELE ,ELEMENTS> <COMEND>)
 279                               (<FORMAHEAD .L> <COMMENTS> <TERPRI> <INDENT-TO .PN>
 280                                 <COND (<FLATSIZE <REST .L> <- <LINLNT .OUTCHAN>
 281                                                                 <LINPOS .OUTCHAN>
 282                                                                 .M 3>>
 283                                                 <ELEMENTS <REST .L>>)
 284                                       (T <COMPONENTS <REST .L>>)>)
 285                               (T <COMEND>)>
 286                         <PRINC ">">>
 287
 288
 289 <SETG COMEND <FUNCTION ("AUX" (PPN <LINPOS .OUTCHAN>))
 290         <COND (<COMMENTS> <TERPRI> <INDENT-TO .PPN>)>
 291         <COND (<EMPTY? <REST .L>>)
 292               (<PRINC !" > <.COMELE <REST .L>>)> >>
 293
 294
 295 <DEFINE FORMAHEAD (ML "AUX" (AVSP <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>))
 296         <COND (<AND <==? <TYPE <1 .ML>> FORM>
 297                     <NOT <EMPTY? <REST .ML>>>
 298                     <NOT <FLATSIZE <1 .ML> <MIN 59 .AVSP>>>>
 299                T)
 300               (ELSE
 301                <REPEAT ()
 302                   <COND (<L? <LENGTH .ML> 2> <RETURN #FALSE ()>)
 303                         (<NOT <==? <TYPE <2 .ML>> FORM>> <RETURN #FALSE ()>)
 304                         (<FLATSIZE <1 <2 .ML>>
 305                                    <- <SET AVSP
 306                                            <- .AVSP
 307                                               3
 308                                               <FLATSIZE <1 .ML> 99999999>>>
 309                                       3>>
 310                          <SET ML <2 .ML>>)
 311                         (ELSE <RETURN T>)>>)>>
 312
 313
 314 <PUT LVAL SPECFORM <FUNCTION () <DAMMIT !".>>>
 315
 316 <PUT GVAL SPECFORM <FUNCTION () <DAMMIT !",>>>
 317
 318 <PUT QUOTE SPECFORM <FUNCTION () <DAMMIT !"'>>>
 319
 320 <DEFINE DAMMIT (Q)
 321         <COND (<==? 2 <LENGTH .L>>
 322                 <PRINC .Q>              ;"No fucking comments printed on . , or ' "
 323                 <COND   (<EMPTY? <REST .L>>)
 324                         (<.COMELE <REST .L>>)>)
 325               (ELSE <NORMFORM>)>>
 326
 327 <PUT FUNCTION SPECFORM <FUNCTION ()
 328         <PRINC "<FUNCTION ">
 329         <FUNCBODY <REST .L> <- <LINPOS .OUTCHAN> 2>>
 330         <PRINC ">">>>
 331
 332 <PUT DEFINE SPECFORM <FUNCTION ()
 333         <PRINC "<DEFINE ">
 334         <SET POS <LINPOS .OUTCHAN>>
 335         <COND (<EMPTY? <SET L <REST .L>>>)
 336               (ELSE
 337                 <PRIN1 <1 .L>>
 338                 <PRINC !" >
 339                 <FUNCBODY <REST .L> .POS>)>
 340         <PRINC ">">>>
 341
 342 <PUT REPEAT SPECFORM <FUNCTION ("AUX" (CPOS <+ <LINPOS .OUTCHAN> 3>))
 343         <PRINC "<REPEAT ">
 344         <FORMS <2 .L>>
 345         <TERPRI>
 346         <INDENT-TO .CPOS>
 347         <.COMELE <REST .L 2>>
 348         <PRINC ">">>>
 349 \f<SETG PPRINT <FUNCTION PPRINT  (L "OPTIONAL" (OUTCHAN .OUTCHAN))
 350         <COND (<NOT <==? <TYPE .L> ATOM>> <EPRINT .L>)
 351               (<GASSIGNED? .L>
 352                 <COND (<==? <TYPE ,.L> FUNCTION>
 353                         <EPRINT <FORM DEFINE .L !,.L>>)
 354                       (<==? <TYPE ,.L> RSUBR>
 355                         <EPRINT <FORM SETG .L <FORM RSUBR <FORM QUOTE <CHTYPE ,.L VECTOR>>>>>)
 356                       (ELSE <EPRINT <FORM SETG .L <FORM QUOTE ,.L>>>)>)
 357               (<AND <BOUND? .L> <ASSIGNED? .L>>
 358                 <EPRINT
 359                  <FORM SET .L
 360                              <COND (<==? <TYPE ..L> FUNCTION>
 361                                         <FORM FUNCTION !..L>)
 362                                    (<==? <TYPE ..L> RSUBR>
 363                                         <FORM RSUBR <CHTYPE ..L VECTOR>>)
 364                                    (ELSE <FORM QUOTE ..L>)>>>)
 365               (ELSE <PRINT .L> #FALSE ("NAKED ATOM?"))>>>
 366
 367 <SETG EPRINT <FUNCTION (L "EXTRA" (M 0) (COMELE ,COMPONENTS))
 368         <SPEEDSEL>
 369         <TERPRI>
 370         <FORMS .L>
 371         <TERPRI>
 372         ,NULL   ;"Null atom returned" >>
 373
 374 <DEFINE PPRINF FACT (INF "OPTIONAL" (OUTF ("" "" "TPL"))
 375                         "AUX" (INCH <OPEN  "READ" !.INF>)
 376                                 OUTCH NULLO)
 377         <OR .INCH <EXIT .FACT "BAD FILE NAME?">>
 378         <PUT <SET OUTCH <OPEN "PRINT" !.OUTF>> 13 100>
 379         <PUT <SET NULLO <OPEN "PRINT" "" "" "NUL">> 13 100>
 380         <REPEAT ((BOTH (<PUT .OUTCH 15 99999> <PUT .NULLO 15 99999>))
 381                   Q)
 382                 <PPRINT <SET Q <READ '<RETURN T> .INCH>>
 383                         <PUT .NULLO 16 <16 .OUTCH>>>
 384                 <AND <G? <16 .NULLO> 58> <PRINC <ASCII 12> .BOTH>>
 385                 <PPRINT .Q .OUTCH>>
 386         <CLOSE .INCH>
 387         <CLOSE .OUTCH>
 388         <CLOSE .NULLO>
 389         "DONE">
 390
 391
 392
 393 <ENDBLOCK>
 394
 395
 396
 397 <COND (<LOOKUP "PPRINT" <1 .OBLIST>> <SETG PPRINT ,PPRINT!-> <REMOVE PPRINT>)>
 398 <COND (<LOOKUP "FRAMES" <1 .OBLIST>> <SETG FRAMES ,FRAMES!-> <REMOVE FRAMES>)>
 399 <COND (<LOOKUP "FRM" <1 .OBLIST>> <SETG FRM ,FRM!-> <REMOVE FRM>)>
 400 <COND (<LOOKUP "PPRINF" <1 .OBLIST>> <SETG PPRINF ,PPRINF!-> <REMOVE PPRINF>)>
 401 \f\f\f\f\ 3\fð`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\að`Á\83\a