Rename lib to library.

src/library/ulm/ulmConclusions.Mod

@@ -0,0 +1,169 @@
+(* Ulm's Oberon Library
+   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+   ----------------------------------------------------------------------------
+   Ulm's Oberon Library is free software; you can redistribute it
+   and/or modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either version
+   2 of the License, or (at your option) any later version.
+
+   Ulm's Oberon Library is distributed in the hope that it will be
+   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+   ----------------------------------------------------------------------------
+   E-mail contact: oberon@mathematik.uni-ulm.de
+   ----------------------------------------------------------------------------
+   $Id: Conclusions.om,v 1.2 1994/07/05 12:50:01 borchert Exp $
+   ----------------------------------------------------------------------------
+   $Log: Conclusions.om,v $
+   Revision 1.2  1994/07/05 12:50:01  borchert
+   formatting of error messages depends now on the indentation width
+   of StreamDisciplines
+
+   Revision 1.1  1994/02/23  07:46:17  borchert
+   Initial revision
+
+   ----------------------------------------------------------------------------
+   AFB 11/91
+   ----------------------------------------------------------------------------
+*)
+
+MODULE ulmConclusions;
+
+   (* convert errors and events into conclusions,
+      i.e. a final message and reaction
+   *)
+
+   IMPORT Errors := ulmErrors, Events := ulmEvents, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
+      Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite;
+
+   VAR
+      handlerSet*: Errors.HandlerSet;
+      errors*: INTEGER; (* number of errors *)
+      fatalcode*: INTEGER; (* exit code on fatal events *)
+
+      (* private variables *)
+      cmdName: Process.Name; (* should be sufficient for a base name *)
+      cmdNameLen: INTEGER; (* Strings.Len(cmdName) *)
+
+   (* private procedures *)
+
+   PROCEDURE GeneralHandler(event: Events.Event; kind: Errors.Kind);
+      VAR
+	 width: INTEGER;
+   BEGIN
+      IF event # NIL THEN
+	 Write.IndentS(Streams.stderr);
+	 Write.StringS(Streams.stderr, cmdName);
+	 Write.StringS(Streams.stderr, ": ");
+	 width := SHORT(Strings.Len(cmdName) + 2);
+	 StreamDisciplines.IncrIndentationWidth(Streams.stderr, width);
+	 IF kind # Errors.message THEN
+	    Write.StringS(Streams.stderr, Errors.kindText[kind]);
+	    Write.StringS(Streams.stderr, ": ");
+	 END;
+	 Errors.Write(Streams.stderr, event); Write.LnS(Streams.stderr);
+	 StreamDisciplines.IncrIndentationWidth(Streams.stderr, -width);
+      END;
+      CASE kind OF
+      | Errors.error:   INC(errors);
+      | Errors.fatal:   Process.Exit(fatalcode);
+      | Errors.bug:     Process.Abort;
+      ELSE
+	 (* no further actions *)
+      END;
+   END GeneralHandler;
+
+   PROCEDURE AbortHandler(event: Events.Event);
+   BEGIN
+      GeneralHandler(event, Errors.bug);
+   END AbortHandler;
+
+   PROCEDURE Init;
+      VAR
+	 messageKind: Errors.Kind;
+   BEGIN
+      fatalcode := 1;
+      errors := 0;
+
+      cmdName := Process.name;
+      cmdNameLen := SHORT(Strings.Len(cmdName));
+
+      messageKind := 0;
+      Errors.CreateHandlerSet(handlerSet);
+      WHILE messageKind < Errors.nkinds DO
+	 Errors.InstallHandler(handlerSet, messageKind, GeneralHandler);
+	 INC(messageKind);
+      END;
+      Events.AbortHandler(AbortHandler);
+   END Init;
+
+   (* public procedures *)
+
+   PROCEDURE CatchEvent*(type: Events.EventType; kind: Errors.Kind);
+   BEGIN
+      Errors.CatchEvent(handlerSet, kind, type);
+   END CatchEvent;
+
+   PROCEDURE ConcludeS*(s: Streams.Stream;
+		       object: RelatedEvents.Object; kind: Errors.Kind;
+		       text: ARRAY OF CHAR);
+      VAR
+	 queue: RelatedEvents.Queue;
+	 width: INTEGER;
+
+      PROCEDURE ReverseQueue(VAR queue: RelatedEvents.Queue);
+	 VAR
+	    ptr, prev, next: RelatedEvents.Queue;
+      BEGIN
+	 ptr := queue; prev := NIL;
+	 WHILE ptr # NIL DO
+	    next := ptr.next;
+	    ptr.next := prev;
+	    prev := ptr;
+	    ptr := next;
+	 END;
+	 queue := prev;
+      END ReverseQueue;
+
+   BEGIN
+      RelatedEvents.GetQueue(object, queue);
+      Write.IndentS(s);
+      Write.StringS(s, cmdName); Write.StringS(s, ": ");
+      IF kind # Errors.message THEN
+	 Write.StringS(s, Errors.kindText[kind]); Write.StringS(s, ": ");
+      END;
+      IF text # "" THEN
+	 Write.StringS(s, text); Write.StringS(s, ": ");
+      END;
+      IF queue = NIL THEN
+	 Write.StringS(s, "*no error messages found*"); Write.LnS(s);
+      ELSE
+	 width := cmdNameLen + (* ": " *) 2;
+	 StreamDisciplines.IncrIndentationWidth(s, width);
+	 (* convert FIFO into LIFO *)
+	 ReverseQueue(queue);
+	 LOOP
+	    Errors.Write(s, queue.event); Write.LnS(s);
+	    queue := queue.next;
+	    (**)IF queue = NIL THEN EXIT END;
+	    Write.IndentS(s);
+	 END;
+	 StreamDisciplines.IncrIndentationWidth(s, -width);
+      END;
+      GeneralHandler(NIL, kind);
+   END ConcludeS;
+
+   PROCEDURE Conclude*(object: RelatedEvents.Object; kind: Errors.Kind;
+		      text: ARRAY OF CHAR);
+   BEGIN
+      ConcludeS(Streams.stderr, object, kind, text);
+   END Conclude;
+
+BEGIN
+   Init;
+END ulmConclusions.