123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682 |
- MODULE StdCoder;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Coder.odc *)
- (* DO NOT EDIT *)
- IMPORT
- Kernel, Files, Converters, Stores, Views, Controllers, Dialog, Documents, Windows,
- TextModels, TextViews, TextControllers, TextMappers,
- StdCmds;
- CONST
- N = 16384;
- LineLength = 74;
- OldVersion = 0; ThisVersion = 1;
- Tag = "StdCoder.Decode"; (* first letter of Tag must not to appear within Tag again *)
- Separator = "/";
- View = 1; File = 2; List = 3;
- TYPE
- FileList = POINTER TO RECORD
- next: FileList;
- file: Files.File;
- type: Files.Type;
- name:Dialog.String
- END;
- ParList* = RECORD
- list*: Dialog.Selection;
- storeAs*: Dialog.String;
- files: FileList
- END;
- VAR
- par*: ParList;
- code: ARRAY 64 OF CHAR;
- revCode: ARRAY 256 OF BYTE;
- table: ARRAY N OF BYTE;
- stdDocuType: Files.Type;
- PROCEDURE NofSelections(IN list: Dialog.Selection): INTEGER;
- VAR i, n: INTEGER;
- BEGIN
- i := 0; n := 0;
- WHILE i # list.len DO
- IF list.In(i) THEN INC(n) END;
- INC(i)
- END;
- RETURN n
- END NofSelections;
- PROCEDURE ShowError(n: INTEGER; par: ARRAY OF CHAR);
- BEGIN
- Dialog.Beep;
- CASE n OF
- 1: Dialog.ShowParamMsg("#Std:bad characters", par, "", "")
- | 2: Dialog.ShowParamMsg("#Std:checksum error", par, "", "")
- | 3: Dialog.ShowParamMsg("#Std:incompatible version", par, "", "")
- | 4: Dialog.ShowParamMsg("#Std:filing error", par, "", "")
- | 5: Dialog.ShowParamMsg("#Std:directory ^0 not found", par, "", "")
- | 6: Dialog.ShowParamMsg("#Std:file ^0 not found", par, "", "")
- | 7: Dialog.ShowParamMsg("#Std:illegal path", par, "", "")
- | 8: Dialog.ShowParamMsg("#Std:no tag", par, "", "")
- | 9: Dialog.ShowParamMsg("#Std:disk write protected", par, "", "")
- | 10: Dialog.ShowParamMsg("#Std:io error", par, "", "")
- END
- END ShowError;
- PROCEDURE ShowSizeMsg(x: INTEGER);
- VAR i, j: INTEGER; ch: CHAR; s: ARRAY 20 OF CHAR;
- BEGIN
- ASSERT(x >= 0, 20);
- i := 0;
- REPEAT s[i] := CHR(ORD("0") + x MOD 10); INC(i); x := x DIV 10 UNTIL x = 0;
- s[i] := 0X;
- DEC(i); j := 0;
- WHILE j < i DO ch := s[j]; s[j] := s[i]; s[i] := ch; INC(j); DEC(i) END;
- Dialog.ShowParamStatus("#Std:^0 characters coded", s, "", "")
- END ShowSizeMsg;
- PROCEDURE Write(dest: TextModels.Writer; x: INTEGER; VAR n: INTEGER);
- BEGIN
- dest.WriteChar(code[x]); INC(n);
- IF n = LineLength THEN dest.WriteChar(0DX); dest.WriteChar(" "); n := 0 END
- END Write;
- PROCEDURE WriteHeader(dest: TextModels.Writer; VAR n: INTEGER;
- name: ARRAY OF CHAR; type: BYTE
- );
- VAR byte, bit, i: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
- BEGIN
- tag := Tag; i := 0; ch := tag[0];
- WHILE ch # 0X DO dest.WriteChar(ch); INC(n); INC(i); ch := tag[i] END;
- dest.WriteChar(" "); INC(n);
- bit := 0; byte := 0; i := 0;
- REPEAT
- ch := name[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- INC(i)
- UNTIL ch = 0X;
- IF bit # 0 THEN Write(dest, byte, n) END;
- Write(dest, ThisVersion, n); Write(dest, type, n)
- END WriteHeader;
- PROCEDURE WriteFileType(dest: TextModels.Writer; VAR n: INTEGER; t: Files.Type);
- VAR byte, bit, i: INTEGER; ch: CHAR;
- BEGIN
- IF t = Kernel.docType THEN t := stdDocuType END;
- bit := 0; byte := 0; i := 0; dest.WriteChar(" ");
- REPEAT
- ch := t[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- INC(i)
- UNTIL ch = 0X;
- IF bit # 0 THEN Write(dest, byte, n) END
- END WriteFileType;
- PROCEDURE WriteFile(dest: TextModels.Writer; VAR n: INTEGER; f: Files.File);
- VAR hash, byte, bit, i, j, sum, len: INTEGER; src: Files.Reader; b: BYTE;
- BEGIN
- len := f.Length(); j := len; i := 6;
- WHILE i # 0 DO Write(dest, j MOD 64, n); j := j DIV 64; DEC(i) END;
- i := 0;
- REPEAT table[i] := 0; INC(i) UNTIL i = N;
- hash := 0; bit := 0; byte := 0; sum := 0; src := f.NewReader(NIL);
- WHILE len # 0 DO
- src.ReadByte(b); DEC(len);
- sum := (sum + b MOD 256) MOD (16 * 1024);
- IF table[hash] = b THEN INC(bit) (* 0 bit for correct prediction *)
- ELSE (* Incorrect prediction -> 1'xxxx'xxxx bits *)
- table[hash] := b; INC(byte, ASH(1, bit)); INC(bit);
- INC(byte, ASH(b MOD 256, bit)); INC(bit, 8)
- END;
- WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
- hash := (16 * hash + b MOD 256) MOD N
- END;
- IF bit # 0 THEN Write(dest, byte, n) END;
- i := 6;
- WHILE i # 0 DO Write(dest, sum MOD 64, n); sum := sum DIV 64; DEC(i) END;
- IF n # 0 THEN dest.WriteChar(0DX); n := 0 END
- END WriteFile;
- PROCEDURE Read(src: TextModels.Reader; VAR x: INTEGER; VAR res: INTEGER);
- VAR ch: CHAR;
- BEGIN
- IF res = 0 THEN
- REPEAT src.ReadChar(ch); x := revCode[ORD(ch)] UNTIL (x >= 0) OR src.eot;
- IF src.eot THEN res := 1 END
- END;
- IF res # 0 THEN x := 0 END
- END Read;
- PROCEDURE ReadHeader(src: TextModels.Reader; VAR res: INTEGER;
- VAR name: ARRAY OF CHAR; VAR type: BYTE
- );
- VAR x, bit, i, j: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
- BEGIN
- tag := Tag; i := 0;
- WHILE ~src.eot & (tag[i] # 0X) DO
- src.ReadChar(ch);
- IF ch = tag[i] THEN INC(i) ELSIF ch = tag[0] THEN i := 1 ELSE i := 0 END
- END;
- IF ~src.eot THEN
- res := 0; i := 0; bit := 0; x := 0;
- REPEAT
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- IF res = 0 THEN
- ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); name[i] := ch; INC(i)
- END
- UNTIL (res # 0) OR (ch = 0X);
- Read(src, j, res);
- IF res = 0 THEN
- IF (j = ThisVersion) OR (j = OldVersion) THEN
- Read(src, j, res); type := SHORT(SHORT(j))
- ELSE res := 3
- END
- END
- ELSE res := 8
- END
- END ReadHeader;
- PROCEDURE ReadFileType(src: TextModels.Reader; VAR res: INTEGER; VAR ftype: Files.Type);
- VAR x, bit, i, j: INTEGER; ch: CHAR;
- BEGIN
- res := 0; i := 0; bit := 0; x := 0;
- REPEAT
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- IF res = 0 THEN ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); ftype[i] := ch; INC(i) END
- UNTIL (res # 0) OR (ch = 0X);
- IF ftype = stdDocuType THEN ftype := Kernel.docType END
- END ReadFileType;
- PROCEDURE ReadFile(src: TextModels.Reader; VAR res: INTEGER; f: Files.File);
- VAR hash, x, bit, i, j, len, sum, s: INTEGER; byte: BYTE; dest: Files.Writer;
- BEGIN
- res := 0; i := 0; len := 0;
- REPEAT Read(src, x, res); len := len + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
- i := 0;
- REPEAT table[i] := 0; INC(i) UNTIL i = N;
- bit := 0; hash := 0; sum := 0; dest := f.NewWriter(NIL);
- WHILE (res = 0) & (len # 0) DO
- IF bit = 0 THEN Read(src, x, res); bit := 6 END;
- IF ODD(x) THEN (* Incorrect prediction -> 1'xxxx'xxxx *)
- x := x DIV 2; DEC(bit);
- WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
- i := x MOD 256;
- IF i > MAX(BYTE) THEN i := i - 256 END;
- byte := SHORT(SHORT(i)); x := x DIV 256; DEC(bit, 8);
- table[hash] := byte
- ELSE byte := table[hash]; x := x DIV 2; DEC(bit) (* correct prediction *)
- END;
- hash := (16 * hash + byte MOD 256) MOD N;
- dest.WriteByte(byte); sum := (sum + byte MOD 256) MOD (16 * 1024); DEC(len)
- END;
- IF res = 0 THEN
- i := 0; s := 0;
- REPEAT Read(src, x, res); s := s + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
- IF (res = 0) & (s # sum) THEN res := 2 END
- END
- END ReadFile;
- PROCEDURE ShowText (t: TextModels.Model);
- VAR l: INTEGER; v: Views.View; wr: TextMappers.Formatter; conv: Converters.Converter;
- BEGIN
- l := t.Length();
- wr.ConnectTo(t); wr.SetPos(l); wr.WriteString(" --- end of encoding ---");
- ShowSizeMsg(l);
- v := TextViews.dir.New(t);
- conv := Converters.list;
- WHILE (conv # NIL) & (conv.imp # "HostTextConv.ImportText") DO conv := conv.next END;
- Views.Open(v, NIL, "", conv);
- Views.SetDirty(v)
- END ShowText;
- PROCEDURE EncodedView*(v: Views.View): TextModels.Model;
- VAR n: INTEGER; f: Files.File; wrs: Stores.Writer; t: TextModels.Model; wr: TextModels.Writer;
- BEGIN
- f := Files.dir.Temp(); wrs.ConnectTo(f); Views.WriteView(wrs, v);
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, "", View); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
- RETURN t
- END EncodedView;
- PROCEDURE EncodeDocument*;
- VAR v: Views.View; w: Windows.Window;
- BEGIN
- w := Windows.dir.First();
- IF w # NIL THEN
- v := w.doc.OriginalView();
- IF (v.context # NIL) & (v.context IS Documents.Context) THEN
- v := v.context(Documents.Context).ThisDoc()
- END;
- IF v # NIL THEN ShowText(EncodedView(v)) END
- END
- END EncodeDocument;
- PROCEDURE EncodeFocus*;
- VAR v: Views.View;
- BEGIN
- v := Controllers.FocusView();
- IF v # NIL THEN ShowText(EncodedView(v)) END
- END EncodeFocus;
- PROCEDURE EncodeSelection*;
- VAR beg, end: INTEGER; t: TextModels.Model; c: TextControllers.Controller;
- BEGIN
- c := TextControllers.Focus();
- IF (c # NIL) & c.HasSelection() THEN
- c.GetSelection(beg, end);
- t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, beg, end);
- ShowText(EncodedView(TextViews.dir.New(t)))
- END
- END EncodeSelection;
- PROCEDURE EncodeFile*;
- VAR n: INTEGER; loc: Files.Locator; name: Files.Name; f: Files.File;
- t: TextModels.Model; wr: TextModels.Writer;
- BEGIN
- Dialog.GetIntSpec("", loc, name);
- IF loc # NIL THEN
- f := Files.dir.Old(loc, name, TRUE);
- IF f # NIL THEN
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, name, File); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
- ShowText(t)
- END
- END
- END EncodeFile;
- PROCEDURE GetFile(VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
- VAR i, j: INTEGER; ch: CHAR;
- BEGIN
- i := 0; ch := path[0]; loc := Files.dir.This("");
- WHILE (ch # 0X) & (loc # NIL) DO
- j := 0;
- WHILE (ch # 0X) & (ch # Separator) DO name[j] := ch; INC(j); INC(i); ch := path[i] END;
- name[j] := 0X;
- IF ch = Separator THEN loc := loc.This(name); INC(i); ch := path[i] END;
- IF loc.res # 0 THEN loc := NIL END
- END;
- path[i] := 0X
- END GetFile;
- PROCEDURE ReadPath(rd: TextModels.Reader; VAR path: ARRAY OF CHAR; VAR len: INTEGER);
- VAR i, l: INTEGER; ch: CHAR;
- BEGIN
- i := 0; l := LEN(path) - 1;
- REPEAT rd.ReadChar(ch) UNTIL rd.eot OR (ch > " ");
- WHILE ~rd.eot & (ch > " ") & (i < l) DO path[i] := ch; INC(i); rd.ReadChar(ch) END;
- path[i] := 0X; len := i
- END ReadPath;
-
- PROCEDURE WriteString(w: Files.Writer; IN str: ARRAY OF CHAR; len: INTEGER);
- VAR i: INTEGER;
- BEGIN
- i := 0;
- WHILE i < len DO
- IF ORD(str[i]) > MAX(BYTE) THEN w.WriteByte(SHORT(SHORT(ORD(str[i]) - 256)))
- ELSE w.WriteByte(SHORT(SHORT(ORD(str[i]))))
- END;
- INC(i)
- END
- END WriteString;
- PROCEDURE EncodeFileList*;
- TYPE
- FileList = POINTER TO RECORD
- next: FileList;
- f: Files.File
- END;
- VAR
- beg, end, i, j, n: INTEGER; err: BOOLEAN;
- files, last: FileList;
- list, f: Files.File; w: Files.Writer; loc: Files.Locator;
- rd: TextModels.Reader; wr: TextModels.Writer; t: TextModels.Model;
- c: TextControllers.Controller;
- name: Files.Name; path, next: ARRAY 2048 OF CHAR;
- BEGIN
- c := TextControllers.Focus();
- IF (c # NIL) & c.HasSelection() THEN c.GetSelection(beg, end);
- rd := c.text.NewReader(NIL); rd.SetPos(beg); err := FALSE;
- list := Files.dir.Temp(); w := list.NewWriter(NIL); files := NIL; last := NIL;
- ReadPath(rd, path, i);
- WHILE (path # "") & (rd.Pos() - i < end) & ~err DO
- GetFile(path, loc, name);
- IF loc # NIL THEN
- f := Files.dir.Old(loc, name, TRUE); err := f = NIL;
- IF ~err THEN
- IF last = NIL THEN NEW(last); files := last ELSE NEW(last.next); last := last.next END;
- last.f := f;
- ReadPath(rd, next, j);
- IF (next = "=>") & (rd.Pos() - j < end) THEN
- ReadPath(rd, next, j);
- IF next # "" THEN WriteString(w, next, j + 1); ReadPath(rd, next, j)
- ELSE err := TRUE
- END
- ELSE WriteString(w, path, i + 1)
- END;
- path := next; i := j
- END
- ELSE err := TRUE
- END
- END;
- IF ~err & (files # NIL) THEN
- t := TextModels.dir.New(); wr := t.NewWriter(NIL);
- n := 0; WriteHeader(wr, n, "", List);
- WriteFileType(wr, n, list.type); WriteFile(wr, n, list);
- WHILE files # NIL DO
- WriteFileType(wr, n, files.f.type); WriteFile(wr, n, files.f); files := files.next
- END;
- ShowText(t)
- ELSIF err THEN
- IF path = "" THEN ShowError(7, path)
- ELSIF loc # NIL THEN ShowError(6, path)
- ELSE ShowError(5, path)
- END
- END
- END
- END EncodeFileList;
- PROCEDURE DecodeView(rd: TextModels.Reader; name: Files.Name);
- VAR res: INTEGER; f: Files.File; ftype: Files.Type; rds: Stores.Reader; v: Views.View;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- rds.ConnectTo(f); Views.ReadView(rds, v); Views.Open(v, NIL, name, NIL);
- Views.SetDirty(v)
- ELSE ShowError(res, "")
- END
- ELSE ShowError(res, "")
- END
- END DecodeView;
- PROCEDURE DecodeFile(rd: TextModels.Reader; name: Files.Name);
- VAR res: INTEGER; ftype: Files.Type; loc: Files.Locator; f: Files.File;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- Dialog.GetExtSpec(name, ftype, loc, name);
- IF loc # NIL THEN
- f := Files.dir.New(loc, Files.ask);
- IF f # NIL THEN
- ReadFile(rd, res, f);
- IF res = 0 THEN
- f.Register(name, ftype, Files.ask, res);
- IF res # 0 THEN ShowError(4, "") END
- ELSE ShowError(res, "")
- END
- ELSIF loc.res = 4 THEN ShowError(9, "")
- ELSIF loc.res = 5 THEN ShowError(10, "")
- END
- END
- ELSE ShowError(res, "")
- END
- END DecodeFile;
- PROCEDURE DecodeFileList (rd: TextModels.Reader; VAR files: FileList; VAR len, res: INTEGER);
- VAR i, n: INTEGER; b: BYTE; p: FileList;
- ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- files := NIL; p := NIL; n := 0;
- frd := f.NewReader(NIL); frd.ReadByte(b);
- WHILE ~frd.eof & (res = 0) DO
- INC(n); i := 0;
- WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
- IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
- & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
- THEN path[i - 4] := 0X
- ELSE path[i] := 0X
- END;
- IF ~frd.eof THEN
- IF p = NIL THEN NEW(p); files := p ELSE NEW(p.next); p := p.next END;
- p.name := path;
- frd.ReadByte(b)
- ELSE res := 1
- END
- END;
- p := files; len := n;
- WHILE (res = 0) & (p # NIL) DO
- ReadFileType(rd, res, p.type);
- IF res = 0 THEN p.file := Files.dir.Temp(); ReadFile(rd, res, p.file) END;
- p := p.next
- END
- END
- END
- END DecodeFileList;
- PROCEDURE OpenDialog(files: FileList; len: INTEGER);
- VAR i: INTEGER; p: FileList;
- BEGIN
- par.files := files; par.list.SetLen(len);
- p := files; i := 0;
- WHILE p # NIL DO par.list.SetItem(i, p.name); INC(i); p := p.next END;
- par.storeAs := "";
- Dialog.Update(par); Dialog.UpdateList(par.list);
- StdCmds.OpenAuxDialog("Std/Rsrc/Coder", "Decode")
- END OpenDialog;
- PROCEDURE CloseDialog*;
- BEGIN
- par.files := NIL; par.list.SetLen(0); par.storeAs := "";
- Dialog.UpdateList(par.list); Dialog.Update(par)
- END CloseDialog;
- PROCEDURE Select*(op, from, to: INTEGER);
- VAR p: FileList; i: INTEGER;
- BEGIN
- IF (op = Dialog.included) OR (op = Dialog.excluded) OR (op = Dialog.set) THEN
- IF NofSelections(par.list) = 1 THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- par.storeAs := p.name
- ELSE par.storeAs := ""
- END;
- Dialog.Update(par)
- END
- END Select;
- PROCEDURE CopyFile(from: Files.File; loc: Files.Locator; name: Files.Name; type: Files.Type);
- CONST BufSize = 4096;
- VAR res, k, l: INTEGER; f: Files.File; r: Files.Reader; w: Files.Writer;
- buf: ARRAY BufSize OF BYTE;
- BEGIN
- f := Files.dir.New(loc, Files.ask);
- IF f # NIL THEN
- r := from.NewReader(NIL); w := f.NewWriter(NIL); l := from.Length();
- WHILE l # 0 DO
- IF l <= BufSize THEN k := l ELSE k := BufSize END;
- r.ReadBytes(buf, 0, k); w.WriteBytes(buf, 0, k);
- l := l - k
- END;
- f.Register(name, type, Files.ask, res);
- IF res # 0 THEN ShowError(4, "") END
- ELSIF loc.res = 4 THEN ShowError(9, "")
- ELSIF loc.res = 5 THEN ShowError(10, "")
- END
- END CopyFile;
- PROCEDURE StoreSelection*;
- VAR i, n: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
- BEGIN
- n := NofSelections(par.list);
- IF n > 1 THEN
- i := 0; p := par.files;
- WHILE n # 0 DO
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(p.name, loc, name); CopyFile(p.file, loc, name, p.type);
- DEC(n); INC(i); p := p.next
- END
- ELSIF (n = 1) & (par.storeAs # "") THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(par.storeAs, loc, name); CopyFile(p.file, loc, name, p.type)
- END
- END StoreSelection;
- PROCEDURE StoreSelectionGuard*(VAR p: Dialog.Par);
- VAR n: INTEGER;
- BEGIN
- n := NofSelections(par.list);
- p.disabled := (n = 0) OR ((n = 1) & (par.storeAs = ""))
- END StoreSelectionGuard;
- PROCEDURE StoreSingle*;
- VAR i: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
- BEGIN
- IF NofSelections(par.list) = 1 THEN
- i := 0; p := par.files;
- WHILE ~par.list.In(i) DO INC(i); p := p.next END;
- GetFile(p.name, loc, name);
- Dialog.GetExtSpec(name, p.type, loc, name);
- IF loc # NIL THEN CopyFile(p.file, loc, name, p.type) END
- END
- END StoreSingle;
- PROCEDURE StoreSingleGuard*(VAR p: Dialog.Par);
- BEGIN
- p.disabled := NofSelections(par.list) # 1
- END StoreSingleGuard;
- PROCEDURE StoreAllFiles(files: FileList);
- VAR loc: Files.Locator; name: Files.Name;
- BEGIN
- WHILE files # NIL DO
- GetFile(files.name, loc, name); CopyFile(files.file, loc, name, files.type); files := files.next
- END
- END StoreAllFiles;
- PROCEDURE StoreAll*;
- BEGIN
- StoreAllFiles(par.files)
- END StoreAll;
- PROCEDURE DecodeAllFromText*(text: TextModels.Model; beg: INTEGER; ask: BOOLEAN);
- VAR res, i: INTEGER; type: BYTE; name: Files.Name; rd: TextModels.Reader; files: FileList;
- BEGIN
- CloseDialog;
- rd := text.NewReader(NIL); rd.SetPos(beg);
- ReadHeader(rd, res, name, type);
- i := 0;
- WHILE name[i] # 0X DO INC(i) END;
- IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
- & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
- THEN name[i - 4] := 0X
- END;
- IF res = 0 THEN
- IF type = View THEN DecodeView(rd, name)
- ELSIF type = File THEN DecodeFile(rd, name)
- ELSIF type = List THEN
- DecodeFileList(rd, files, i, res);
- IF res = 0 THEN
- IF ask THEN OpenDialog(files, i) ELSE StoreAllFiles(files) END
- ELSE ShowError(res, "")
- END
- ELSE ShowError(3, "")
- END
- ELSE ShowError(res, "")
- END
- END DecodeAllFromText;
- PROCEDURE Decode*;
- VAR beg, end: INTEGER; c: TextControllers.Controller;
- BEGIN
- CloseDialog;
- c := TextControllers.Focus();
- IF c # NIL THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
- DecodeAllFromText(c.text, beg, TRUE)
- END
- END Decode;
- PROCEDURE ListFiles(rd: TextModels.Reader; VAR wr: TextMappers.Formatter);
- VAR i, n, res: INTEGER; b: BYTE;
- ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
- BEGIN
- ReadFileType(rd, res, ftype);
- IF res = 0 THEN
- f := Files.dir.Temp(); ReadFile(rd, res, f);
- IF res = 0 THEN
- n := 0;
- frd := f.NewReader(NIL); frd.ReadByte(b);
- WHILE ~frd.eof & (res = 0) DO
- INC(n); i := 0;
- WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
- IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
- & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
- THEN path[i - 4] := 0X
- ELSE path[i] := 0X
- END;
- IF ~frd.eof THEN wr.WriteString(path); wr.WriteLn; frd.ReadByte(b) ELSE res := 1 END
- END
- ELSE ShowError(res, "")
- END
- ELSE ShowError(res, "")
- END
- END ListFiles;
- PROCEDURE ListSingleton(type, name: ARRAY OF CHAR; VAR wr: TextMappers.Formatter);
- BEGIN
- wr.WriteString(type);
- IF name # "" THEN wr.WriteString(": '"); wr.WriteString(name); wr.WriteChar("'") END;
- wr.WriteLn
- END ListSingleton;
- PROCEDURE EncodedInText*(text: TextModels.Model; beg: INTEGER): TextModels.Model;
- VAR res, i: INTEGER; type: BYTE; name: Files.Name;
- rd: TextModels.Reader; report: TextModels.Model; wr: TextMappers.Formatter;
- BEGIN
- report := TextModels.dir.New(); wr.ConnectTo(report);
- rd := text.NewReader(NIL); rd.SetPos(beg);
- ReadHeader(rd, res, name, type);
- i := 0;
- WHILE name[i] # 0X DO INC(i) END;
- IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
- & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
- THEN name[i - 4] := 0X
- END;
- IF res = 0 THEN
- IF type = View THEN ListSingleton("View", name, wr)
- ELSIF type = File THEN ListSingleton("File", name, wr)
- ELSIF type = List THEN ListFiles(rd, wr)
- ELSE ShowError(3, "")
- END
- ELSE ShowError(res, "")
- END;
- RETURN report
- END EncodedInText;
- PROCEDURE ListEncodedMaterial*;
- VAR beg, end: INTEGER; c: TextControllers.Controller;
- BEGIN
- c := TextControllers.Focus();
- IF c # NIL THEN
- IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
- Views.OpenView(TextViews.dir.New(EncodedInText(c.text, beg)))
- END
- END ListEncodedMaterial;
- PROCEDURE InitCodes;
- VAR i: BYTE; j: INTEGER;
- BEGIN
- j := 0;
- WHILE j # 256 DO revCode[j] := -1; INC(j) END;
- code[0] := "."; revCode[ORD(".")] := 0; code[1] := ","; revCode[ORD(",")] := 1;
- i := 2; j := ORD("0");
- WHILE j <= ORD("9") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- j := ORD("A");
- WHILE j <= ORD("Z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- j := ORD("a");
- WHILE j <= ORD("z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
- ASSERT(i = 64, 60)
- END InitCodes;
- BEGIN
- InitCodes;
- stdDocuType[0] := 3X; stdDocuType[1] := 3X; stdDocuType[2] := 3X; stdDocuType[3] := 0X
- END StdCoder.
|