path: root/system/base/1.7.5/src/functions

PACKET  editor functions  DEFINES                     (* FUNCTIONS - 052 *)
        (**************)                              (*  17.07.85 -bk-  *)
                                                      (*  10.09.85 -ws-  *)
        edit,                                         (*  25.04.86 -sh-  *)
        show,                                         (*  27.05.86 -wk-  *)
        U, 
        D,
        T,
        up,
        down,
        downety,
        uppety,
        to line,
        PUT,
        GET,
        P,
        G,
        limit,
        len,
        eof,
        C,
        change to,
        CA,
        change all,
        lines,
        line no,
        col,
        mark,
        at,
        word,
        std kommando interpreter,
        note,
        note line,
        note edit,
        anything noted,
        note file:
 
 
LET     marker       = "^",
        ersatzmarker = "'",
        schritt      = 50,
        file size    = 4072,
        write acc    = TRUE,
        read acc     = FALSE;
 
LET     bold         = 2,
        integer      = 3,
        string       = 4,
        end of file  = 7;
 
LET     std res      = "eqvw19dpgn"9"";
 
FILE VAR edfile;
BOOL VAR from scratchfile :: FALSE;
TEXT VAR kommandotext, tabulator, zeile;
 

PROC std kommando interpreter (TEXT CONST taste) :
  enable stop ; 
  edfile := editfile;
  set busy indicator; 
  SELECT pos (std res, taste) OF
    CASE 1 (*e*)  : edit 
    CASE 2 (*q*)  : quit
    CASE 3 (*v*)  : quit last
    CASE 4 (*w*)  : open editor (next editor)
    CASE 5 (*1*)  : toline (1); col (1)
    CASE 6 (*9*)  : toline (lines); col (len+1)
    CASE 7 (*d*)  : d case 
    CASE 8 (*p*)  : p case 
    CASE 9 (*g*)  : g case 
    CASE 10(*n*)  : note edit
    CASE 11(*tab*): change tabs
    OTHERWISE     : echtes kommando analysieren
  END SELECT . 
 
d case :
  IF   mark
  THEN PUT ""; mark (FALSE); from scratchfile := TRUE
  ELSE textzeile auf taste legen
  FI .

p case :
  IF   mark                                                          (*sh*)
  THEN IF   write permission 
       THEN PUT ""; push(""27""12""); from scratchfile := TRUE
       ELSE out (""7"")
       FI
  ELSE textzeile auf taste legen
  FI .

g case :
  IF   write permission                                              (*sh*)
  THEN IF   from scratchfile 
       THEN GET "" 
       ELSE IF is editget
              THEN push (lernsequenz auf taste ("g")); nichts neu
            FI
       FI
  ELSE out (""7"")
  FI .

textzeile auf taste legen : 
  read record (edfile, zeile); 
  zeile := subtext (zeile, col);
  lernsequenz auf taste legen ("g", zeile);
  from scratchfile := FALSE; zeile neu . 

next editor :
  (aktueller editor MOD groesster editor) + 1 .
 
change tabs :
  get tabs (edfile, tabulator) ;
  IF   pos (tabulator, marker) <> 0
  THEN change all (tabulator, marker, ersatzmarker)
  ELSE change all (tabulator, ersatzmarker, marker)
  FI ;
  put tabs (edfile, tabulator) ;
  ueberschrift neu .
 
echtes kommando analysieren :
  kommandotext := kommando auf taste (taste);
  IF   kommandotext = ""
  THEN nichts neu; LEAVE std kommando interpreter
  FI ;
  scan (kommandotext);
  TEXT VAR s1; INT VAR t1; next symbol (s1, t1);
  TEXT VAR s2; INT VAR t2; next symbol (s2, t2);
  IF   t1 = integer AND t2 = end of file THEN toline (int (s1))
  ELIF t1 = string  AND t2 = end of file THEN down (s1)
  ELIF perhaps simple up or down         THEN
  ELIF perhaps simple changeto           THEN
  ELSE do (kommandotext)
  FI . 
 
