Amiga MA Magazine 1998 #6/amigamamagazinepolishissue1998.iso/coders/jËzyki_programowania/oberon/system/doc.mod

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.