path: root/app/eudas/5.3/src/eudas.dialoghilfen.04

PACKET eudas dialoghilfen

(*************************************************************************)
(*                                                                       *)
(*     Dialoghilfen für EUDAS                                            *)
(*                                                                       *)
(*     Version 04                                                        *)
(*                                                                       *)
(*     Autor: Thomas Berlage                                             *)
(*     Stand: 15.10.88                                                   *)
(*                                                                       *)
(*************************************************************************)

  DEFINES

  fenstergroessen bestimmen,
  fenster links,
  fenster rechts,
  fenster ganz,

  ausfuehrung,
  auf archiv,
  bitte warten,
  frage ob einrichten,
  set command dialogue false,
  reset command dialogue,
  edit :


(**************************** Fenster *************************************)

LET
  breite links = 16;

INT VAR
  last x size := 0,
  last y size;

FENSTER VAR
  ganz,
  links,
  rechts,
  fuss;

fenster initialisieren (fuss);
fenster initialisieren (ganz);
fenster initialisieren (links);
fenster initialisieren (rechts);


PROC fenstergroessen bestimmen :

  IF x size <> last x size OR y size <> last y size THEN
    neue fenstergroessen;
    last x size := x size;
    last y size := y size
  END IF .

neue fenstergroessen :
  fenstergroesse setzen (ganz, 1, 2, x size - 1, y size - 1);
  fenstergroesse setzen (links, 1, 2, breite links, y size - 2);
  fenstergroesse setzen (rechts,
    breite links + 1, 2, x size - breite links - 1, y size - 2);
  fenstergroesse setzen (fuss, 1, y size, x size - 1, 1);
  dialogfenster (rechts);
  anzeigefenster (rechts);
  uebersichtsfenster (ganz) .

END PROC fenstergroessen bestimmen;

FENSTER PROC fenster rechts : rechts END PROC fenster rechts;

FENSTER PROC fenster links : links  END PROC fenster links;

FENSTER PROC fenster ganz : ganz  END PROC fenster ganz;


(******************** Parameter-Auswahl ***********************************)

LET
  keine datei zur auswahl =  #1001#
    "Keine Datei zur Auswahl vorhanden.",
  name der datei =  #1002#
    "Name der Datei: ";

SATZ VAR sammel;

THESAURUS VAR
  zusaetzliche namen;

TEXT VAR
  feldpuffer,
  dateiname,
  offene;

LET
  niltext = "",
  esc z = ""27"z",
  cleol = ""5"";

LET
  fetch code = 11,
  ack = 0;

DATASPACE VAR ds;

INITFLAG VAR init ds;

BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;

PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ,
                  PROC (TEXT CONST) operation) :

  ausfuehrung (prompt, nur eine, typ, niltask,
               PROC (TEXT CONST) operation)

END PROC ausfuehrung;

PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ,
                  TASK CONST zusatztask,
                  PROC (TEXT CONST) operation) :

  enable stop;
  dateinamen anfordern;
  IF dateiname = niltext THEN
    errorstop (niltext)
  ELIF ist esc z THEN
    dateiname := subtext (dateiname, 3);
    dateinamen sammeln (all, typ, zusatztask);
    auswahl anbieten ("EUDAS-Dateiauswahl", rechts, max wahl,
                      "AUSWAHL/Datei",
                      PROC (TEXT VAR, INT CONST) als text);
    bitte warten;
    operation ausfuehren (PROC (TEXT CONST) operation)
  ELSE
    last param (dateiname);
    operation (dateiname)
  END IF .

dateinamen anfordern :
  IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN
    dateiname := std
  ELSE
    dateiname := niltext
  END IF;
  editget (prompt, dateiname, "z", "GET/Dateiname") .

max wahl :
  IF nur eine THEN 1 ELSE 1024 END IF .

END PROC ausfuehrung;

PROC auf archiv (PROC (TEXT CONST) operation, THESAURUS CONST archivinhalt) :

  dateiname := niltext;
  editget (name der datei, dateiname, "z", "GET/Dateiname");
  IF dateiname = niltext THEN
    errorstop (niltext)
  ELIF ist esc z THEN
    uebersicht zeigen
  ELSE
    last param (dateiname);
    operation (dateiname)
  END IF .

uebersicht zeigen :
  dateiname := subtext (dateiname, 3);
  dateinamen sammeln (archivinhalt, 0, niltask);
  auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv",
                    PROC (TEXT VAR, INT CONST) als text);
  operation ausfuehren (PROC (TEXT CONST) operation) .

END PROC auf archiv;

PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ,
                         TASK CONST zusatztask) :

  BOOL CONST kein pattern := pos (dateiname, "*") = 0;
  uebergebene namen sammeln;
  offene dateien merken;
  zusaetzliche namen dazu;
  meldung falls keine datei .

uebergebene namen sammeln :
  INT VAR
    stelle := 1,
    von := 0;
  satz initialisieren (sammel);
  REP
    get (t, feldpuffer, von);
    IF feldpuffer = niltext THEN
      LEAVE uebergebene namen sammeln
    ELIF richtiger typ AND nach pattern THEN
      feld aendern (sammel, stelle, feldpuffer);
      stelle INCR 1
    END IF
  END REP .

richtiger typ :
  typ = 0 COR type (old (feldpuffer)) = typ .

nach pattern :
  kein pattern COR (feldpuffer LIKE dateiname) .

offene dateien merken :
  offene := niltext;
  INT VAR i;
  FOR i FROM 1 UPTO anzahl dateien REP
    INT CONST t link := feldindex (sammel, eudas dateiname (i));
    IF t link > 0 THEN
      offene CAT code (t link)
    END IF
  END REP .

