Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
6 Apr 95
Syntax12i.Scn.Fnt
LineElems
Alloc
Syntax10b.Scn.Fnt
FoldElems
Syntax10i.Scn.Fnt
(* code for all Oberons without the object model (all except HP, DEC, SGI) *)
MODULE Doc;	(** SHML 15 Dec 93 / 
	IMPORT Modules, Texts, TextFrames, Oberon;
	CONST ConfigurationName = "Doc.Configuration.Text";
	TYPE
		String = ARRAY 32 OF CHAR;
		Element = POINTER TO ElementDesc;
		ElementDesc = RECORD
			command, ext: String;
			next: Element
		END;
	VAR root: Element; default: String; wr: Texts.Writer;
	(* Support *)
	PROCEDURE Str(s: ARRAY OF CHAR);	BEGIN Texts.WriteString(wr, s) END Str;
	PROCEDURE Ch(ch: CHAR);	BEGIN Texts.Write(wr, ch) END Ch;
	PROCEDURE Ln;	BEGIN Texts.WriteLn(wr); Texts.Append(Oberon.Log, wr.buf) END Ln;
	PROCEDURE ScanFirst(VAR s: Texts.Scanner);	(* Open s on parameter list *)
		VAR sel: Texts.Text; beg, end, time: LONGINT;
	BEGIN
		Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
		IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN
			Oberon.GetSelection(sel, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
		END
	END ScanFirst;
	PROCEDURE Extension(name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR);
		VAR i, j: INTEGER;
	BEGIN
		i := -1; REPEAT INC(i) UNTIL name[i] = 0X;
		REPEAT DEC(i) UNTIL (name[i] = ".") OR (i = 0);
		IF i = 0 THEN ext[0] := 0X
		ELSE
			j := -1; REPEAT INC(i); INC(j); ext[j] := name[i] UNTIL name[i] = 0X
		END
	END Extension;
	PROCEDURE Search(ext: ARRAY OF CHAR; VAR prev: Element): Element;
		VAR l: Element;
	BEGIN
		l := root; prev := NIL;
		WHILE (l # NIL) & (l.ext # ext) DO prev := l; l := l.next END;
		RETURN l
	END Search;
	PROCEDURE Call(command: ARRAY OF CHAR);
		VAR res, i: INTEGER;
	BEGIN
		i := -1;
		REPEAT INC(i) UNTIL (command[i] = ".") OR (command[i] = 0X);
		IF command[i] = "." THEN
			Oberon.Call(command, Oberon.Par, FALSE, res);
(* delete this fold, if you run an Oberon with the object model (HP, DEC, SGI) *)
			IF res > 0 THEN	(* not-object model error messages *)
				IF res = 1 THEN Str(Modules.importing); Str(" not found")
				ELSIF res = 2 THEN Str(Modules.importing); Str(" not an obj-file")
				ELSIF res = 3 THEN Str(Modules.importing); Str(" imports "); Str(Modules.imported); Str(" with bad key")
				ELSIF res = 4 THEN Str(Modules.importing); Str(" corrupted obj file")
				ELSIF res = 5 THEN Str(command); Str(" command not found")
				ELSIF res = 6 THEN Str(Modules.importing); Str(" has too many imports")
				ELSIF res = 7 THEN Str(Modules.importing); Str(" not enough space")
				END;
				Ln
			ELSIF res < 0 THEN
				INC(i);
				WHILE command[i] # 0X DO Ch(command[i]); INC(i) END;
				Str(" not found"); Ln
			END
		END
	END Call;
	(** Commands **)
	PROCEDURE Open*;	(** "^" | name	Open document name with installed Open command **)
		VAR s: Texts.Scanner; this, prev: Element; ext: String;
	BEGIN
		ScanFirst(s);
		IF s.class = Texts.Name THEN
			Extension(s.s, ext); this := Search(ext, prev);
			IF this # NIL THEN Call(this.command) ELSIF default # "" THEN Call(default) END
		END
	END Open;
	PROCEDURE List*;	(** List all command - extension pairs **)
		VAR this: Element;
	BEGIN
		Str("Doc.List"); Ln;
		IF default # "" THEN Str(default); Str(" - *"); Ln END;
		this := root;
		WHILE this # NIL DO
			Str(this.command); Str(" - "); Str(this.ext); Ln;
			this := this.next
		END
	END List;
	PROCEDURE Defaults*;	(** Clear all pairs and load default assignments from configuration file **)
		VAR t: Texts.Text; s: Texts.Scanner; new, this, prev: Element;
	BEGIN
		root := NIL; default[0] := 0X;
		t := TextFrames.Text(ConfigurationName);
		IF t.len # 0 THEN
			Texts.OpenScanner(s, t, 0); Texts.Scan(s);
			WHILE ~s.eot & ((s.class = Texts.Name) OR (s.class = Texts.String)) DO
				NEW(new); COPY(s.s, new.command); Texts.Scan(s);
				IF (s.class = Texts.Char) & (s.c = "*") THEN default := new.command
				ELSIF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
					COPY(s.s, new.ext);
					this := Search(new.ext, prev);	(* check for duplicates *)
					IF this = NIL THEN new.next := root; root := new	(* new entry *)
					ELSIF this.command # new.command THEN	(* new entry for existing extension -> remove this *)
						IF this = root THEN new.next := root.next; root := new
						ELSE new.next := this.next; prev.next := new
						END
					END
				END;
				Texts.Scan(s)
			END
		END
	END Defaults;
BEGIN Defaults; Texts.OpenWriter(wr)
END Doc.