home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
doc.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
5KB
|
126 lines
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.