gcc/m2/gm2-libs/StrIO.mod

   1 (* StrIO.mod provides simple string input output routines.
   2
   3 Copyright (C) 2001-2023 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE StrIO ;
  28
  29
  30 FROM ASCII IMPORT cr, nul, lf, bel, del, bs, nak, etb, ff, eof ;
  31 FROM StdIO IMPORT Read, Write ;
  32 FROM libc IMPORT isatty ;
  33
  34
  35 VAR
  36    IsATTY: BOOLEAN ;   (* Is default input from the keyboard? *)
  37
  38
  39 (*
  40    WriteLn - writes a carriage return and a newline
  41              character.
  42 *)
  43
  44 PROCEDURE WriteLn ;
  45 BEGIN
  46    Echo(cr) ;
  47    Write(lf)
  48 END WriteLn ;
  49
  50
  51 (*
  52    ReadString - reads a sequence of characters into a string.
  53                 Line editing accepts Del, Ctrl H, Ctrl W and
  54                 Ctrl U.
  55 *)
  56
  57 PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
  58 VAR
  59    n    ,
  60    high : CARDINAL ;
  61    ch   : CHAR ;
  62 BEGIN
  63    high := HIGH(a) ;
  64    n := 0 ;
  65    REPEAT
  66       Read(ch) ;
  67       IF (ch=del) OR (ch=bs)
  68       THEN
  69          IF n=0
  70          THEN
  71             Write(bel)
  72          ELSE
  73             Erase ;
  74             DEC(n)
  75          END
  76       ELSIF ch=nak    (* Ctrl U *)
  77       THEN
  78          WHILE n>0 DO
  79             Erase ;
  80             DEC(n)
  81          END
  82       ELSIF ch=etb    (* Ctrl W *)
  83       THEN
  84          IF n=0
  85          THEN
  86             Echo(bel)
  87          ELSIF AlphaNum(a[n-1])
  88          THEN
  89             REPEAT
  90                Erase ;
  91                DEC(n)
  92             UNTIL (n=0) OR (NOT AlphaNum(a[n-1]))
  93          ELSE
  94             Erase ;
  95             DEC(n)
  96          END
  97       ELSIF n<=high
  98       THEN
  99          IF (ch=cr) OR (ch=lf)
 100          THEN
 101             a[n] := nul ;
 102             INC(n)
 103          ELSIF ch=ff
 104          THEN
 105             a[0] := ch ;
 106             IF high>0
 107             THEN
 108                a[1] := nul
 109             END ;
 110             ch := cr
 111          ELSIF ch>=' '
 112          THEN
 113             Echo(ch) ;
 114             a[n] := ch ;
 115             INC(n)
 116          ELSIF ch=eof
 117          THEN
 118             a[n] := ch ;
 119             INC(n) ;
 120             ch := cr;
 121             IF n<=high
 122             THEN
 123                a[n] := nul
 124             END
 125          END
 126       ELSIF ch#cr
 127       THEN
 128          Echo(bel)
 129       END
 130    UNTIL (ch=cr) OR (ch=lf)
 131 END ReadString ;
 132
 133
 134 (*
 135    WriteString - writes a string to the default output.
 136 *)
 137
 138 PROCEDURE WriteString (a: ARRAY OF CHAR) ;
 139 VAR
 140    n    ,
 141    high : CARDINAL ;
 142 BEGIN
 143    high := HIGH(a) ;
 144    n := 0 ;
 145    WHILE (n <= high) AND (a[n] # nul) DO
 146       Write(a[n]) ;
 147       INC(n)
 148    END
 149 END WriteString ;
 150
 151
 152 (*
 153    Erase - writes a backspace, space and backspace to remove the
 154            last character displayed.
 155 *)
 156
 157 PROCEDURE Erase ;
 158 BEGIN
 159    Echo(bs) ;
 160    Echo(' ') ;
 161    Echo(bs)
 162 END Erase ;
 163
 164
 165 (*
 166    Echo - echos the character, ch, onto the output channel if IsATTY
 167           is true.
 168 *)
 169
 170 PROCEDURE Echo (ch: CHAR) ;
 171 BEGIN
 172    IF IsATTY
 173    THEN
 174       Write(ch)
 175    END
 176 END Echo ;
 177
 178
 179 (*
 180    AlphaNum- returns true if character, ch, is an alphanumeric character.
 181 *)
 182
 183 PROCEDURE AlphaNum (ch: CHAR) : BOOLEAN ;
 184 BEGIN
 185    RETURN ((ch>='a') AND (ch<='z')) OR
 186           ((ch>='A') AND (ch<='Z')) OR
 187           ((ch>='0') AND (ch<='9'))
 188 END AlphaNum ;
 189
 190
 191 BEGIN
 192 (*   IsATTY := isatty() *)
 193    IsATTY := FALSE
 194 END StrIO.