mim/development/mim/vax/tty/ttyterm.mud

   1 "Interpreted output routines--used for echoing and NORMAL-OUT."
   2
   3 <SETG TABS <ISTRING 8>>
   4 <GDECL (TABS) STRING>
   5
   6 <DEFINE TTY-NORMAL-OUT (CHANNEL OPER CHRS
   7                         "OPTIONAL" (LENGTH <>)
   8                         "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
   9                               (TD <TT-DESC .TTY>))
  10   #DECL ((CHANNEL) CHANNEL (CHRS) <OR STRING CHARACTER> (LENGTH) <OR FIX FALSE>
  11          (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC)
  12   <COND (<TEST-TC-MODE .TC ,TM-BADPOS>
  13          ; "If we don't know where the cursor is, go to top of screen"
  14          <HOME-CURSOR .CHANNEL .OPER>
  15          <CLEAR-EOL .CHANNEL .OPER>)>
  16   <COND (<TYPE? .CHRS CHARACTER>
  17          <SET CHRS <1 <CHTYPE ,BUF1 STRING> .CHRS>>
  18          <SET LENGTH 1>)
  19         (<NOT .LENGTH>
  20          <SET LENGTH <LENGTH .CHRS>>)
  21         (<SET LENGTH <MIN .LENGTH <LENGTH .CHRS>>>)>
  22   <COND (<G? .LENGTH 0>
  23          <REPEAT ((CT 0) CHR (LASTCHR <ASCII 0>))
  24            #DECL ((CT) FIX (LASTCHR CHR) CHARACTER)
  25            <SET CHR <CHTYPE <ANDB <1 .CHRS> *177*> CHARACTER>>
  26            <SET CHRS <REST .CHRS>>
  27            <SET CT <+ .CT 1>>
  28            <COND (<NOT <OR <L? <ASCII .CHR> 32>
  29                            <==? <ASCII .CHR> 127>>>
  30                   ; "Normal character"
  31                   <DO-CHAR .CHANNEL .TC .TTY .TD .CHR>)
  32                  (<==? .CHR <ASCII 27> ;"Char Alt">
  33                   <DO-CHAR .CHANNEL .TC .TTY .TD !\$>)
  34                  (<==? .CHR <ASCII 13> ;"Char C.R.">
  35                   <OUTPUT-RAW-STRING .CHANNEL .CHR>
  36                   <TT-X .TTY 0>
  37                   <COND (<G? <TD-CRPAD .TD> 0>
  38                          <OUTPUT-PAD .CHANNEL .TD <TD-CRPAD .TD>>)>)
  39                  (<==? .CHR <ASCII 10> ;"Char L.F.">
  40                   <COND (<N==? .LASTCHR <ASCII 13> ;"Char C.R.">
  41                          <OUTPUT-RAW-STRING .CHANNEL <ASCII 13> ;"Char C.R.">
  42                          <TT-X .TTY 0>
  43                          <COND (<G? <TD-CRPAD .TD> 0>
  44                                 <OUTPUT-PAD .CHANNEL .TD <TD-CRPAD .TD>>)>)>
  45                   <DO-LF .CHANNEL .TC .TTY .TD>)
  46                  (<==? .CHR <ASCII 9> ;"Char Tab">
  47                   <PROG ((X <TT-X .TTY>) (LEN <- 8 <MOD .X 8>>))
  48                     <COND (<G? <SET X <+ .X .LEN>> <- <TD-WIDTH .TD> 1>>
  49                            <DO-CHAR .CHANNEL .TC .TTY .TD
  50                              !<REST ,TABS <- 8 .LEN>>>)
  51                           (T
  52                            <TT-X .TTY .X>
  53                            <OUTPUT-RAW-STRING .CHANNEL .CHR>)>>)
  54                  (<==? .CHR <ASCII 7> ;"Char Bell">
  55                   ; "Ring bell, don't move cursor"
  56                   <OUTPUT-RAW-STRING .CHANNEL .CHR>)
  57                  (<N==? .CHR <ASCII 127> ;"Char \7f">
  58                   ; "Rubout is normally invisible, so ,NULL will work."
  59                   <DO-CHAR .CHANNEL .TC .TTY .TD !\^
  60                            <ASCII <ANDB <+ <ASCII .CHR> %<- <ASCII !\A> 1>>
  61                                         *177*>>>)>
  62            <SET LASTCHR .CHR>
  63            <COND (<G=? .CT .LENGTH>
  64                   <RETURN .CT>)>>)
  65         (.LENGTH)>>
  66
  67 ; "Called with a tuple of chars to be dumped.  Handles ! stuff, including
  68    invocation of LF.  Chars seen here need no special handlng."
  69 <DEFINE DO-CHAR (CHANNEL TC TTY TD "TUPLE" CHARS "AUX" (X <TT-X .TTY>)
  70                  (WIDTH <- <TD-WIDTH .TD> 1>))
  71   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC
  72          (CHARS) <TUPLE [REST CHARACTER]> (X WIDTH) FIX)
  73   <MAPF <>
  74     <FUNCTION (CHR)
  75       #DECL ((CHR) CHARACTER)
  76       <COND (<G? <SET X <+ .X 1>> .WIDTH>
  77              ; "Line overflow"
  78              <OUTPUT-RAW-STRING .CHANNEL !\!>
  79              ; "Stuff out a CR"
  80              <TTY-NORMAL-OUT .CHANNEL NORMAL-OUT <ASCII 13> ;"Char C.R.">
  81              <SET X 1>
  82              ; "Go to next line -- may provoke --More-- and friends"
  83              <DO-LF .CHANNEL .TC .TTY .TD>)>
  84       <TT-X .TTY .X>
  85       <OUTPUT-RAW-STRING .CHANNEL .CHR>>
  86     .CHARS>>
  87
  88 <DEFINE TTY-MORE-LIMIT (CHANNEL OPER "OPTIONAL" NEW
  89                         "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>))
  90   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (NEW) <OR FIX FALSE>)
  91   <COND (<NOT <ASSIGNED? NEW>>
  92          <TT-MORE-LINES .TTY>)
  93         (T
  94          <TT-MORE-LINES .TTY .NEW>)>>
  95
  96 <SETG MORE-TYPE-LIMIT 5>
  97 <GDECL (MORE-TYPE-LIMIT) FIX>
  98 <DEFINE DO-LF (CHANNEL TC TTY TD "AUX" (LIN <TT-LAST-IN .TTY>)
  99                (Y <TT-Y .TTY>) (HEIGHT <TD-HEIGHT .TD>) (MODE <TC-MODE .TC>)
 100                (MORE? <>) (MORE-LINES <COND (<NOT <TT-MORE-LINES .TTY>>
 101                                              -1)
 102                                             (T
 103                                              <MIN <- .HEIGHT 2>
 104                                                   <TT-MORE-LINES .TTY>>)>))
 105   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC
 106          (Y LIN HEIGHT MODE) FIX (MORE?) <OR ATOM FALSE>)
 107   <COND (<AND <TEST-MODE .MODE ,TM-PAGE>
 108               <COND (<NOT <TEST-MODE .MODE ,TM-WRAP>>
 109                      <COND (<TEST-MODE .MODE ,TM-ITS>
 110                             <AND <G=? <TT-LAST-MORE .TTY> <- .HEIGHT 1>>
 111                                  <G? <- .HEIGHT .LIN> .MORE-LINES>>)
 112                            (T
 113                             <==? <+ .LIN 1> .HEIGHT>)>)
 114                     (<AND <TEST-MODE .MODE ,TM-WRAP>
 115                           <NOT <TEST-MODE .MODE ,TM-ITS>>>
 116                      <==? .Y <- .HEIGHT 1>>)
 117                     (T
 118                      <AND <==? .Y <- .HEIGHT 2>>
 119                           <G? <- .HEIGHT .LIN>
 120                                   .MORE-LINES>>)>>
 121          ; "Need a more"
 122          <SET MORE? <DO-MORE .CHANNEL .TC .TTY .TD>>)>
 123   <COND (<NOT .MORE?>
 124          <COND (<NOT <TEST-MODE .MODE ,TM-WRAP>>
 125                 ; "Not a more, but scrolling"
 126                 <TT-LAST-IN .TTY <MOD <+ .LIN 1> .HEIGHT>>
 127                 ; "Update last in, to trigger halt at screen bottom"
 128                 <TT-LAST-MORE .TTY <+ <TT-LAST-MORE .TTY> 1>>
 129                 <TT-Y .TTY <MIN <+ .Y 1> <- .HEIGHT 1>>>
 130                 <OUTPUT-RAW-STRING .CHANNEL <ASCII 10>>
 131                 ; "Pad only if scrolling"
 132                 <COND (<==? <TT-Y .TTY> <- .HEIGHT 1>>
 133                        <OUTPUT-PAD .CHANNEL .TD <TD-LFPAD .TD>>)>)
 134                (T
 135                 ; "Down cursor wraps if at bottom"
 136                 <DOWN-CURSOR .CHANNEL NORMAL-OUT>
 137                 <CLEAR-EOL .CHANNEL NORMAL-OUT>)>)>>
 138
 139 <DEFINE DO-MORE (CHANNEL TC TTY TD "AUX" ICHR (MODE <TC-MODE .TC>))
 140   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC
 141          (MODE) FIX (ICHR) CHARACTER)
 142   <TT-LAST-MORE .TTY 0>
 143   <COND (<TEST-MODE .MODE ,TM-ITS>
 144          <BOTTOM-CURSOR .CHANNEL NORMAL-OUT>
 145          <CLEAR-EOL .CHANNEL NORMAL-OUT>
 146          <TTY-NORMAL-OUT .CHANNEL NORMAL-OUT "**More**">)
 147         (<OUTPUT-RAW-STRING .CHANNEL <ASCII 7>>)>
 148   <DUMP-WRITE-BUFFER .TC>
 149   <COND (<TEST-MODE .MODE ,TM-ITS>
 150          <READ-UNTIL .CHANNEL <> T %<STRING <ASCII 32> ;"Char Space"
 151                                             <ASCII 127> ;"Char \7f">>)
 152         (T
 153          <READ-UNTIL .CHANNEL <ASCII 17> ;"Char Cntl-Q"
 154                      <> %<STRING <ASCII 17> ;"Char Cntl-Q"
 155                                  <ASCII 19> ;"Char Cntl-S">>)>
 156   <COND (<TEST-MODE .MODE ,TM-WRAP>
 157          <HOR-POS-CURSOR .CHANNEL NORMAL-OUT 0>
 158          <>)>>
 159
 160 <DEFINE READ-UNTIL (CHANNEL RETURNS CHECK-QUEUE? DONT
 161                     "AUX" (TC <CHANNEL-DATA .CHANNEL>) (OM <TC-MODE .TC>)
 162                           CHR Q)
 163   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL
 164          (RETURNS) <OR FALSE CHARACTER STRING> (CHECK-QUEUE?) <OR ATOM FALSE>
 165          (DONT Q) <OR CHARACTER STRING FALSE>)
 166   <UNWIND
 167    <PROG ()
 168      <TC-MODE .TC <ANDB .OM %<XORB ,TM-ECHO -1>>>
 169      <COND (<AND .CHECK-QUEUE?
 170                  <NOT <0? <TC-QCT .TC>>>>
 171             <COND (.DONT
 172                    <COND (<NOT <TYPE? <SET Q <TC-QUEUE .TC>> CHARACTER>>
 173                           <SET Q <1 .Q>>)>
 174                    <COND (<COND (<TYPE? .DONT CHARACTER>
 175                                  <==? .Q .DONT>)
 176                                 (<MEMQ .Q .DONT>)>
 177                           <SET CHR <GET-QUEUE-CHAR .TC>>)>)>)
 178            (T
 179             <REPEAT ()
 180               <SET CHR <TTY-READ-IMMEDIATE .CHANNEL READ-IMMEDIATE <> <>>>
 181               <COND (.DONT
 182                      <COND (<NOT <COND (<TYPE? .DONT CHARACTER>
 183                                         <==? .DONT .CHR>)
 184                                        (<MEMQ .CHR .DONT>)>>
 185                             <STORE-QUEUE-CHAR .TC .CHR>)>)>
 186               <COND (<OR <NOT .RETURNS>
 187                          <AND <TYPE? .RETURNS CHARACTER>
 188                               <==? .CHR .RETURNS>>
 189                          <MEMQ .CHR .RETURNS>>
 190                      <RETURN>)>>)>
 191      <TC-MODE .TC .OM>
 192      .CHR>
 193    <TC-MODE .TC .OM>>>
 194
 195 \f
 196 "Buffered input routines"
 197
 198 <MSETG BUF-START 1>
 199 <MSETG BUF-CURRENT 2>
 200 <MSETG BUF-AVAIL 3>
 201 <MSETG BUF-TOT 4>
 202 <MSETG BUF-X 5>
 203 <MSETG BUF-Y 6>
 204 <MSETG BUF-CONT 7>
 205
 206 <DEFINE UPDATE-INPUT (TTY MODE)
 207   #DECL ((TTY) TTY (MODE) FIX)
 208   <COND (<NOT <TEST-MODE .MODE ,TM-WRAP>>
 209          ; "Scroll mode"
 210          <COND (<NOT <TEST-MODE .MODE ,TM-ITS>>
 211                 ; "Normal mode"
 212                 <TT-LAST-IN .TTY 0>)
 213                (T       ; "ITS mode"
 214                 <TT-LAST-IN .TTY <TT-LAST-MORE .TTY>>)>)
 215         (T
 216          ; "Wrap mode"
 217          <TT-LAST-IN .TTY <TT-Y .TTY>>)>>
 218
 219 <DEFINE DO-RDTTY (CHANNEL TC BUF CONT END PROMPT "AUX" TOT AVAIL CBUF
 220                   (MODE <TC-MODE .TC>)
 221                   (IMAGE? <TEST-MODE .MODE ,TM-IMAGE>)
 222                   (ECHO? <ECHO-ON? .MODE>)
 223                   (BUFFER <TUPLE "" "" 0 0 0 0 0>) (TTY <TC-TTY .TC>))
 224   #DECL ((TC) TTY-CHANNEL (BUF CBUF END) STRING (TOT AVAIL CONT) FIX
 225          (IMAGE? ECHO?) <OR ATOM FALSE> (CHANNEL) CHANNEL
 226          (BUFFER) <TUPLE [2 STRING] [5 FIX]> (MODE) FIX
 227          (PROMPT) <OR FALSE STRING>)
 228   <SET AVAIL <- <LENGTH .BUF> .CONT>>
 229   <COND (<L=? .AVAIL 0>
 230          <LENGTH .BUF>)
 231         (T
 232          <SET TOT .CONT>
 233          <SET CBUF <REST .BUF .TOT>>
 234          <BUF-START .BUFFER .BUF>
 235          <BUF-CURRENT .BUFFER .CBUF>
 236          <BUF-AVAIL .BUFFER .AVAIL>
 237          <BUF-TOT .BUFFER .TOT>
 238          <BUF-X .BUFFER <TT-X .TTY>>
 239          <BUF-Y .BUFFER <TT-Y .TTY>>
 240          <BUF-CONT .BUFFER .CONT>
 241          <DUMP-WRITE-BUFFER .TC>
 242          <REPEAT (CHR (IJFN <TC-IJFN .TC>) (TTY <TC-TTY .TC>)
 243                   (ECHRS <TT-SPEC-CHARS .TTY>) RC TERM?)
 244            #DECL ((RC) <OR FIX FALSE> (CHR) CHARACTER (IJFN) FIX
 245                   (ECHRS) STRING (TERM?) <OR STRING FALSE> (TTY) TTY)
 246            <COND (<SET CHR <GET-BYTE .TC>>
 247                   <1 .CBUF .CHR>
 248                   <SET TERM? <MEMQ .CHR .END>>
 249                   <UPDATE-INPUT .TTY .MODE>
 250                   <COND (<AND .ECHO?
 251                               <OR .TERM?
 252                                   <AND <NOT <MEMQ .CHR .ECHRS>>
 253                                        <N==? .CHR <ASCII 13>>
 254                                        <N==? .CHR <ASCII 10>>>>>
 255                          ; "Echo char in these cases"
 256                          <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 257                                          .CHR>
 258                          <DUMP-WRITE-BUFFER .TC>)>
 259                   ; "Done.  Do this before checking for editing char"
 260                   <COND (.TERM?
 261                          <RETURN <+ .TOT 1>>)>
 262                   <COND (<OR <==? .CHR <TS-RUBOUT .ECHRS>>
 263                              <==? .CHR <TS-WORD .ECHRS>>
 264                              <==? .CHR <TS-KILL .ECHRS>>>
 265                          <BUF-CURRENT .BUFFER .CBUF>
 266                          <BUF-AVAIL .BUFFER .AVAIL>
 267                          <BUF-TOT .BUFFER .TOT>
 268                          <DO-RUBOUT .CHANNEL .TC .TTY .BUFFER
 269                                     <COND (<==? .CHR <TS-RUBOUT .ECHRS>>
 270                                            <ASCII 127>)
 271                                           (<==? .CHR <TS-WORD .ECHRS>>
 272                                            <ASCII 23> ;"Char Cntl-W")
 273                                           (<==? .CHR <TS-KILL .ECHRS>>
 274                                            <ASCII 21> ;"Char Cntl-U")>
 275                                     .PROMPT>
 276                          <SET CBUF <BUF-CURRENT .BUFFER>>
 277                          <SET AVAIL <BUF-AVAIL .BUFFER>>
 278                          <SET TOT <BUF-TOT .BUFFER>>)
 279                         (<==? .CHR <ASCII 12> ;"Char Cntl-L">
 280                          <CLEAR-SCREEN .CHANNEL FILL-READ-BUFFER>
 281                          <COND (.PROMPT
 282                                 <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 283                                                 .PROMPT>)>
 284                          <BUF-CONT .BUFFER 0>
 285                          <BUF-X .BUFFER <TT-X .TTY>>
 286                          <BUF-Y .BUFFER <TT-Y .TTY>>; "Now know where we start"
 287                          <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 288                                          .BUF .TOT>)
 289                         (<==? .CHR <ASCII 4> ;"Char Cntl-D">
 290                          <FRESH-LINE .CHANNEL FILL-READ-BUFFER>
 291                          <BUF-CONT .BUFFER 0>
 292                          <COND (.PROMPT
 293                                 <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 294                                                 .PROMPT>)>
 295                          <BUF-X .BUFFER <TT-X .TTY>>
 296                          <BUF-Y .BUFFER <TT-Y .TTY>>
 297                          <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 298                                          .BUF .TOT>)
 299                         (<==? .CHR <TS-REPRINT .ECHRS>>
 300                          ;"...")
 301                         (T
 302                          <COND (<OR <==? .CHR <ASCII 13>>
 303                                     <==? .CHR <ASCII 10>>>
 304                                 <1 .CBUF <ASCII 13>>
 305                                 <SET CBUF <REST .CBUF>>
 306                                 <SET TOT <+ .TOT 1>>
 307                                 <SET AVAIL <- .AVAIL 1>>
 308                                 <COND (<0? .AVAIL>
 309                                        <RETURN .TOT>)>
 310                                 <1 .CBUF <ASCII 10>>
 311                                 <TTY-NORMAL-OUT .CHANNEL FILL-READ-BUFFER
 312                                                 ,CRLF-STRING>)>
 313                          <SET TOT <+ .TOT 1>>
 314                          <SET CBUF <REST .CBUF>>
 315                          <SET AVAIL <- .AVAIL 1>>
 316                          <COND (<0? .AVAIL>
 317                                 <RETURN .TOT>)>)>
 318                   <DUMP-WRITE-BUFFER .TC>)>>)>>
 319
 320 <SETG CRLF-STRING <STRING <ASCII 13> <ASCII 10>>>
 321 <SETG BREAKS <STRING <ASCII 32> ;"Char Space"
 322                      <ASCII 9> ;"Char Tab"
 323                      <ASCII 10> ;"Char L.F."
 324                      <ASCII 13> ;"Char C.R."
 325                      <ASCII 45> ;"Char -"
 326                      <ASCII 47> ;"Char /"
 327                      <ASCII 46> ;"Char .">>
 328 ; "BUFFER is:  initial buf, current buf, space left in buf,
 329    total chrs in buf"
 330 <DEFINE DO-RUBOUT (CHANNEL TC TTY BUFFER WHICH PROMPT "AUX" KC (VERT 0)
 331                    (OY <TT-Y .TTY>))
 332   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (WHICH) CHARACTER
 333          (BUFFER) <TUPLE [2 STRING] [5 FIX]> (KC) CHARACTER (VERT) FIX
 334          (PROMPT) <OR FALSE STRING>)
 335   <COND (<0? <BUF-TOT .BUFFER>>
 336          <TTY-IMAGE-OUT .CHANNEL FILL-READ-BUFFER <ASCII 7> ;"Char Bell">)
 337         (<==? .WHICH <ASCII 127> ;"Char \7f">
 338          <BUF-CURRENT .BUFFER <BACK <BUF-CURRENT .BUFFER>>>
 339          <SET KC <1 <BUF-CURRENT .BUFFER>>>
 340          <BUF-AVAIL .BUFFER <+ <BUF-AVAIL .BUFFER> 1>>
 341          <BUF-TOT .BUFFER <- <BUF-TOT .BUFFER> 1>>
 342          <COND (<==? .KC <ASCII 10> ;"Char L.F.">
 343                 <COND (<AND <G? <BUF-TOT .BUFFER> 0>
 344                             <==? <1 <BACK <BUF-CURRENT .BUFFER>>>
 345                                  <ASCII 13> ;"Char C.R.">>
 346                        <BUF-CURRENT .BUFFER <BACK <BUF-CURRENT .BUFFER>>>
 347                        <BUF-AVAIL .BUFFER <+ <BUF-AVAIL .BUFFER> 1>>
 348                        <BUF-TOT .BUFFER <- <BUF-TOT .BUFFER> 1>>)>
 349                 <UPDATE-CURSOR-POS .CHANNEL .BUFFER 1 T .PROMPT>)
 350                (<OR <==? .KC <ASCII 9> ;"Char Tab">
 351                     <==? .KC <ASCII 13> ;"Char C.R.">>
 352                 <UPDATE-CURSOR-POS .CHANNEL .BUFFER 0 <> .PROMPT>
 353                 <COND (<==? <TT-Y .TTY> .OY>
 354                        <HOR-POS-CURSOR .CHANNEL FILL-READ-BUFFER
 355                                        <TT-X .TTY>>)
 356                       (T
 357                        <MOVE-CURSOR .CHANNEL FILL-READ-BUFFER
 358                                     <TT-X .TTY> <TT-Y .TTY>>)>
 359                 <CLEAR-EOL .CHANNEL FILL-READ-BUFFER>)
 360                (<AND <L? <ASCII .KC> <ASCII !\ >>
 361                      <N==? .KC <ASCII 27> ;"Char Alt">>
 362                 <ERASE-CHAR .CHANNEL FILL-READ-BUFFER 2>)
 363                (T
 364                 <ERASE-CHAR .CHANNEL FILL-READ-BUFFER>)>)
 365         (<==? .WHICH <ASCII 23> ;"Char Cntl-W">
 366          <DELTOCH .CHANNEL .BUFFER ,BREAKS .PROMPT>)
 367         (<==? .WHICH <ASCII 21> ;"Char Cntl-U">
 368          <DELTOCH .CHANNEL .BUFFER ,CRLF-STRING .PROMPT>)>>
 369
 370 <DEFINE DELTOCH (CHANNEL BUFFER STOP PROMPT "AUX"
 371                  (CCT <BUF-TOT .BUFFER>) (CHRS <BUF-CURRENT .BUFFER>) (UP 0)
 372                  (NBREAKFLAG <>) (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 373                  (OX <TT-X .TTY>) (OY <TT-Y .TTY>) NX NY)
 374   #DECL ((CHANNEL) CHANNEL (BUFFER) <TUPLE [2 STRING] [5 FIX]>
 375          (CCT UP) FIX (STOP CHRS) STRING (TC) TTY-CHANNEL (TTY) TTY
 376          (PROMPT) <OR FALSE STRING>)
 377   <REPEAT (CHR)
 378     <COND (<0? .CCT>
 379            <RETURN>)>
 380     <SET CCT <- .CCT 1>>
 381     <COND (<MEMQ <SET CHR <1 <SET CHRS <BACK .CHRS>>>> .STOP>
 382            <COND (.NBREAKFLAG   ; "Have we seen any non-breaks?"
 383                   <SET CHRS <REST .CHRS>>
 384                   <SET CCT <+ .CCT 1>>
 385                   <RETURN>)>)
 386           (T
 387            <SET NBREAKFLAG T>)>
 388     <COND (<==? .CHR <ASCII 10> ;"Char L.F.">
 389            ; "First, kill everything after the linefeed"
 390            <BUF-CURRENT .BUFFER <REST .CHRS>>
 391            <BUF-TOT .BUFFER <+ .CCT 1>>
 392            <UPDATE-CURSOR-POS .CHANNEL .BUFFER .UP T .PROMPT>
 393            <CLEAR-EOL .CHANNEL FILL-READ-BUFFER>
 394            <SET OX <TT-X .TTY>>
 395            <SET OY <TT-Y .TTY>>
 396            <SET UP 1>
 397            ; "Now, delete the CR if there"
 398            <COND (<AND <G? .CCT 0>
 399                        <==? <1 <BACK .CHRS>> <ASCII 13> ;"Char C.R.">>
 400                   <SET CHRS <BACK .CHRS>>
 401                   <SET CCT <- .CCT 1>>)>)>>
 402   ; "Update the buffer"
 403   <BUF-CURRENT .BUFFER .CHRS>
 404   <BUF-TOT .BUFFER .CCT>
 405   ; "And do the delete"
 406   <UPDATE-CURSOR-POS .CHANNEL .BUFFER .UP <> .PROMPT>
 407   ; "Computes new cursor pos, but doesn't move cursor"
 408   <SET NY <TT-Y .TTY>>
 409   <SET NX <TT-X .TTY>>
 410   <COND (<N==? .OY .NY>
 411          <REPEAT ()
 412            <COND (<N==? .OX 0>
 413                   <MOVE-CURSOR .CHANNEL FILL-READ-BUFFER 0 .OY>
 414                   <CLEAR-EOL .CHANNEL FILL-READ-BUFFER>
 415                   <SET OX -1>)>
 416            <COND (<L? <SET OY <- .OY 1>> 0>
 417                   <SET OY <- <TD-HEIGHT <TT-DESC .TTY>> 1>>)>
 418            <COND (<==? .OY .NY>
 419                   <MOVE-CURSOR .CHANNEL FILL-READ-BUFFER .NX .NY>
 420                   <RETURN>)>>)
 421         (T
 422          <HOR-POS-CURSOR .CHANNEL FILL-READ-BUFFER .NX>)>
 423   <CLEAR-EOL .CHANNEL FILL-READ-BUFFER>>
 424
 425 ; "Takes channel, buffer, # lines moved up.  Positions screen cursor at
 426    end of current buffer.  If CONT is non-zero, and have erased into that,
 427    and CONT doesn't start at beginning of line, will do wrong thing with
 428    horizontal position.  VERT is then used to find new vertical position."
 429 <DEFINE UPDATE-CURSOR-POS (CHANNEL BUFFER VERT "OPT" (MOVE? T) (PROMPT <>)
 430                            "AUX" IH (VLOSER? <>)
 431                            (LINES 0) NEWY HEIGHT (TC <CHANNEL-DATA .CHANNEL>))
 432   #DECL ((CHANNEL) CHANNEL (BUFFER) <TUPLE [2 STRING] [5 FIX]>
 433          (HEIGHT NEWY VERT) FIX (MOVE? VLOSER?) <OR ATOM FALSE>
 434          (PROMPT) <OR FALSE STRING> (TC) TTY-CHANNEL)
 435   <COND (<G? <BUF-CONT .BUFFER> <BUF-TOT .BUFFER>>
 436          ; "Sigh.  Don't know where the text starts"
 437          <BUF-CONT .BUFFER 0>
 438          <BUF-X .BUFFER 0>
 439          <BUF-Y .BUFFER -1>
 440          <SET VLOSER? T>
 441          <SET IH 0>)
 442         (T
 443          <SET IH <BUF-X .BUFFER>>)>
 444   <REPEAT ((FLG? <AND .VLOSER? .PROMPT>)
 445            (CT <COND (.FLG? <LENGTH .PROMPT>)
 446                      (T <BUF-TOT .BUFFER>)>)
 447            CHR (BB <COND (.FLG? .PROMPT)
 448                          (T <BUF-START .BUFFER>)>)
 449            (WIDTH <DO-TTY-PARM .TC PAGE-WIDTH>))
 450     #DECL ((WIDTH CT) FIX (CHR) CHARACTER (BB) STRING)
 451     <COND (<0? .CT>
 452            <COND (.FLG?
 453                   <SET BB <BUF-START .BUFFER>>
 454                   <SET CT <BUF-TOT .BUFFER>>
 455                   <SET FLG? <>>
 456                   <AGAIN>)
 457                  (T
 458                   <RETURN>)>)>
 459     <SET CHR <1 .BB>>
 460     <SET CT <- .CT 1>>
 461     <SET BB <REST .BB>>
 462     <COND (<OR <AND <G=? <ASCII .CHR> 32>
 463                     <L? <ASCII .CHR> 127>>
 464                <==? .CHR <ASCII 27> ;"Char Alt">>
 465            <SET IH <+ .IH 1>>)
 466           (<==? .CHR <ASCII 13> ;"Char C.R.">
 467            <SET IH 0>)
 468           (<==? .CHR <ASCII 10> ;"Char L.F.">
 469            <SET LINES <+ .LINES 1>>)
 470           (<==? .CHR <ASCII 9> ;"Char Tab">
 471            <SET IH <+ .IH <- 8 <MOD .IH 8>>>>)
 472           (<SET IH <+ .IH 2>>)>
 473     <COND (<G=? .IH <- .WIDTH 1>>
 474            <SET LINES <+ .LINES 1>>
 475            <SET IH <- .IH .WIDTH>>)>>
 476   <COND (<OR .VLOSER?
 477              <L? <BUF-Y .BUFFER> 0>>
 478          <SET NEWY <- <DO-TTY-PARM .TC PAGE-Y> .VERT>>)
 479         (<SET NEWY <+ <BUF-Y .BUFFER> .LINES>>)>
 480   <COND (<G=? .NEWY <SET HEIGHT <DO-TTY-PARM .TC PAGE-HEIGHT>>>
 481          <SET NEWY <MOD .NEWY .HEIGHT>>)
 482         (<L? .NEWY 0>
 483          <SET NEWY <- .HEIGHT <MOD <- .NEWY> .HEIGHT>>>)>
 484   <COND (.MOVE?
 485          <COND (<N==? .NEWY <DO-TTY-PARM .TC PAGE-Y>>
 486                 <MOVE-CURSOR .CHANNEL FILL-READ-BUFFER .IH .NEWY>)
 487                (T
 488                 <HOR-POS-CURSOR .CHANNEL FILL-READ-BUFFER .IH>)>)
 489         (T
 490          <DO-TTY-PARM .TC PAGE-X .IH>
 491          <DO-TTY-PARM .TC PAGE-Y .NEWY>)>>