perhaps simple up or down :
  IF   t1 = bold
  THEN TEXT VAR s3; INT VAR t3; next symbol (s3, t3);
       IF   t3 <> end of file THEN FALSE
       ELIF s1 = "U"          THEN perhaps simple up
       ELIF s1 = "D"          THEN perhaps simple down
                              ELSE FALSE
       FI
  ELSE FALSE
  FI .
 
perhaps simple up :
  IF   t2 = string  THEN up (s2);       TRUE 
  ELIF t2 = integer THEN up (int (s2)); TRUE 
                    ELSE                FALSE 
  FI . 
 
perhaps simple down : 
  IF   t2 = string  THEN down (s2);       TRUE 
  ELIF t2 = integer THEN down (int (s2)); TRUE 
                    ELSE                  FALSE 
  FI .
 
perhaps simple changeto : 
  IF   t1 = string AND s2 = "C" AND t3 is string AND t4 is eof 
  THEN s1 C s3; TRUE 
  ELSE FALSE 
  FI . 
 
t3 is string : 
  next symbol (s3, t3); 
  t3 = string . 

t4 is eof : 
  TEXT VAR s4; INT VAR t4; 
  next symbol (s4, t4); 
  t4 = end of file . 
END PROC std kommando interpreter; 

 
PROC edit (FILE VAR f) : 
  enable stop; 
  IF aktueller editor > 0                                            (*wk*)
    THEN ueberschrift neu
  FI ;
  open editor (f, write acc);
  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
END PROC edit;
 
 
PROC edit (FILE VAR f, INT CONST x, y, x size, y size) :
  enable stop;
  open editor (groesster editor + 1, f, write acc, x, y, x size, y size);
  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
END PROC edit;
 

PROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter) :
  enable stop;
  open editor (f, write acc);
  edit (groesster editor, res, PROC(TEXT CONST) kdo interpreter)
END PROC edit;
 
 
PROC edit :
  IF   aktueller editor > 0
  THEN dateiname einlesen;
       edit (dateiname)
  ELSE edit (last param)
  FI .
 
dateiname einlesen :
  INT VAR x, y; get editcursor (x, y);
  IF x < x size - 17                                                 (*sh*)
  THEN cursor (x, y);
       out (""15"Dateiname:"14"");
       (x size-14-x) TIMESOUT " ";
       (x size-14-x) TIMESOUT ""8"";
       TEXT VAR dateiname := std;
       editget (dateiname);
       trailing blanks entfernen; 
       quotes entfernen
  ELSE errorstop ("Fenster zu klein")
  FI .
 
trailing blanks entfernen: 
  INT VAR i := LENGTH dateiname; 
  WHILE (dateiname SUB i) = " " REP i DECR 1 PER; 
  dateiname := subtext (dateiname, 1, i) . 
 
quotes entfernen :
  IF   (dateiname SUB 1) = """" AND (dateiname SUB LENGTH dateiname) = """"
  THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1)
  FI .
END PROC edit;
 
 
PROC edit (TEXT CONST filename) :
  IF   filename <> ""
  THEN edit named file
  ELSE errorstop ("Name ungueltig")
  FI . 
 
