1 files changed, 268 insertions, 0 deletions
diff --git a/system/dos/1.8.7/src/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos
new file mode 100644
index 0000000..23885e6
--- /dev/null
+++ b/system/dos/1.8.7/src/manager-S.dos
@@ -0,0 +1,268 @@
+PACKET dos single DEFINES                       (* Copyright (C) 1985 *)
+                                                (* Frank Klapper      *)
+                                                (* 11.09.87           *)
+  /,
+  dos,
+  provide dos channel,
+  archive,
+  reserve,
+  release,
+  save,
+  fetch,
+  erase,
+  check,
+  exists,
+  ALL,
+  SOME,
+  clear,
+  list, 
+  format:
+
+LET std archive channel = 31,
+    main    channel = 1;
+
+INT VAR dos channel := std archive channel;
+INT VAR fetch save modus;
+
+TYPE DOSTASK = TEXT;
+
+DOSTASK CONST dos := "DOS";
+
+OP := (DOSTASK VAR d, TEXT CONST t):
+  CONCR (d) := t
+
+END OP :=;
+
+DOSTASK OP / (TEXT CONST text):
+  DOSTASK VAR d;
+  CONCR (d) := text;
+  d
+
+END OP /;
+
+BOOL PROC is dostask (DOSTASK CONST d):
+  CONCR (d) = "DOS"
+
+END PROC is dos task;
+
+PROC provide dos channel (INT CONST channel no):
+  dos channel := channel no
+
+END PROC provide dos channel;
+
+DATASPACE VAR space := nilspace;
+forget (space);
+
+PROC reserve (TEXT CONST string, DOSTASK CONST task):
+   IF is dostask (task)
+    THEN fetch save modus := save fetch mode (string);
+         open dos disk (path (string))
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC reserve;
+
+PROC archive (TEXT CONST string, DOSTASK CONST task):
+  reserve (string, task)
+
+END PROC archive;
+
+PROC release (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN close dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC release;
+
+PROC fetch (TEXT CONST name, DOSTASK CONST from):
+  IF is dostask (from)
+    THEN fetch from dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+fetch from dos disk:
+  IF NOT exists (name) COR overwrite permitted
+    THEN do fetch 
+  FI.
+
+overwrite permitted:
+  say ("eigene Datei """) ; 
+  say (name) ; 
+  yes (""" auf der Diskette ueberschreiben"). 
+
+do fetch:
+  last param (name);
+  disable stop;
+  continue (dos channel);
+  fetch (dos name (name, read modus), space, fetch save modus);
+  continue (main channel);
+  IF NOT is error
+    THEN forget (name, quiet);
+         copy (space, name)
+  FI;
+  forget (space).
+
+END PROC fetch;
+
+PROC erase (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN do erase dos file
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+do erase dos file:
+  IF NOT exists (name, /"DOS")
+    THEN error stop ("die Datei """ + name + """ gibt es nicht")
+  ELIF yes ("""" + dos name (name, read modus)+ """ auf Der Diskette loeschen")
+    THEN disable stop;
+         continue (dos channel);
+         erase dos file (dos name (name, read modus));
+         continue (main channel)
+  FI.
+
+END PROC erase;
+
+PROC save (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN save to dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+save to dos disk:
+  TEXT CONST save file name :: dos name (name, write modus);
+  disable stop;
+  continue (dos channel);
+  IF NOT dos file exists (save file name) COR overwrite permitted
+    THEN IF dos file exists (save file name)
+           THEN erase dos file (save file name)
+         FI;
+         save (save file name, old (name), fetch save modus);
+  FI;
+  continue (main channel).
+
+overwrite permitted:
+  continue (main channel);
+  BOOL CONST result :: yes ("""" + save file name + """ auf der Diskette ueberschreiben");
+  continue (dos channel);
+  result.
+
+END PROC save;
+
+PROC check (TEXT CONST name, DOSTASK CONST from):
+  IF is dostask (from)
+    THEN disable stop;
+         continue (dos channel);
+         check file (dos name (name, read modus));
+         continue (main channel)
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC check;
+
+BOOL PROC exists (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         BOOL VAR dummy := dos file exists (dos name (name, read modus));
+         continue (main channel);
+         enable stop;
+         dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); FALSE
+  FI.
+
+END PROC exists;
+
+PROC list (DOSTASK CONST from):
+  forget (space);
+  space := nilspace;
+  FILE VAR list file := sequential file (output, space);
+  list (list file, from);
+  modify (list file);
+  show (list file);
+  forget (space).
+
+ENDPROC list;
+
+PROC list (FILE VAR list file, DOSTASK CONST from):
+  IF is dos task (from)
+    THEN list dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+list dos disk:
+  disable stop;
+  continue (dos channel);
+  dos list (space);
+  continue (main channel);
+  enable stop;
+  output (list file);
+  FILE VAR list source := sequential file (output, space);
+  TEXT VAR line;
+  WHILE NOT eof (list source) REP
+    getline (list source, line);
+    putline (list file,   line)
+  PER.
+
+END PROC list;
+
+THESAURUS OP ALL (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         THESAURUS VAR dummy := all dos files;
+         continue (main channel);
+         enable stop;
+         dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus
+  FI.
+
+END OP ALL;
+
+THESAURUS OP SOME (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         THESAURUS VAR dummy := all dos files;
+         continue (main channel);
+         enable stop;
+         SOME dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus
+  FI.
+
+END OP SOME;
+
+PROC clear (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN clear disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+clear disk:
+  disable stop;
+  IF yes ("Diskette loeschen")
+    THEN continue (dos channel);
+         clear dos disk;
+         continue (main channel)
+  FI.
+
+END PROC clear;
+
+PROC format (INT CONST format code, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN format disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+format disk:
+  disable stop;
+  IF yes ("Diskette formatieren")
+    THEN continue (dos channel);
+         format dos disk (format code);
+         continue (main channel)
+  FI.
+
+END PROC format;
+
+END PACKET dos single;
+