MUDDLE/editor.8

   1 "MUDDLE EDITOR, PRETTY-PRINT, AND OTHER ASSORTED ROUTINES"
   2
   3 %%<BLOCK (<ROOT>)>
   4 FRAMES
   5 LINPOS
   6 LINLNT
   7 PAGPOS
   8 PAGLNT
   9 LPT
  10 TPL
  11 1+
  12 1-
  13 INC
  14 DEC
  15 CHOP
  16 DEFINE
  17 PPRINT
  18 EPPRINT
  19 EDITOR
  20 %%<ENDBLOCK>
  21 \f"PAGE 2"
  22 %%<BLOCK <SETG EDITOR (<MOBLIST 7> <ROOT>)>>
  23
  24 <SETG DEFINE <FUNCTION (NAME "ARGS" BODY "NAME" REDEF)
  25         <COND (<GASSIGNED? .NAME><COND (<LISTEN
  26                         DO-YOU-REALLY-WANT-TO-REDEFINE .NAME
  27                         IF-SO-ERRET-TRUE-OTHERWISE-FALSE>)
  28                         (ELSE <EXIT .REDEF>)>)>
  29         <SETG .NAME <CHTYPE .BODY FUNCTION>>
  30         .NAME >>
  31
  32 <SETG FRAMES    <FUNCTION (I)
  33         <REPEAT ((FRM <FRAME>)(SMALL 1))
  34         <COND (<L? .I .SMALL >  <RETURN FUNCT---ARGS>)>
  35         <SET FRM <FRAME .FRM>>
  36         <PRINT .SMALL >
  37         <PRINC <FUNCT .FRM>>
  38         <PRINC "        ">
  39         <PRINC <ARGS .FRM>>
  40         <SET SMALL <+ .SMALL 1>>
  41         >>>
  42
  43 <SETG LINPOS 14>
  44 <SETG LINLNT 13>
  45 <SETG PAGPOS 16>
  46 <SETG PAGLNT 15>
  47
  48 <SETG 1+ <FUNCTION (NUMBER)  <+ .NUMBER 1>>>
  49 <SETG 1- <FUNCTION (NUMBER)  <- .NUMBER 1>>>
  50
  51 <SETG INC <FUNCTION (ATOM "OPTIONAL" (VAL 1))
  52         <SET .ATOM <+ ..ATOM .VAL>>>>
  53
  54 <SETG DEC <FUNCTION (ATOM "OPTIONAL" (VAL 1))
  55         <SET .ATOM <- ..ATOM .VAL>>>>
  56
  57 <SETG CHOP <FUNCTION (ATOM "OPTIONAL" (VAL 1))
  58         <SET .ATOM <REST ..ATOM .VAL>>>>
  59
  60
  61 <SETG TPL <FUNCTION ()
  62         <OPEN "PRINT" "" "" "TPL">>>
  63
  64 <SETG LPT <FUNCTION ("OPTIONAL" (DEFAULT TRUE))
  65         <COND (<OPEN "PRINT" "" "" "LPT">)
  66                 (.DEFAULT <TPL>)>>>
  67 \f"PAGE 3"
  68 <SET TABS ["" " " "             " "                     "
  69 "                               " "                                     "
  70 "                                               "
  71 "                                                       "
  72 "                                                               "]>
  73
  74
  75
  76
  77 <SET SPACES ["" " " "  " "   " "    " "     " "      " "       "]>
  78
  79
  80 <SETG INDENT-TO <FUNCTION ( N "AUX" (NOW <LINPOS .OUTCHAN>))
  81         <COND (<G? .N .NOW>
  82                 <PRINC <<- </ .N 8> </ .NOW 8 > -1> .TABS>>
  83                 <PRINC <<- .N <* </ .N 8> 8> -1> .SPACES>>)>>>
  84
  85 <SETG COMPONENTS <FUNCTION (L M)
  86         <REPEAT ((N <LINPOS .OUTCHAN>))
  87                 <FORMS <1 .L>>
  88                 <COND (<EMPTY? <SET L <REST .L>>><RETURN DONE>)>
  89                 <TERPRI>
  90                 <INDENT-TO .N>>>>
  91
  92
  93 \f"PAGE 4"
  94 <SETG FORMS <FUNCTION (L)
  95         <COND (<FLATSIZE .L <- <LINLNT .OUTCHAN> <LINPOS .OUTCHAN> .M>>
  96                 <PRIN1 .L>)
  97
  98
  99
 100               (<==? <TYPE .L> FORM> <PRINC "<">
 101                 <PRIN1 <1 .L>>
 102                 <PRINC " ">
 103                 <FORM1 <REST .L> <+ .M 1>>
 104                 <PRINC ">">)
 105               (<==? <TYPE .L> LIST><PRINC "(">
 106                 <FORM1 .L <+ .M 1>>
 107                 <PRINC ")">)
 108               (<==? <TYPE .L> VECTOR><PRINC "[">
 109                 <FORM1 .L <+ .M 1>>
 110                 <PRINC "]"> )
 111               (<==? <TYPE .L> FUNCTION>
 112                 <PRINC "<FUNCTION " >
 113                 <FORM1 .L <+ .M 1>>
 114                 <PRINC ">" >)
 115               (<MONAD? .L> <PRIN1 .L>)
 116               (ELSE <PRINC "#">
 117                 <PRIN1 <TYPE .L>>
 118                 <PRINC " (">
 119                 <FORM1 .L <+ .M 1>>
 120                 <PRINC ")"> )>
 121 >>
 122 \f"PAGE 5"
 123
 124 <SETG PPRINT <FUNCTION  (L "OPTIONAL" (OUTCHAN .OUTCHAN))
 125         <COND (<GASSIGNED? .L>
 126                <EPPRINT <CHTYPE (SETG .L ,.L) FORM>>)
 127               (<ASSIGNED? .L>
 128                <EPPRINT <CHTYPE (SET .L ..L) FORM>>)
 129               (ELSE UNASSIGNED)>>>
 130
 131
 132 <SETG EPPRINT <FUNCTION ( L "AUX" (M 1))
 133         <TERPRI>
 134         <FORMS .L>
 135         <TERPRI>
 136         DONE>>
 137
 138 %%<ENDBLOCK>
 139
 140 \f\ 3\f