zusaetzliche namen dazu :
  IF NOT is niltask (zusatztask) THEN
    zusaetzliche namen := ALL zusatztask;
    zusaetzliche namen nach typ abfragen
  END IF .

zusaetzliche namen nach typ abfragen :
  von := 0;
  REP
    get (zusaetzliche namen, feldpuffer, von);
    IF feldpuffer = niltext THEN
      LEAVE zusaetzliche namen nach typ abfragen
    ELIF nach pattern CAND noch nicht enthalten CAND typ stimmt THEN
      feld aendern (sammel, stelle, feldpuffer);
      stelle INCR 1
    END IF
  END REP .

noch nicht enthalten :
  NOT (t CONTAINS feldpuffer) .

typ stimmt :
  typ = 0 COR tasktyp (feldpuffer, zusatztask) = typ .

meldung falls keine datei :
  IF stelle = 1 THEN
    dialog (keine datei zur auswahl);
    errorstop (niltext)
  END IF .

END PROC dateinamen sammeln;

INT PROC tasktyp (TEXT CONST datei, TASK CONST zieltask) :

  enable stop;
  INT VAR reply, result;
  IF NOT initialized (init ds) THEN ds := nilspace END IF;
  forget (ds); ds := nilspace;
  msg := ds;
  msg. name := datei;
  msg. write pass := write password;
  msg. read pass := read password;
  call (zieltask, fetch code, ds, reply);
  IF reply <> ack THEN
    result := 0
  ELSE
    result := type (ds)
  END IF;
  forget (ds);
  result

END PROC tasktyp;

BOOL PROC ist esc z :

  subtext (dateiname, 1, 2) = esc z

END PROC ist esc z;

PROC als text (TEXT VAR inhalt, INT CONST stelle) :

  IF stelle < 256 THEN
    feld lesen (sammel, stelle, inhalt);
    IF pos (offene, code (stelle)) > 0 THEN
      inhalt := "<!> " + textdarstellung (inhalt)
    ELIF inhalt <> niltext THEN
      inhalt := textdarstellung (inhalt)
    END IF
  ELSE
    inhalt := niltext
  END IF

END PROC als text;

PROC operation ausfuehren (PROC (TEXT CONST) operation) :

  INT VAR
    stelle := 1;
  REP
    IF wahl (stelle) = 0 THEN
      LEAVE operation ausfuehren
    ELSE
      feld lesen (sammel, wahl (stelle), feldpuffer);
      meldung in fusszeile;
      last param (feldpuffer);
      operation (feldpuffer)
    END IF;
    stelle INCR 1
  END REP .

meldung in fusszeile :
  IF online THEN
    fenster veraendert (fuss);
    cursor (1, y size); out (cleol);
    out (text (stelle)); out (". ");
    out (textdarstellung (feldpuffer))
  END IF .

END PROC operation ausfuehren;


(************************** Editor ****************************************)

LET
  edit status =  #1003#
"EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?",
  show status =  #1004#
"ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ?";

INT VAR return code;

BOOL VAR
  zeige edit status,
  feldanzeige erlaubt;


PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe,
           BOOL CONST aendern) :

  INT VAR x, y, x l, y l;
  fenstergroesse (fenster, x, y, x l, y l);
  fenster veraendert (fenster);
  enable stop;
  feldanzeige erlauben;
  zeige edit status := aendern;
  REP
    edit status anzeigen;
    open editor (groesster editor + 1, f, aendern, x, y, x l, y l);
    edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo);
    return code behandeln
  END REP .

feldanzeige erlauben :
  IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN
    feldanzeige erlaubt := TRUE
  ELSE
    feldanzeige erlaubt := FALSE
  END IF .

return code behandeln :
  SELECT return code OF
  CASE 0 : LEAVE edit
  CASE 1 : hilfe anbieten (hilfe, fenster)
  CASE 2 : errorstop (niltext)
  END SELECT .

END PROC edit;

PROC edit status anzeigen :

  IF zeige edit status THEN
    status anzeigen (edit status)
  ELSE
    status anzeigen (show status)
  END IF

END PROC edit status anzeigen;

PROC kdo (TEXT CONST zeichen) :

  return code := pos ("q?h", zeichen);
  IF return code > 0 THEN
    return code DECR 1;
    quit
  ELIF feldanzeige erlaubt CAND zeichen = "F" THEN
    do ("feldnamen anzeigen");
    edit status anzeigen
  ELSE
    std kommando interpreter (zeichen);
    edit status anzeigen;
    bildschirm neu
  END IF

END PROC kdo;


(**************************** Kommandodialog *******************************)

BOOL VAR dialogue state;

PROC set command dialogue false :

  dialogue state := command dialogue;
  command dialogue (FALSE)

END PROC set command dialogue false;

PROC reset command dialogue :

  command dialogue (dialogue state)

END PROC reset command dialogue;


(************************** Verschiedenes ********************************)

LET
  t bitte warten =  #1005#
    " Bitte warten.. ",
  t neu einrichten =  #1006#
    " neu einrichten";


PROC bitte warten :

  status anzeigen (t bitte warten)

END PROC bitte warten;

PROC frage ob einrichten (TEXT CONST datei) :

  IF NOT ja (textdarstellung (datei) + t neu einrichten, 
             "JA/einrichten") THEN
    errorstop (niltext)
  END IF

END PROC frage ob einrichten;


END PACKET eudas dialoghilfen;