(**********************************************************************

:Program.    M2undCED

:Contents.   zeigt Fehlermeldungen, die im M2Amiga-Format vorliegen,
:Contents    in einem eigenen Fenster auf dem CED-Screen an

:Copyright.  Shareware!

:Author.     Thomas Ansorge

:Address.    Dinkelackerring 55, W-6730 Neustadt, Deutschland

:Language.   Modula-2

:Translator. M2Amiga V4.0 (deutsch)

:Imports.    OFont.OpenFont, kann notfalls durch GraphicsL.OpenFont
:Imports.       ersetzt werden.

:History.    Version 1.1 vom 03.11.1991

:Update.     0.9 vom 02.10.1991: erste Tipparbeiten...
:Update.     1.0 vom 25.10.1991: Hurra! Es läuft!
:Update.     1.1 vom 03.11.1991: Viele Erweiterungen:
:Update.         - der beim Verbessern von Fehlern entstehende Offset
:Update.           wird automatisch erkannt und bein Anzeigen von
:Update.           weiteren Fehlern berücksichtigt
:Update.         - Das Laden der Datei M2:Fehler-Meldungen geschieht 
:Update            nur bei Bedarf
:Update.         - Die Fehlermeldung "kann Fehlerdatei nicht finden"
:Update.           erscheint als einzige per CED-Requester
:Update.         - CED liefert nicht immer null-terminierte Strings
:Update.           zurück, was nun vollständig ausgeglichen wird

**********************************************************************)

MODULE M2undCED;

FROM Arts IMPORT Assert, Terminate, thisTask;

FROM ASCII IMPORT nul;

FROM Conversions IMPORT ValToStr;

FROM ExecD IMPORT MsgPort, MsgPortPtr, Message, Node, NodePtr, NodeType,
   Task, TaskPtr;

FROM ExecL IMPORT FindPort, Forbid, FreeMem, GetMsg, Permit, PutMsg,
   ReplyMsg, WaitPort;

FROM ExecSupport IMPORT CreatePort, DeletePort;

FROM FileSystem IMPORT Close, File, FileMode, FileModeSet, Lookup,
   ReadBytes, ReadChar, Response, SetPos;

FROM GraphicsD IMPORT FontFlagSet, jam2, TextAttr, TextFontPtr,
   FontStyleSet;

FROM GraphicsL IMPORT CloseFont;

FROM Heap IMPORT Allocate, Deallocate;

FROM IntuitionD IMPORT ActivationFlags, ActivationFlagSet, boolGadget,
   Border, customScreen, Gadget, GadgetFlags, GadgetFlagSet, IDCMPFlags,
   IDCMPFlagSet, IntuiMessage, IntuiMessagePtr, IntuiText, IntuitionBase,
   IntuitionBasePtr, NewWindow, ScreenFlags, ScreenFlagSet, ScreenPtr,
   WindowFlags, WindowFlagSet, WindowPtr;

FROM IntuitionL IMPORT CloseWindow, OpenIntuition, OpenWindow, PrintIText,
   SetWindowTitles;

FROM OFont IMPORT OpenFont;

FROM String IMPORT ComparePart, Concat, ConcatChar, Copy, CopyPart,
   DeleteChar, Length;

FROM SYSTEM IMPORT ADR, ADDRESS, CAST, LONGSET;

(* -------------------------------------------------------------------- *)

