diff options
Diffstat (limited to 'system/base/1.7.5/src/functions')
| -rw-r--r-- | system/base/1.7.5/src/functions | 760 |
1 files changed, 760 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/functions b/system/base/1.7.5/src/functions new file mode 100644 index 0000000..9f338ff --- /dev/null +++ b/system/base/1.7.5/src/functions @@ -0,0 +1,760 @@ +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; + |