Syntax10.Scn.FntSyntax10i.Scn.FntStampElemsAlloc4 Apr 96Nw3S PN'LineElemsAllocESyntax10m.Scn.Fntc K'  0$F!; 01MODULE Doc; (** SHML 15 Dec 93,  *) (** Document opener. Calls installable Open command according to file extension. *) (* Created by Stefan H._M. Ludwig, Institute for Computer Systems, ETH Zurich, ludwig@inf.ethz.ch, 15 Dec 93 Changes: 3 Apr 96: SHML - uses Host module. Fully portable. *) IMPORT Host, Texts, TextFrames, Oberon; CONST ConfigurationName = "Doc.Configuration.Text"; Version = "Doc (SHML 3 Apr 96)"; 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; msg: ARRAY 128 OF CHAR; BEGIN i := -1; REPEAT INC(i) UNTIL (command[i] = ".") OR (command[i] = 0X); IF command[i] = "." THEN Oberon.Call(command, Oberon.Par, FALSE, res); IF res # 0 THEN Host.CallError(command, res, msg); Str(msg); 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.