CONST StringMax     = 80;
      LongStringMax = 255;

      ERR       = LONGINT (-1052421550); (* LONGINT ($C1455252) *)
      ERR1      = INTEGER (ERR DIV 65536);
      ERR2      = INTEGER (ERR MOD 65536);
      ERRFile   = LONGINT (3);
      ERRString = 194; (* leitet String in der Fehlerdatei #?E ein *)

      Space = " ";

      FehlerDateiChar = "E";

TYPE String     = ARRAY [0..StringMax] OF CHAR;
     StringPtr  = POINTER TO String;
     
     LongString = ARRAY [0..LongStringMax] OF CHAR;

     FehlerlistePtr = POINTER TO Fehlerliste;
     Fehlerliste    = RECORD
                         FehlerNummer   : INTEGER;
                         FehlerText     : String;
                         NaechsterFehler: FehlerlistePtr;
                      END (* RECORD Fehlerliste *);

     CEDInfo    = RECORD
                     WBench: BOOLEAN; (* WBench-Screen? Custom-Screen? *)
                     Screen: ScreenPtr; (* falls Custom-Screen *)
                     Breite: LONGINT; (* Screenbreite *)
                     PName : LongString; (* die gerade editierte Datei *)
                     Offset: LONGINT; (* der Benutzer tippt, während    *)
                             (* das Fenster offen ist (oder auch nicht) *)
                  END (* RECORD CEDInfo *);

     UserGadget = (naechsterFehler, stop); (* die Gadgets im Fenster *)

VAR CEDDaten    : CEDInfo;
    ErgERR      : String;
    ErgERRNum   : INTEGER;
    ERRNum      : INTEGER;
    ERRPos      : LONGINT;
    FehlerDatei : File;
    FehlerListe : FehlerlistePtr; (* die eingelesene Fehlerliste *)
    FehlerNummer: BOOLEAN; (* Fehlernummer oder String in Fehlerdatei? *)
    FehlerText  : String;
    Gelesen     : LONGINT;
    UserGad     : UserGadget;

(* -------------------------------------------------------------------- *)

PROCEDURE CEDAusfragen (VAR CEDDaten: CEDInfo);

   (* erfragt von CED wichtige Informationen *)

   CONST CEDPortName  = "rexx_ced";
         MeinPortName = "GHOST - Nachricht von CED";

   (* CEDs eigenes Msg-Format (siehe CED-Handbuch Kap. 28.12, S. 242ff) *)
   TYPE CEDMessage = RECORD
                        CmNode : Message;
                        Rfu1   : LONGINT;
                        Rfu2   : LONGINT;
                        Action : LONGSET;
                        Result1: LONGINT;

                        CASE :LONGINT OF
                           |0: Result2: StringPtr;
                           |1: Result3: LONGINT;
                        END (* CASE *);

                        Args   : ARRAY [0..16] OF ADDRESS;
                        Rfu7   : LONGINT;
                        Rfu8   : LONGINT;
                        Rfu9   : LONGINT;
                        Rfu10  : LONGINT;
                        Rfu11  : LONGINT;
                        Rfu12  : LONGINT;
                     END (* RECORD CEDMsg *);

   VAR Befehl   : String;
       CEDPort  : MsgPortPtr;
       Dummy    : ADDRESS;
       Error    : BOOLEAN;
       IBase    : IntuitionBasePtr;
       Nachricht: CEDMessage;
       MeinPort : MsgPortPtr;
       SNummer  : String;

   (* ----------------------------------------------------------------- *)

   BEGIN (* Prozedur CEDAusfragen *)

   CEDPort := NIL;
   IBase := NIL;
   MeinPort := NIL;

   IBase := OpenIntuition ();
   Assert (IBase # NIL, ADR ("konnte Intuition nicht finden!"));

   CEDPort := FindPort (ADR (CEDPortName));
   Assert (CEDPort # NIL, ADR ("kein CED zu finden!"));

   MeinPort := CreatePort (ADR (MeinPortName), 
                  CAST (TaskPtr, thisTask)^.node.pri);
   Assert (MeinPort # NIL, ADR ("kein Reply-Port!"));
   WITH CEDDaten DO
      Offset := 0;

      (* Workbench-Fenster? *)

      WITH Nachricht DO
         CmNode.node.succ := NIL;
         CmNode.node.pred := NIL;
         CmNode.node.type := message;
         CmNode.node.pri := 0;
         CmNode.node.name := ADR (MeinPortName);
         CmNode.length := SIZE (Nachricht);
         CmNode.replyPort := MeinPort;
         Rfu1 := 0;
         Rfu2 := 0;
         Action := LONGSET {17};
         Result1 := 0;
         Result2 := NIL;
         Args [0] := ADR ("Status 3");
         Args [1] := NIL;
         Args [2] := NIL;
         Args [3] := NIL;
         Args [4] := NIL;
         Args [5] := NIL;
         Args [6] := NIL;
         Args [7] := NIL;
         Args [8] := NIL;
         Args [9] := NIL;
         Args [10] := NIL;
         Args [11] := NIL;
         Args [12] := NIL;
         Args [13] := NIL;
         Args [14] := NIL;
         Args [15] := NIL;
         Args [16] := NIL;
         Rfu7 := 0;
         Rfu8 := 0;
         Rfu9 := 0;
         Rfu10 := 0;
         Rfu11 := 0;
         Rfu12 := 0;
      END (* WITH Nachricht *);

      PutMsg (CEDPort, ADR (Nachricht));
      WaitPort (MeinPort);
      Dummy := GetMsg (MeinPort);

      IF Nachricht.Result3 # 0 THEN
         WBench := FALSE;

         (* Screenadresse feststellen *)

         WITH Nachricht DO
            CmNode.node.type := message;
            Args [0] := ADR ("Cedtofront");
            Action := LONGSET {};
            Result1 := 0;
            Result2 := NIL;
         END (* WITH Nachricht *);

         PutMsg (CEDPort, ADR (Nachricht));
         WaitPort (MeinPort);
         Dummy := GetMsg (MeinPort);

         Forbid (); (* Multitasking kurz aus... *)
         Screen := IBase^.firstScreen;
         Permit (); (* ...und wieder an *)

      ELSE (* doch Workbench! *)
         WBench := TRUE;
         Screen := NIL;
      END (* IF Nachricht^.result3 *);

      (* Sceenbreite in Pixels (ich will es von CED persönlich wissen) *)

      WITH Nachricht DO
         CmNode.node.type := message;
         Args [0] := ADR ("Status 53");
         Action := LONGSET {17};
         Result1 := 0;
         Result2 := NIL;
      END (* WITH Nachricht *);

      PutMsg (CEDPort, ADR (Nachricht));
      WaitPort (MeinPort);
      Dummy := GetMsg (MeinPort);

      Breite := Nachricht.Result3;
      
      IF WBench AND (Breite < 640) THEN
         (* der WBench-Screen ist immer mindestens 640 Pixels breit und *)
         (* CED gibt in diesem Fall die Breite des Fensters zurück      *)
         Breite := 640;
      END (* IF WBench *);

      (* der komplette Pfad zur Datei inkl. Dateiname *)
      (* (dieser existiert, da die Datei bereits kompiliert wurde) *)

      WITH Nachricht DO
         CmNode.node.type := message;
         Args [0] := ADR ("Status 19");
         Action := LONGSET {17};
         Result1 := 0;
         Result2 := NIL;
      END (* WITH Nachricht *);

      PutMsg (CEDPort, ADR (Nachricht));
      WaitPort (MeinPort);
      Dummy := GetMsg (MeinPort);

      PName := "";

      IF Length (Nachricht.Result2^) <= LongStringMax - 1 THEN
         Copy (PName, Nachricht.Result2^);
      END (* IF Length *);

      FreeMem (Nachricht.Result2, Length (Nachricht.Result2^));

      (* "E" für "Fehlerdatei" addieren *)
      ConcatChar (PName, FehlerDateiChar);
   END (* WITH CEDDaten *);

   DeletePort (MeinPort);

   Assert (Length (CEDDaten.PName) # 0, ADR ("Dateiname zu lang!"));
END CEDAusfragen (* Prozedur *);

(* -------------------------------------------------------------------- *)

PROCEDURE DisplayFehlerFenster (FNummer      : INTEGER;
                                Text4        : String;
                                VAR CEDDaten : CEDInfo;
                                LetzterFehler: BOOLEAN;
                                Nummer       : BOOLEAN): UserGadget;

   (* öffnet ein Fenster mit der Fehlermeldung auf CEDs Screen und      *)
   (* registriert, welches Gadget der Anwnder angeklickt hat            *)

   CONST FensterTitel = "(M2Amiga, ...) Syntaxfehler:";

         FontName  = "topaz.font";
         FontHoehe = 8;

         Zeichenhoehe  = FontHoehe;
         Zeichenbreite = 8;

         Text1 = "Fehler Nummer";
         Text3 = ": ";
         Text7 = "nächster Fehler";
         Text8 = "Fehler:";

         WoraufIchWarte = IDCMPFlagSet {gadgetUp, closeWindow};
         
         ScreenTitel = "M2undCED © 1991 Thomas Ansorge. Shareware!";

   VAR Attr           : TextAttr;
       CEDFenster     : WindowPtr;
       Ecken          : ARRAY [0..9] OF INTEGER;
       Error          : BOOLEAN;
       FehlerNummer   : String;
       Fensterbreite  : INTEGER;
       Flags          : IDCMPFlagSet;
       Font           : TextFontPtr;
       IText          : ARRAY [1..7] OF IntuiText;
       Nachricht      : IntuiMessagePtr;
       NFGadget       : Gadget;
       NFenster       : NewWindow;
       Rahmen         : Border;
       Text5,
       Text6          : String;
       Vorher         : LONGINT;
       ZeichenProZeile: INTEGER;
       ZeilenImFenster: INTEGER; (* Anzahl Zeilen des Fehlertextes *)

   (* ----------------------------------------------------------------- *)
   
   PROCEDURE AnzahlZeichen (): LONGINT;
      
      (* fragt CED, wieviel Zeichen die Datei enthält *)

      CONST CEDPortName  = "rexx_ced";
            MeinPortName = "GHOST - Nachricht von CED";

      (* CEDs eigenes Msg-Format (siehe CED-Handbuch Kap. 28.12 *)
      TYPE CEDMessage = RECORD
                           CmNode : Message;
                           Rfu1   : LONGINT;
                           Rfu2   : LONGINT;
                           Action : LONGSET;
                           Result1: LONGINT;
                           Result2: LONGINT;
                           Args   : ARRAY [0..16] OF ADDRESS;
                           Rfu7   : LONGINT;
                           Rfu8   : LONGINT;
                           Rfu9   : LONGINT;
                           Rfu10  : LONGINT;
                           Rfu11  : LONGINT;
                           Rfu12  : LONGINT;
                        END (* RECORD CEDMsg *);
                        
      VAR CEDPort  : MsgPortPtr;
          Dummy    : ADDRESS;
          MeinPort : MsgPortPtr;
          Nachricht: CEDMessage;
          
      (* -------------------------------------------------------------- *)
      
      BEGIN (* Funktion AnzahlZeichen *)

      CEDPort := NIL;  
      MeinPort := NIL;
      
      CEDPort := FindPort (ADR (CEDPortName));
      Assert (CEDPort # NIL, ADR ("kein CED-Port mehr da!"));
      
      MeinPort := CreatePort (ADR (MeinPortName), 
                     CAST (TaskPtr, thisTask)^.node.pri);
      Assert (MeinPort # NIL, ADR ("konnte Port nicht erzeugen!"));
      
      WITH Nachricht DO
         CmNode.node.succ := NIL;
         CmNode.node.pred := NIL;
         CmNode.node.type := message;
         CmNode.node.pri := 0;
         CmNode.node.name := ADR (MeinPortName);
         CmNode.length := SIZE (Nachricht);
         CmNode.replyPort := MeinPort;
         Rfu1  := 0;
         Rfu2  := 0;
         Args [0] := ADR ("Status 16");
         Args [1] := NIL;
         Args [2] := NIL;
         Args [3] := NIL;
         Args [4] := NIL;
         Args [5] := NIL;
         Args [6] := NIL;
         Args [7] := NIL;
         Args [8] := NIL;
         Args [9] := NIL;
         Args [10] := NIL;
         Args [11] := NIL;
         Args [12] := NIL;
         Args [13] := NIL;
         Args [14] := NIL;
         Args [15] := NIL;
         Args [16] := NIL;
         Action := LONGSET {17};
         Result1 := 0;
         Result2 := 0;
         Rfu7  := 0;
         Rfu8  := 0;
         Rfu9  := 0;
         Rfu10 := 0;
         Rfu11 := 0;
         Rfu12 := 0;
      END (* WITH Nachricht *);

      PutMsg (CEDPort, ADR (Nachricht));
      WaitPort (MeinPort);
      Dummy := GetMsg (MeinPort);
      
      DeletePort (MeinPort);
      
      RETURN Nachricht.Result2;
   END AnzahlZeichen (* Funktion *);

   (* ----------------------------------------------------------------- *)
   
   PROCEDURE SchneideString (VAR Text  : ARRAY OF CHAR;
                             VAR Text2 : ARRAY OF CHAR;
                             MaxZeichen: INTEGER;
                             VAR IText : IntuiText);

      (* trennt Text so, daß der erste Teil (<= MaxZeichen) nach IText  *)
      (* kommt und der Rest als Text2 zurückgegben wird                 *)

      VAR i: INTEGER;

      (* -------------------------------------------------------------- *)

      BEGIN (* Prozedur SchneideString *)

      i := MaxZeichen;

      WHILE (i > 0) AND (Text [i] # " ") DO
         DEC (i);
      END (* WHILE (i *);

      IF i = 0 THEN
         Copy (Text2, Text);
         Text [0] := nul;
      ELSE (* IF i = 0 *)
         CopyPart (Text2, Text, i + 1, Length (Text) - i - 1);
         Text [i] := nul;
      END (* IF i *);

      IText.iText := ADR (Text);
   END SchneideString (* Prozedur *);

   (* ----------------------------------------------------------------- *)

   PROCEDURE Ziffern (Zahl: INTEGER): INTEGER;

      (* gibt die Anzahl an Stellen der Zahl zurück                     *)

      BEGIN (* Funktion Ziffern *)

      IF ABS (Zahl) > 9999 THEN
         IF Zahl >= 0 THEN
            RETURN 5;
         ELSE
            RETURN 6;
         END;
      ELSE
         IF ABS (Zahl) > 999 THEN
            IF Zahl >= 0 THEN
               RETURN 4;
            ELSE
               RETURN 5;
            END;
         ELSE
            IF ABS (Zahl) > 99 THEN
               IF Zahl >= 0 THEN
                  RETURN 3;
               ELSE
                  RETURN 4;
               END;
            ELSE
               IF ABS (Zahl) > 9 THEN
                  IF Zahl >= 0 THEN
                     RETURN 2;
                  ELSE
                     RETURN 3;
                  END;
               ELSE
                  IF Zahl >= 0 THEN
                     RETURN 1;
                  ELSE
                     RETURN 2;
                  END;
               END;
            END;
         END;
      END;
   END Ziffern (* Funktion *);

   (* ----------------------------------------------------------------- *)

   BEGIN (* Funktion DisplayFehlerFenster *)

   CEDFenster := NIL;
   Nachricht := NIL;

   (* der Font *)

   WITH Attr DO
      name := ADR (FontName);
      ySize := FontHoehe;
      style := FontStyleSet {};
      flags := FontFlagSet {};
   END (* WITH Attr *);

   Font := OpenFont (ADR (Attr));

   (* die FehlerNummer *)

   ValToStr (FNummer, TRUE, FehlerNummer, 10, Ziffern (FNummer), " ",
             Error);

   (* die IntuiText-Strukturen *)

   (* im Gadget *)
   WITH IText [7] DO
      frontPen := 1;
      backPen := 0;
      drawMode := jam2;
      leftEdge := 3;
      topEdge := 2;
      iTextFont := ADR (Attr);
      iText := ADR (Text7);
      nextText := NIL;
   END (* WITH IText [6] *);

   (* Fehlertext, 3. Zeile *)
   IText [6] := IText [7];
   IText [6].leftEdge := 4;
   IText [6].topEdge := 4 * (Zeichenhoehe + 2) + 1;
   IText [6].iText := NIL;

   (* Fehlertext, 2. Zeile *)
   IText [5] := IText [6];
   IText [5].topEdge := 3 * (Zeichenhoehe + 2) + 1;
   IText [5].nextText := ADR (IText [6]);

   (* Fehlertext, 1. Zeile *)
   IText [4] := IText [5];
   IText [4].topEdge := 2 * (Zeichenhoehe + 2) + 1;
   IText [4].nextText := ADR (IText [5]);
   
   (* ":" *)
   IText [3] := IText [4];
   IText [3].iText := ADR (Text3);
   IText [3].topEdge := (Zeichenhoehe + 2) + 1;
   IText [3].leftEdge := (2 + Zeichenbreite * 14) +
                         Zeichenbreite * Ziffern (FNummer) + 2;
   IText [3].nextText := ADR (IText [4]);
   
   (* die Fehlernummer *)
   IText [2] := IText [3];
   IText [2].leftEdge := 4 + Zeichenbreite * 14;
   IText [2].iText := ADR (FehlerNummer);
   IText [2].nextText := ADR (IText [3]);
   
   (* "Fehler Nummer" *)
   IText [1] := IText [2];
   IText [1].leftEdge := 4;
   
   IF Nummer THEN
      IText [1].iText := ADR (Text1);
      IText [1].nextText := ADR (IText [2]);
   ELSE (* keine Fehlernummer zum Anzeigen da! *)
      IText [1].iText := ADR (Text8);
      IText [1].nextText := ADR (IText [4]);
   END (* IF Nummer *);

   (* der Fehlertext: *)
   Fensterbreite := 3 * (CEDDaten.Breite DIV 4);
   ZeichenProZeile := (Fensterbreite DIV Zeichenbreite) - 1;

   (* Text4 # "" *)
   IF Length (Text4) > ZeichenProZeile THEN
      SchneideString (Text4, Text5, ZeichenProZeile, IText [4]);

      IF Length (Text5) > ZeichenProZeile THEN
         SchneideString (Text5, Text6, ZeichenProZeile, IText [5]);

         (* Die Fehlermeldungen sind zusammen nicht länger als 80       *)
         (* Zeichen, also paßt Text6 jetzt auf alle Fälle. Wenn doch    *)
         (* nicht, dann haben wir eben Pech gehabt.                     *)

         IF Length (Text6) > ZeichenProZeile THEN
            Text6 [ZeichenProZeile] := nul;
         END (* IF Length (Text6) *);

         IText [6].iText := ADR (Text6);
         ZeilenImFenster := 4;

      ELSE (* Text4 und Text5 reichen zusammen! *)
         IText [5].iText := ADR (Text5);
         IText [5].nextText := NIL;
         ZeilenImFenster := 3;
      END (* IF Length (Text5) *);

   ELSE (* Text4 reicht! *)
      IText [4].iText := ADR (Text4);
      IText [4].nextText := NIL;
      ZeilenImFenster := 2;
   END (* IF Length (Text4) *);

   (* die Ecken für den Rahmen *)

   Ecken [0] := -1;
   Ecken [1] := -1;
   Ecken [2] := Length (Text7) * Zeichenbreite + 4 + 1;
   Ecken [3] := Ecken [1];
   Ecken [4] := Ecken [2];
   Ecken [5] := Zeichenhoehe + 3;
   Ecken [6] := Ecken [0];
   Ecken [7] := Ecken [5];
   Ecken [8] := Ecken [0];
   Ecken [9] := Ecken [1];

   (* der Rahmen selber *)

   WITH Rahmen DO
      leftEdge := 0;
      topEdge := 0;
      frontPen := 1;
      backPen := 0;
      drawMode := jam2;
      count := 5;
      xy := ADR (Ecken [0]);
      nextBorder := NIL;
   END (* WITH Rahmen *);

   (* das "nächster Fehler"-Gadget *)

   WITH NFGadget DO
      nextGadget := NIL;
      leftEdge := (Fensterbreite - (Ecken [2] - 1)) DIV 2;
      topEdge := (Zeichenhoehe + 2) * (ZeilenImFenster + 1) + 2;
      width := Ecken [2] - 1;
      height := Ecken [5] + 1;

      IF LetzterFehler THEN
         flags := GadgetFlagSet {gadgDisabled};
      ELSE
         flags := GadgetFlagSet {};
      END (* IF LetzterFehler *);

      activation := ActivationFlagSet {relVerify};
      gadgetType := boolGadget;
      gadgetRender := ADR (Rahmen);
      selectRender := NIL;
      gadgetText := ADR (IText [7]);
      mutualExclude := LONGSET {};
      specialInfo := NIL;
      gadgetID := 0;
      userData := NIL;
   END (* WITH NFGadget *);

   (* das Fenster öffnen *)

   WITH NFenster DO
      leftEdge := ((Fensterbreite * 4 / 3) - Fensterbreite ) DIV 2;
      topEdge := Zeichenhoehe + 3; (* unter der Titelzeile *)
      width := Fensterbreite;
      height := (Zeichenhoehe + 2) * (ZeilenImFenster + 2) + 7;
      detailPen := 0;
      blockPen := 1;
      idcmpFlags := IDCMPFlagSet {gadgetUp, closeWindow};
      flags := WindowFlagSet {windowDrag, windowDepth, windowClose};
      firstGadget := ADR (NFGadget);
      checkMark := NIL;
      title := ADR (FensterTitel);

      IF CEDDaten.WBench THEN
         screen := NIL;
         type := ScreenFlagSet {wbenchScreen};
      ELSE (* CED-Screen ist custom! *)
         screen := CEDDaten.Screen;
         type := customScreen;
      END (* IF CEDDaten *);

      bitMap := NIL;
      minWidth := width;
      minHeight := height;
      maxWidth := width;
      maxHeight := height;
   END (* WITH NFenster *);
   
   Vorher := AnzahlZeichen ();

   CEDFenster := OpenWindow (NFenster);
   Assert (CEDFenster # NIL, ADR ("konnte Fenster nicht öffnen!"));
   
   SetWindowTitles (CEDFenster, ADR (FensterTitel), ADR (ScreenTitel));

   PrintIText (CEDFenster^.rPort, ADR (IText [1]), 0, 0);

   (* warten, bis ein Gadget angeklickt wird *)

   Nachricht := NIL;
   Flags := IDCMPFlagSet {};

   REPEAT
      WaitPort (CEDFenster^.userPort);
      Nachricht := GetMsg (CEDFenster^.userPort);

      IF Nachricht # NIL THEN
         Flags := Nachricht^.class;
         ReplyMsg (Nachricht);
      END (* IF Nachricht *);
   UNTIL (Flags / WoraufIchWarte) # IDCMPFlagSet {};

   (* ...und tschüß! *)

   CloseWindow (CEDFenster);
   CEDFenster := NIL;

   CloseFont (Font);
   Font := NIL;
   
   (* Änderungen in der Datei? *)
   CEDDaten.Offset := CEDDaten.Offset + (AnzahlZeichen () - Vorher);

   IF closeWindow IN Flags THEN
      RETURN stop;
   ELSE (* relVerify IN Flags *)
      RETURN naechsterFehler;
   END (* IF closeWindow *);
END DisplayFehlerFenster (* Funktion *);

(* -------------------------------------------------------------------- *)

PROCEDURE DisplayOkay1Requester (Text: ARRAY OF CHAR);

   (* erzeugt einen Okay1-Requester auf dem CED-Screen *)
   
   CONST CEDPortName  = "rexx_ced";
         MeinPortName = "Spiel mir das Lied vom Tod";

   (* CEDs eigenes Msg-Format (siehe CED-Handbuch Kap. 28.12 *)
   TYPE CEDMessage = RECORD
                        CmNode : Message;
                        Rfu1   : LONGINT;
                        Rfu2   : LONGINT;
                        Action : LONGSET;
                        Result1: LONGINT;
                        Result2: LONGINT;
                        Args   : ARRAY [0..16] OF ADDRESS;
                        Rfu7   : LONGINT;
                        Rfu8   : LONGINT;
                        Rfu9   : LONGINT;
                        Rfu10  : LONGINT;
                        Rfu11  : LONGINT;
                        Rfu12  : LONGINT;
                     END (* RECORD CEDMsg *);
                        
   VAR Befehl   : String;
       CEDPort  : MsgPortPtr;
       Dummy    : ADDRESS;
       MeinPort : MsgPortPtr;
       Nachricht: CEDMessage;
       
   (* ----------------------------------------------------------------- *)
   
   BEGIN (* Prozedur DisplayOkay1Requester *)
   
   Befehl := 'Okay1 "';
   Concat (Befehl, Text);
   ConcatChar (Befehl, '"');
   
   CEDPort := NIL;  
   MeinPort := NIL;
      
   CEDPort := FindPort (ADR (CEDPortName));
   Assert (CEDPort # NIL, ADR ("kein CED-Port mehr da!"));
      
   MeinPort := CreatePort (ADR (MeinPortName), 
                  CAST (TaskPtr, thisTask)^.node.pri);
   Assert (MeinPort # NIL, ADR ("konnte Port nicht erzeugen!"));
      
   WITH Nachricht DO
      CmNode.node.succ := NIL;
      CmNode.node.pred := NIL;
      CmNode.node.type := message;
      CmNode.node.pri := 0;
      CmNode.node.name := ADR (MeinPortName);
      CmNode.length := SIZE (Nachricht);
      CmNode.replyPort := MeinPort;
      Rfu1  := 0;
      Rfu2  := 0;
      Args [0] := ADR (Befehl);
      Args [1] := NIL;
      Args [2] := NIL;
      Args [3] := NIL;
      Args [4] := NIL;
      Args [5] := NIL;
      Args [6] := NIL;
      Args [7] := NIL;
      Args [8] := NIL;
      Args [9] := NIL;
      Args [10] := NIL;
      Args [11] := NIL;
      Args [12] := NIL;
      Args [13] := NIL;
      Args [14] := NIL;
      Args [15] := NIL;
      Args [16] := NIL;
      Action := LONGSET {};
      Result1 := 0;
      Result2 := 0;
      Rfu7  := 0;
      Rfu8  := 0;
      Rfu9  := 0;
      Rfu10 := 0;
      Rfu11 := 0;
      Rfu12 := 0;
   END (* WITH Nachricht *);

   PutMsg (CEDPort, ADR (Nachricht));
   WaitPort (MeinPort);
   Dummy := GetMsg (MeinPort);
      
   DeletePort (MeinPort);
END DisplayOkay1Requester (* Prozedur *);

(* -------------------------------------------------------------------- *)

PROCEDURE Fehlertext (VAR FehlerText: String;
                      ERRNum        : INTEGER;
                      FehlerListe   : FehlerlistePtr);

   (* sucht den zur Fehlernummer passenden Text                         *)

   CONST Fehler = "M2undCED: unbekannte Fehlernummer!";

   (* ----------------------------------------------------------------- *)

   BEGIN (* Prozedur Fehlertext *)

   WHILE (FehlerListe^.NaechsterFehler # NIL) AND
      (FehlerListe^.FehlerNummer # ERRNum) DO
      FehlerListe := FehlerListe^.NaechsterFehler;
   END (* WHILE (FehlerListe^ *);

   IF FehlerListe^.FehlerNummer # ERRNum THEN
      Copy (FehlerText, Fehler);
   ELSE (* Fehler gefunden! *)
      Copy (FehlerText, FehlerListe^.FehlerText);
   END (* IF FehlerListe^ *);
END Fehlertext (* Prozedur *);

(* -------------------------------------------------------------------- *)

PROCEDURE LiesFehlerlisteEin (): FehlerlistePtr;

   (* liest die M2-Fehlerliste ein und speichert sie in einer internen  *)
   (* Liste. Aus dieser Liste werden dann die Texte für die Fehler-     *)
   (* meldungen genommen.                                               *)

   CONST FehlerlisteBufferGroesse = 30 * 1024; (* sollte reichen *)
         FehlerlisteDefaultName   = "M2:Fehler-Meldungen";

         OldFile = FALSE;

   VAR FListe         : File;
       ElementPtr     : FehlerlistePtr;
       ErstesElement  : FehlerlistePtr;
       FehlerlisteName: String;
       Gelesen        : LONGINT; (* tatsächlich gelesen *)
       NaechsterFehler: LONGINT; (* für die Datei *)
       NeuesElement   : FehlerlistePtr;
       Vorgaenger     : FehlerlistePtr;

   (* ----------------------------------------------------------------- *)

   PROCEDURE New (VAR NeuesElement: FehlerlistePtr);

      (* aloziiert Speicher für ein neues Listen-Element *)

      BEGIN (* Prozedur NeuesElement *)

      (*$ NilChk := FALSE *)

      Allocate (NeuesElement, SIZE (NeuesElement^));

      (*$ POP NilChk *)

      Assert (NeuesElement # NIL, ADR ("FL: nicht genug Speicher!"));

      WITH NeuesElement^ DO
         FehlerNummer := 0;
         FehlerText := "";
         NaechsterFehler := NIL;
      END (* WITH NeuesElement^ *);
   END New (* Prozedur *);

   (* ----------------------------------------------------------------- *)

   PROCEDURE ReadString (Datei     : File;
                         VAR String: ARRAY OF CHAR);

      (* liest einen String ein *)

      VAR i    : INTEGER;
          Muell: CHAR; (* Dummy *)

      (* -------------------------------------------------------------- *)

      BEGIN (* Prozedur ReadString *)

      i := -1;

      REPEAT
         INC (i);
         ReadChar (Datei, String [i]);
      UNTIL (i = StringMax) OR (String [i] < " ");

      IF (i = StringMax) AND (String [i] >= " ") THEN
         (* String mangels Platz unvollständig eingelesen *)
         String [i] := nul;

         REPEAT
            ReadChar (Datei, Muell);
         UNTIL (Muell < " ") OR Datei.eof;
      END (* IF (i *);
   END ReadString (* Prozedur *);

   (* ----------------------------------------------------------------- *)

   BEGIN (* Funktion LiesFehlerlisteEin *)

   ErstesElement := NIL;
   NeuesElement := NIL;
   
   Copy (FehlerlisteName, FehlerlisteDefaultName);

   Lookup (FListe, FehlerlisteName, FehlerlisteBufferGroesse, OldFile);
   Assert (FListe.res = done, ADR ("konnte Fehlerliste nicht öffnen!"));

   NaechsterFehler := 0;

   REPEAT
      SetPos (FListe, NaechsterFehler);
      ReadBytes (FListe, ADR (NaechsterFehler), SIZE (NaechsterFehler),
                 Gelesen);

      IF NaechsterFehler # 0 THEN
         (* noch mindestens ein gültiger Eintrag *)

         Vorgaenger := NeuesElement;

         New (NeuesElement);

         IF ErstesElement = NIL THEN
            ErstesElement := NeuesElement;
         END (* IF ErstesElement *);

         WITH NeuesElement^ DO
            ReadBytes (FListe, ADR (FehlerNummer), SIZE (FehlerNummer),
                       Gelesen);
            ReadString (FListe, FehlerText);
         END (* WITH NeuesElement^ *);
      END (* IF NaechsterFehler *);

      IF Vorgaenger # NIL THEN
         Vorgaenger^.NaechsterFehler := NeuesElement;
      END (* IF Vorgaenger *);

   UNTIL (FListe.eof) OR (NaechsterFehler = 0);

   Close (FListe);

   RETURN ErstesElement;
END LiesFehlerlisteEin (* Funktion *);

(* -------------------------------------------------------------------- *)

PROCEDURE LiesFehlerStringEin (VAR FehlerDatei: File;
                               ERRNum         : INTEGER;
                               VAR FehlerText : String);

   (* liest den Fehlerstring ein *)

   VAR Gelesen: LONGINT;
       Zeichen: CHAR;

   (* ------------------------------------------------------------------ *)

   BEGIN (* Prozedur LiesFehlerStringEin *)

   FehlerText [0] := CHAR (ERRNum MOD 256);
   FehlerText [1] := nul;

   (* String fertig einlesen *)

   REPEAT
      ReadBytes (FehlerDatei, ADR (Zeichen), SIZE (Zeichen), Gelesen);
      ConcatChar (FehlerText, Zeichen);
   UNTIL Zeichen = nul;

   IF Length (FehlerText) MOD 2 = 1 THEN
      ReadBytes (FehlerDatei, ADR (Zeichen), SIZE (Zeichen), Gelesen);
   END (* IF Length *);
END LiesFehlerStringEin (* Prozedur *);

(* -------------------------------------------------------------------- *)

PROCEDURE LoescheFehlerliste (VAR Element: FehlerlistePtr);

   (* löscht die Fehlerliste rekursiv - ich habe lange nichts mehr      *)
   (* rekursiv programmiert und M2Amiga ist ja jetzt so sparsam mit dem *)
   (* Stack...                                                          *)

   BEGIN (* Prozedur LoescheFehlerliste *)

   IF Element^.NaechsterFehler # NIL THEN
      LoescheFehlerliste (Element^.NaechsterFehler);
   END (* IF Element^.NaechsterFehler *);

   Deallocate (Element);
   (* Element wird automatisch NIL durch Heap.Deallocate *)

END LoescheFehlerliste (* Prozedur *);

(* -------------------------------------------------------------------- *)

PROCEDURE SpringeZuByteNr (Nummer: LONGINT);

   (* gibt CED den Befehl, den Cursor auf Byte Nr. Nummer zu bewegen    *)

   CONST CEDPortName  = "rexx_ced";
         MeinPortName = "Der mit dem CED tanzt";

   (* CEDs eigenes Msg-Format (siehe CED-Handbuch Kap. 28.12, S. 242ff) *)
   TYPE CEDMessage = RECORD
                        CmNode : Message;
                        Rfu1   : LONGINT;
                        Rfu2   : LONGINT;
                        Action : LONGINT;
                        Result1: LONGINT;
                        Result2: ADDRESS;
                        Args   : ARRAY [0..16] OF ADDRESS;
                        Rfu7   : LONGINT;
                        Rfu8   : LONGINT;
                        Rfu9   : LONGINT;
                        Rfu10  : LONGINT;
                        Rfu11  : LONGINT;
                        Rfu12  : LONGINT;
                     END (* RECORD CEDMsg *);

   VAR Befehl   : String;
       CEDPort  : MsgPortPtr;
       Error    : BOOLEAN;
       Nachricht: CEDMessage;
       MeinPort : MsgPortPtr;
       SNummer  : String;

   (* ----------------------------------------------------------------- *)

   BEGIN (* Prozedur SpringeZuByteNr *)

   Befehl := "Jump to byte ";
   CEDPort := NIL;
   MeinPort := NIL;

   ValToStr (Nummer, FALSE, SNummer, 10, 5, "0", Error);
   Concat (Befehl, SNummer);

   CEDPort := FindPort (ADR (CEDPortName));
   Assert (CEDPort # NIL, ADR ("kein CED zu finden!"));

   MeinPort := CreatePort (ADR (MeinPortName), 
                  CAST (TaskPtr, thisTask)^.node.pri);
   Assert (MeinPort # NIL, ADR ("kein Reply-Port!"));

   WITH Nachricht DO
      CmNode.node.succ := NIL;
      CmNode.node.pred := NIL;
      CmNode.node.type := message;
      CmNode.node.pri := 0;
      CmNode.node.name := ADR (MeinPortName);
      CmNode.length := SIZE (Nachricht);
      CmNode.replyPort := MeinPort;
      Rfu1  := 0;
      Rfu2  := 0;
      Args [0] := ADR (Befehl);
      Args [1] := NIL;
      Args [2] := NIL;
      Args [3] := NIL;
      Args [4] := NIL;
      Args [5] := NIL;
      Args [6] := NIL;
      Args [7] := NIL;
      Args [8] := NIL;
      Args [9] := NIL;
      Args [10] := NIL;
      Args [11] := NIL;
      Args [12] := NIL;
      Args [13] := NIL;
      Args [14] := NIL;
      Args [15] := NIL;
      Args [16] := NIL;
      Action := 0;
      Result1 := 0;
      Result2 := NIL;
      Rfu7  := 0;
      Rfu8  := 0;
      Rfu9  := 0;
      Rfu10 := 0;
      Rfu11 := 0;
      Rfu12 := 0;
   END (* WITH Nachricht *);

   PutMsg (CEDPort, ADR (Nachricht));
   WaitPort (MeinPort);
   DeletePort (MeinPort);
END SpringeZuByteNr (* Prozedur *);

(* -------------------------------------------------------------------- *)
(* -------------------------------------------------------------------- *)

BEGIN (* Hauptprogramm M2undCED *)

(* initialisieren... *)

FehlerListe := NIL;

(* diverse Dinge von CED erfragen *)

CEDAusfragen (CEDDaten);

(* die Fehlerdatei öffnen *)

Lookup (FehlerDatei, CEDDaten.PName, 512, FALSE);

IF FehlerDatei.res # done THEN
   (* manchmal gibt CED ein (zwei, ...) Zeichen zuviel zurück *)
   (* So, jetzt reicht es mir! Den großen Holzhammer herbei!: *)
   REPEAT
      DeleteChar (CEDDaten.PName, Length (CEDDaten.PName) - 2);
      Lookup (FehlerDatei, CEDDaten.PName, 512, FALSE);
   UNTIL (FehlerDatei.res = done) OR (Length (CEDDaten.PName) <= 2);      
END (* IF FehlerDatei *);

IF FehlerDatei.res # done THEN
   DisplayOkay1Requester ("M2undCED: keine Fehler-Datei gefunden!");
   Terminate;
END (* IF FehlerDatei.res *);

(* die Fehlerdatei Eintrag für Eintrag laden und anzeigen *)

ReadBytes (FehlerDatei, ADR (ERRPos), SIZE (LONGINT), Gelesen);
Assert (ERRPos = ERRFile, ADR ("keine Fehler-Datei (ERRFile)!"));

(* erstes "ERR" *)
ReadBytes (FehlerDatei, ADR (ERRPos), SIZE (LONGINT), Gelesen);

REPEAT
   IF FehlerDatei.res = done THEN
      (* die Position (Byte-Nummer) *)
      ReadBytes (FehlerDatei, ADR (ERRPos), SIZE (LONGINT), Gelesen);

      (* die Fehler-Nummer *)
      ReadBytes (FehlerDatei, ADR (ERRNum), SIZE (INTEGER), Gelesen);

      IF CAST (CARDINAL, ERRNum) DIV 256 = ERRString THEN
         (* keine Fehlernummer, sondern ein String! *)
         FehlerNummer := FALSE;
         
         LiesFehlerStringEin (FehlerDatei, ERRNum, FehlerText);

         (* "ERR": *)
         ReadBytes (FehlerDatei, ADR (ErgERRNum), SIZE (INTEGER), Gelesen);
         ReadBytes (FehlerDatei, ADR (ErgERRNum), SIZE (INTEGER), Gelesen);
      ELSE (* doch eine Fehlernummer *)
         FehlerNummer := TRUE;
         
         (* die Liste aller Fehlermeldungen einlesen falls nötig *)
         IF FehlerListe = NIL THEN
            FehlerListe := LiesFehlerlisteEin ();
         END (* IF FehlerListe *);
         
         Fehlertext (FehlerText, ERRNum, FehlerListe);

         (* weitere Fehlernummern (Ergänzungen zu dieser Nummer)? *)
         LOOP
            ReadBytes (FehlerDatei, ADR (ErgERRNum), SIZE (INTEGER),
               Gelesen);

            IF FehlerDatei.res = done THEN
               IF (ErgERRNum # ERR1) AND (ErgERRNum > 0)  THEN
                  (* ja, eine Ergänzung *)
                  ErgERR := "";
                  Fehlertext (ErgERR, ErgERRNum, FehlerListe);
                  ConcatChar (FehlerText, Space);
                  Concat (FehlerText, ErgERR);
               ELSE
                  EXIT;
               END (* IF ErgERRNum *);
            ELSE
               EXIT;
            END (* IF FehlerDatei.res *);
         END (* LOOP *);

         IF FehlerDatei.res = done THEN
            (* ERR2 *)
            ReadBytes (FehlerDatei, ADR (ErgERRNum), SIZE (INTEGER),
               Gelesen);
         END (* IF FehlerDatei.res *);
      END (* IF CAST (CARDINAL, ERRNum) DIV 256 *);

      (* den Fehler-Text anzeigen *)
      SpringeZuByteNr (ERRPos + CEDDaten.Offset);
      UserGad := DisplayFehlerFenster (ERRNum, FehlerText, CEDDaten,
                    (FehlerDatei.eof) OR (ErgERRNum # ERR2), FehlerNummer);
   END (* IF FehlerDatei.res = done *);
UNTIL (FehlerDatei.res # done) OR (UserGad = stop) OR (ErgERRNum # ERR2);

CLOSE; (* aufräumen... *)

IF FehlerDatei.file # NIL THEN
   Close (FehlerDatei);
   FehlerDatei.file := NIL;
END (* IF FehlerDatei *);

IF FehlerListe # NIL THEN
   LoescheFehlerliste (FehlerListe);
END (* IF FehlerListe *);

END M2undCED (* Modul *).