edit named file :
  last param (filename);
  IF   exists (filename) COR yes ("""" + filename + """ neu einrichten")
  THEN IF aktueller editor > 0 THEN ueberschrift neu FI;             (*sh*)
       FILE VAR f := sequential file (modify, filename);
       headline (f, filename); edit (f); last param (filename)
  ELSE errorstop ("")
  FI .
END PROC edit;
 
 
PROC edit (TEXT CONST filename, INT CONST x, y, x size, y size) :
  last param (filename);
  IF exists (filename) COR yes ("""" + filename + """ neu einrichten")
  THEN FILE VAR f := sequential file (modify, filename);
       headline (f, filename); edit (f, x, y, x size, y size);
       last param (filename)
  ELSE errorstop ("")
  FI
END PROC edit;
 
 
PROC edit (INT CONST i) :
  edit (i, std res, PROC (TEXT CONST) std kommando interpreter)
END PROC edit;
 
 
PROC show (FILE VAR f) :
  enable stop; 
  open editor (f, read acc);
  edit(groesster editor, std res, PROC(TEXT CONST) std kommando interpreter);
END PROC show;
 

PROC show (TEXT CONST filename) :                                    (*sh*)
  last param (filename);
  IF   exists (filename)
  THEN FILE VAR f := sequential file (modify, filename);
       show (f); last param (filename)
  ELSE errorstop ("""" + filename + """ gibt es nicht") 
  FI
END PROC show; 

 
PROC show :
  show (last param)
END PROC show;
 
 
DATASPACE VAR local space;
INT  VAR zeilenoffset;
TEXT VAR kopierzeile;
 
 
OP PUT (TEXT CONST filename) :
  nichts neu;
  IF   mark 
  THEN markierten bereich in datei schreiben
  FI .
 
markierten bereich in datei schreiben :
  disable stop;
  zieldatei vorbereiten;
  quelldatei oeffnen;
  IF   noch genuegend platz in der zieldatei                         (*sh*)
  THEN zeilenweise kopieren
  ELSE errorstop ("FILE-Ueberlauf")
  FI ;
  quelldatei schliessen;
  zieldatei schliessen;
  set busy indicator .

zieldatei vorbereiten :
  FRANGE VAR ganze zieldatei;
  IF exists (filename) THEN forget (filename); ueberschrift neu FI;
  FILE VAR destination;
  IF   filename = ""
  THEN forget (local space); local space := nilspace;
       destination := sequential file (output, local space)
  ELSE destination := sequential file (modify, filename) ;
       INT CONST groesse der zieldatei := lines (destination);       (*sh*)
       set marked range (destination, ganze zieldatei) ;
       output (destination)
  FI .

quelldatei oeffnen :
  zeilenoffset := mark line no (edfile) - 1;
  INT CONST old line := line no, old col := col;
  FRANGE VAR ganze datei;
  set range (edfile, mark lineno (edfile), mark col (edfile), ganze datei);
  input (edfile) .
 
noch genuegend platz in der zieldatei :
  lines + groesse der zieldatei < file size .

zeilenweise kopieren :
  enable stop;
  satznr neu;
  INT VAR zeile;
  FOR zeile FROM 1 UPTO lines (edfile) REP
    getline (edfile, kopierzeile);
    putline (destination, kopierzeile);
    satznr zeigen
  PER .
 
quelldatei schliessen :
  modify (edfile);
  set range (edfile, ganze datei);
  to line (old line);
  col (old col) .
 
zieldatei schliessen :
  IF   filename <> ""
  THEN INT CONST last line written := line no (destination) ;
       modify (destination) ;
       to line (destination, last line written) ;
       col (destination, len (destination) + 1) ;
       bild neu (destination) ;
       set range (destination, ganze zieldatei)
  FI .
END OP PUT;

 
OP P (TEXT CONST filename) :
  PUT filename
END OP P ;


OP GET (TEXT CONST filename) :                                       (*sh*)
  IF   NOT write permission
  THEN errorstop ("Schreibversuch auf 'show'-Datei")
  FI ;
  quelldatei oeffnen;
  IF   nicht mehr genuegend platz im editfile 
  THEN quelldatei schliessen; errorstop ("FILE-Ueberlauf")
  FI ;
  disable stop;
  zieldatei oeffnen;
  zeilenweise kopieren ;
  zieldatei schliessen;
  quelldatei schliessen;
  set busy indicator .

quelldatei oeffnen :
  FILE VAR source;
  FRANGE VAR ganze quelldatei;
  IF   filename = ""
  THEN source := sequential file (input, local space)
  ELSE IF NOT exists (filename) 
       THEN errorstop ("""" + filename + """ gibt es nicht")
       FI ;
       source := sequential file (modify, filename); 
       INT CONST old line := line no (source),
                 old col  := col (source);
       set marked range (source, ganze quelldatei);
       input (source)
  FI .
 
nicht mehr genuegend platz im editfile :
  lines (source) + lines >= file size .

zeilenweise kopieren :
  enable stop;
  satznr neu;
  INT VAR zeile;
  FOR zeile FROM 1 UPTO lines (source) REP
    getline (source, kopierzeile);
    putline (edfile, kopierzeile);
    satznr zeigen
  PER .
 
zieldatei oeffnen :
  zeilenoffset := line no - 1;
  leere datei in editfile einschachteln;
  output (edfile) .
 
leere datei in editfile einschachteln :
  INT CONST range start col := col;
  FRANGE VAR ganze datei;
  set range (edfile, line no, col, ganze datei);
  IF lines = 1 THEN delete record (edfile) FI .
 
quelldatei schliessen :
  IF   filename <> ""
  THEN modify (source);
       set range (source, ganze quelldatei);
       to line (source, old line);
       col (source, old col)
  FI .
 
zieldatei schliessen :
  modify (edfile);
  to line (lines);
  col (range start col);
  set range (edfile, ganze datei);
  abschnitt neu (zeilenoffset + 1, lines) .
END OP GET;

 
OP G (TEXT CONST filename) :
  GET filename
END OP G;
 
 
INT PROC len :
  len (edfile)
END PROC len;
 
 
PROC col (INT CONST stelle) :
  nichts neu; col (edfile, stelle)
END PROC col;
 
 
INT PROC col :
  col (edfile)
END PROC col;
 
 
PROC limit (INT CONST limit) :
  nichts neu; max line length (edfile, limit)
END PROC limit;
 
 
INT PROC limit :
  max line length (edfile)
END PROC limit;
 
 
INT PROC lines :
  lines (edfile)
END PROC lines;
 
 
INT PROC line no :
  line no (edfile)
END PROC line no;
 
 
PROC to line (INT CONST satz nr) :
  satznr neu;
  edfile := editfile; 
  IF   satz nr > lines 
  THEN toline (edfile, lines); col (len + 1)
  ELSE to line (edfile, satz nr)
  FI
END PROC to line;
 
 
OP T (INT CONST satz nr) :
  to line (satz nr)
END OP T;
 
 
PROC down (INT CONST anz) :
  nichts neu; down (edfile, anz)
END PROC down;
 
 
OP D (INT CONST anz) :
  down (anz)
END OP D;
 
 
PROC up (INT CONST anz) :
  nichts neu; up (edfile, anz)
END PROC up;
 
 
OP U (INT CONST anz) :
  up (anz)
END OP U;
 
 
PROC down (TEXT CONST muster) :
  nichts neu;
  REP
    down (muster, schritt - line no MOD schritt);
    IF   pattern found
    THEN LEAVE down
    ELSE satznr zeigen
    FI
  UNTIL eof PER
END PROC down;
 
 
OP D (TEXT CONST muster) :
  down (muster)
END OP D;
 
 
PROC down (TEXT CONST muster, INT CONST anz) :
  nichts neu; down (edfile, muster, anz)
END PROC down;
 
 
PROC up (TEXT CONST muster) :
  nichts neu;
  REP
    up (muster, (line no - 1) MOD schritt + 1);
    IF   pattern found
    THEN LEAVE up
    ELSE satznr zeigen
    FI
  UNTIL line no = 1 PER
END PROC up;
 
 
OP U (TEXT CONST muster) :
  up (muster)
END OP U;
 
 
PROC up (TEXT CONST muster, INT CONST anz) :
  nichts neu; up (edfile, muster, anz)
END PROC up;
 
 
PROC downety (TEXT CONST muster) :
  nichts neu;
  IF   NOT at (muster)
  THEN down (muster)
  FI
END PROC downety;
 

PROC downety (TEXT CONST muster, INT CONST anz) :
  nichts neu; downety (edfile, muster, anz)
END PROC downety;
 

PROC uppety (TEXT CONST muster) :
  nichts neu;
  IF   NOT at (muster)
  THEN up (muster)
  FI
END PROC uppety;

 
PROC uppety (TEXT CONST muster, INT CONST anz) :
  nichts neu; uppety (edfile, muster, anz)
END PROC uppety;

 
OP C (TEXT CONST old, new) :
  change to (old, new)
END OP C;
 
OP C (TEXT CONST replacement) : 
  IF   NOT write permission                                          (*sh*)
  THEN errorstop ("Schreibversuch auf 'show'-Datei")
  FI ;
  IF   at (edfile, match(0))
  THEN zeile neu; change (edfile, matchpos(0), matchend(0), replacement)
  FI
END OP C; 
 
PROC change to (TEXT CONST old, new) :
  IF   NOT write permission                                          (*sh*)
  THEN errorstop ("Schreibversuch auf 'show'-Datei")
  FI ;
  nichts neu;
  REP
    downety (old, schritt - line no MOD schritt);
    IF   pattern found
    THEN change (edfile, matchpos(0), matchend(0), new);
         col (col + LENGTH new); zeile neu;
         LEAVE changeto
    ELSE satznr zeigen
    FI
  UNTIL eof PER 
END PROC change to;
 
 
OP CA (TEXT CONST old, new) :
  change all (old, new)
END OP CA;
 

PROC change all (TEXT CONST old, new) :
  WHILE NOT eof REP old C new PER
END PROC change all;
 
 
BOOL PROC eof :
  eof (edfile)
END PROC eof;
 
 
BOOL PROC mark :
  mark (edfile)
END PROC mark;
 
 
PROC mark (BOOL CONST mark on) :
  nichts neu;
  IF   mark on
  THEN mark (edfile, line no, col)
  ELSE mark (edfile, 0, 0)
  FI
END PROC mark;
 
 
BOOL PROC at (TEXT CONST pattern) :
  at (edfile, pattern)
END PROC at;
 
TEXT PROC word :
  word (edfile)
END PROC word;

 
TEXT PROC word (TEXT CONST sep) :
  word (edfile, sep)
END PROC word;

 
TEXT PROC word (INT CONST len) :
 word (edfile, len)
END PROC word;
 
 
LET no access = 0,
    edit access = 1,
    output access = 2;
 
INT VAR last note file mode;
FILE VAR notebook; 
INITFLAG VAR this packet := FALSE;
DATASPACE VAR note ds;
 
 
PROC note (TEXT CONST text) :
  access note file (output access);
  write (notebook, text)
END PROC note;
 

PROC note (INT CONST number) :
  access note file (output access);
  put (notebook, number)
END PROC note;
 

PROC note line :
  access note file (output access);
  line (notebook)
END PROC note line;
 

BOOL PROC anything noted :
  access note file (no access);
  last note file mode = output access
END PROC anything noted;
 

FILE PROC note file :
  access note file (output access);
  notebook
END PROC note file;
 

PROC note edit (FILE VAR context) :                                  (*sh*)
  access note file (edit access);
  make notebook erasable;
  IF aktueller editor = 0
    THEN open editor (1, context, write acc, 1, 1, x size - 1, y size)
  FI ;
  get window size;
  IF   window large enough
  THEN include note editor;
       edit (aktueller editor-1, aktueller editor, aktueller editor-1,
             std res, PROC (TEXT CONST) std kommando interpreter)
  FI .
 
get window size : 
  INT VAR x, y, windows x size, windows y size; 
  get window (x, y, windows x size, windows y size) .
 
window large enough :
  windows y size > 4 .
 
include note editor :
  open editor (aktueller editor + 1, notebook, write acc,
               x, y + (windows y size + 1) DIV 2,
               windows x size, windows y size DIV 2) .
 
make notebook erasable :
  last note file mode := edit access .
END PROC note edit;
 

PROC note edit :
  access note file (edit access);
  make notebook erasable;
  edit (notebook) .
 
make notebook erasable :
  last note file mode := edit access .
END PROC note edit;
 
 
PROC access note file (INT CONST new mode) :
  disable stop;
  initialize note ds if necessary;
  IF   last note file mode < new mode
  THEN forget (note ds);
       note ds := nilspace;
       notebook := sequential file (output, note ds);
       headline (notebook, "notebook");
       last note file mode := new mode
  FI .
 
initialize note ds if necessary :
  IF   NOT initialized (this packet)
  THEN note ds := nilspace;
       last note file mode := no access
  FI .
END PROC access note file;

END PACKET editor functions;