1 MODULE StdCoder;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Coder.odc *)
4 (* DO NOT EDIT *)
6 IMPORT
7 Kernel, Files, Converters, Stores, Views, Controllers, Dialog, Documents, Windows,
8 TextModels, TextViews, TextControllers, TextMappers,
9 StdCmds;
11 CONST
12 N = 16384;
13 LineLength = 74;
14 OldVersion = 0; ThisVersion = 1;
15 Tag = "StdCoder.Decode"; (* first letter of Tag must not to appear within Tag again *)
16 Separator = "/";
17 View = 1; File = 2; List = 3;
19 TYPE
20 FileList = POINTER TO RECORD
21 next: FileList;
22 file: Files.File;
23 type: Files.Type;
24 name:Dialog.String
25 END;
27 ParList* = RECORD
28 list*: Dialog.Selection;
29 storeAs*: Dialog.String;
30 files: FileList
31 END;
33 VAR
34 par*: ParList;
35 code: ARRAY 64 OF CHAR;
36 revCode: ARRAY 256 OF BYTE;
37 table: ARRAY N OF BYTE;
38 stdDocuType: Files.Type;
40 PROCEDURE NofSelections(IN list: Dialog.Selection): INTEGER;
41 VAR i, n: INTEGER;
42 BEGIN
43 i := 0; n := 0;
44 WHILE i # list.len DO
45 IF list.In(i) THEN INC(n) END;
46 INC(i)
47 END;
48 RETURN n
49 END NofSelections;
51 PROCEDURE ShowError(n: INTEGER; par: ARRAY OF CHAR);
52 BEGIN
53 Dialog.Beep;
54 CASE n OF
55 1: Dialog.ShowParamMsg("#Std:bad characters", par, "", "")
56 | 2: Dialog.ShowParamMsg("#Std:checksum error", par, "", "")
57 | 3: Dialog.ShowParamMsg("#Std:incompatible version", par, "", "")
58 | 4: Dialog.ShowParamMsg("#Std:filing error", par, "", "")
59 | 5: Dialog.ShowParamMsg("#Std:directory ^0 not found", par, "", "")
60 | 6: Dialog.ShowParamMsg("#Std:file ^0 not found", par, "", "")
61 | 7: Dialog.ShowParamMsg("#Std:illegal path", par, "", "")
62 | 8: Dialog.ShowParamMsg("#Std:no tag", par, "", "")
63 | 9: Dialog.ShowParamMsg("#Std:disk write protected", par, "", "")
64 | 10: Dialog.ShowParamMsg("#Std:io error", par, "", "")
65 END
66 END ShowError;
68 PROCEDURE ShowSizeMsg(x: INTEGER);
69 VAR i, j: INTEGER; ch: CHAR; s: ARRAY 20 OF CHAR;
70 BEGIN
71 ASSERT(x >= 0, 20);
72 i := 0;
73 REPEAT s[i] := CHR(ORD("0") + x MOD 10); INC(i); x := x DIV 10 UNTIL x = 0;
74 s[i] := 0X;
75 DEC(i); j := 0;
76 WHILE j < i DO ch := s[j]; s[j] := s[i]; s[i] := ch; INC(j); DEC(i) END;
77 Dialog.ShowParamStatus("#Std:^0 characters coded", s, "", "")
78 END ShowSizeMsg;
80 PROCEDURE Write(dest: TextModels.Writer; x: INTEGER; VAR n: INTEGER);
81 BEGIN
82 dest.WriteChar(code[x]); INC(n);
83 IF n = LineLength THEN dest.WriteChar(0DX); dest.WriteChar(" "); n := 0 END
84 END Write;
86 PROCEDURE WriteHeader(dest: TextModels.Writer; VAR n: INTEGER;
87 name: ARRAY OF CHAR; type: BYTE
88 );
89 VAR byte, bit, i: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
90 BEGIN
91 tag := Tag; i := 0; ch := tag[0];
92 WHILE ch # 0X DO dest.WriteChar(ch); INC(n); INC(i); ch := tag[i] END;
93 dest.WriteChar(" "); INC(n);
94 bit := 0; byte := 0; i := 0;
95 REPEAT
96 ch := name[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
97 WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
98 INC(i)
99 UNTIL ch = 0X;
100 IF bit # 0 THEN Write(dest, byte, n) END;
101 Write(dest, ThisVersion, n); Write(dest, type, n)
102 END WriteHeader;
104 PROCEDURE WriteFileType(dest: TextModels.Writer; VAR n: INTEGER; t: Files.Type);
105 VAR byte, bit, i: INTEGER; ch: CHAR;
106 BEGIN
107 IF t = Kernel.docType THEN t := stdDocuType END;
108 bit := 0; byte := 0; i := 0; dest.WriteChar(" ");
109 REPEAT
110 ch := t[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
111 WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
112 INC(i)
113 UNTIL ch = 0X;
114 IF bit # 0 THEN Write(dest, byte, n) END
115 END WriteFileType;
117 PROCEDURE WriteFile(dest: TextModels.Writer; VAR n: INTEGER; f: Files.File);
118 VAR hash, byte, bit, i, j, sum, len: INTEGER; src: Files.Reader; b: BYTE;
119 BEGIN
120 len := f.Length(); j := len; i := 6;
121 WHILE i # 0 DO Write(dest, j MOD 64, n); j := j DIV 64; DEC(i) END;
122 i := 0;
123 REPEAT table[i] := 0; INC(i) UNTIL i = N;
124 hash := 0; bit := 0; byte := 0; sum := 0; src := f.NewReader(NIL);
125 WHILE len # 0 DO
126 src.ReadByte(b); DEC(len);
127 sum := (sum + b MOD 256) MOD (16 * 1024);
128 IF table[hash] = b THEN INC(bit) (* 0 bit for correct prediction *)
129 ELSE (* Incorrect prediction -> 1'xxxx'xxxx bits *)
130 table[hash] := b; INC(byte, ASH(1, bit)); INC(bit);
131 INC(byte, ASH(b MOD 256, bit)); INC(bit, 8)
132 END;
133 WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
134 hash := (16 * hash + b MOD 256) MOD N
135 END;
136 IF bit # 0 THEN Write(dest, byte, n) END;
137 i := 6;
138 WHILE i # 0 DO Write(dest, sum MOD 64, n); sum := sum DIV 64; DEC(i) END;
139 IF n # 0 THEN dest.WriteChar(0DX); n := 0 END
140 END WriteFile;
142 PROCEDURE Read(src: TextModels.Reader; VAR x: INTEGER; VAR res: INTEGER);
143 VAR ch: CHAR;
144 BEGIN
145 IF res = 0 THEN
146 REPEAT src.ReadChar(ch); x := revCode[ORD(ch)] UNTIL (x >= 0) OR src.eot;
147 IF src.eot THEN res := 1 END
148 END;
149 IF res # 0 THEN x := 0 END
150 END Read;
152 PROCEDURE ReadHeader(src: TextModels.Reader; VAR res: INTEGER;
153 VAR name: ARRAY OF CHAR; VAR type: BYTE
154 );
155 VAR x, bit, i, j: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
156 BEGIN
157 tag := Tag; i := 0;
158 WHILE ~src.eot & (tag[i] # 0X) DO
159 src.ReadChar(ch);
160 IF ch = tag[i] THEN INC(i) ELSIF ch = tag[0] THEN i := 1 ELSE i := 0 END
161 END;
162 IF ~src.eot THEN
163 res := 0; i := 0; bit := 0; x := 0;
164 REPEAT
165 WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
166 IF res = 0 THEN
167 ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); name[i] := ch; INC(i)
168 END
169 UNTIL (res # 0) OR (ch = 0X);
170 Read(src, j, res);
171 IF res = 0 THEN
172 IF (j = ThisVersion) OR (j = OldVersion) THEN
173 Read(src, j, res); type := SHORT(SHORT(j))
174 ELSE res := 3
175 END
176 END
177 ELSE res := 8
178 END
179 END ReadHeader;
181 PROCEDURE ReadFileType(src: TextModels.Reader; VAR res: INTEGER; VAR ftype: Files.Type);
182 VAR x, bit, i, j: INTEGER; ch: CHAR;
183 BEGIN
184 res := 0; i := 0; bit := 0; x := 0;
185 REPEAT
186 WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
187 IF res = 0 THEN ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); ftype[i] := ch; INC(i) END
188 UNTIL (res # 0) OR (ch = 0X);
189 IF ftype = stdDocuType THEN ftype := Kernel.docType END
190 END ReadFileType;
192 PROCEDURE ReadFile(src: TextModels.Reader; VAR res: INTEGER; f: Files.File);
193 VAR hash, x, bit, i, j, len, sum, s: INTEGER; byte: BYTE; dest: Files.Writer;
194 BEGIN
195 res := 0; i := 0; len := 0;
196 REPEAT Read(src, x, res); len := len + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
197 i := 0;
198 REPEAT table[i] := 0; INC(i) UNTIL i = N;
199 bit := 0; hash := 0; sum := 0; dest := f.NewWriter(NIL);
200 WHILE (res = 0) & (len # 0) DO
201 IF bit = 0 THEN Read(src, x, res); bit := 6 END;
202 IF ODD(x) THEN (* Incorrect prediction -> 1'xxxx'xxxx *)
203 x := x DIV 2; DEC(bit);
204 WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
205 i := x MOD 256;
206 IF i > MAX(BYTE) THEN i := i - 256 END;
207 byte := SHORT(SHORT(i)); x := x DIV 256; DEC(bit, 8);
208 table[hash] := byte
209 ELSE byte := table[hash]; x := x DIV 2; DEC(bit) (* correct prediction *)
210 END;
211 hash := (16 * hash + byte MOD 256) MOD N;
212 dest.WriteByte(byte); sum := (sum + byte MOD 256) MOD (16 * 1024); DEC(len)
213 END;
214 IF res = 0 THEN
215 i := 0; s := 0;
216 REPEAT Read(src, x, res); s := s + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
217 IF (res = 0) & (s # sum) THEN res := 2 END
218 END
219 END ReadFile;
221 PROCEDURE ShowText (t: TextModels.Model);
222 VAR l: INTEGER; v: Views.View; wr: TextMappers.Formatter; conv: Converters.Converter;
223 BEGIN
224 l := t.Length();
225 wr.ConnectTo(t); wr.SetPos(l); wr.WriteString(" --- end of encoding ---");
226 ShowSizeMsg(l);
227 v := TextViews.dir.New(t);
228 conv := Converters.list;
229 WHILE (conv # NIL) & (conv.imp # "HostTextConv.ImportText") DO conv := conv.next END;
230 Views.Open(v, NIL, "", conv);
231 Views.SetDirty(v)
232 END ShowText;
234 PROCEDURE EncodedView*(v: Views.View): TextModels.Model;
235 VAR n: INTEGER; f: Files.File; wrs: Stores.Writer; t: TextModels.Model; wr: TextModels.Writer;
236 BEGIN
237 f := Files.dir.Temp(); wrs.ConnectTo(f); Views.WriteView(wrs, v);
238 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
239 n := 0; WriteHeader(wr, n, "", View); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
240 RETURN t
241 END EncodedView;
243 PROCEDURE EncodeDocument*;
244 VAR v: Views.View; w: Windows.Window;
245 BEGIN
246 w := Windows.dir.First();
247 IF w # NIL THEN
248 v := w.doc.OriginalView();
249 IF (v.context # NIL) & (v.context IS Documents.Context) THEN
250 v := v.context(Documents.Context).ThisDoc()
251 END;
252 IF v # NIL THEN ShowText(EncodedView(v)) END
253 END
254 END EncodeDocument;
256 PROCEDURE EncodeFocus*;
257 VAR v: Views.View;
258 BEGIN
259 v := Controllers.FocusView();
260 IF v # NIL THEN ShowText(EncodedView(v)) END
261 END EncodeFocus;
263 PROCEDURE EncodeSelection*;
264 VAR beg, end: INTEGER; t: TextModels.Model; c: TextControllers.Controller;
265 BEGIN
266 c := TextControllers.Focus();
267 IF (c # NIL) & c.HasSelection() THEN
268 c.GetSelection(beg, end);
269 t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, beg, end);
270 ShowText(EncodedView(TextViews.dir.New(t)))
271 END
272 END EncodeSelection;
274 PROCEDURE EncodeFile*;
275 VAR n: INTEGER; loc: Files.Locator; name: Files.Name; f: Files.File;
276 t: TextModels.Model; wr: TextModels.Writer;
277 BEGIN
278 Dialog.GetIntSpec("", loc, name);
279 IF loc # NIL THEN
280 f := Files.dir.Old(loc, name, TRUE);
281 IF f # NIL THEN
282 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
283 n := 0; WriteHeader(wr, n, name, File); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
284 ShowText(t)
285 END
286 END
287 END EncodeFile;
289 PROCEDURE GetFile(VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
290 VAR i, j: INTEGER; ch: CHAR;
291 BEGIN
292 i := 0; ch := path[0]; loc := Files.dir.This("");
293 WHILE (ch # 0X) & (loc # NIL) DO
294 j := 0;
295 WHILE (ch # 0X) & (ch # Separator) DO name[j] := ch; INC(j); INC(i); ch := path[i] END;
296 name[j] := 0X;
297 IF ch = Separator THEN loc := loc.This(name); INC(i); ch := path[i] END;
298 IF loc.res # 0 THEN loc := NIL END
299 END;
300 path[i] := 0X
301 END GetFile;
303 PROCEDURE ReadPath(rd: TextModels.Reader; VAR path: ARRAY OF CHAR; VAR len: INTEGER);
304 VAR i, l: INTEGER; ch: CHAR;
305 BEGIN
306 i := 0; l := LEN(path) - 1;
307 REPEAT rd.ReadChar(ch) UNTIL rd.eot OR (ch > " ");
308 WHILE ~rd.eot & (ch > " ") & (i < l) DO path[i] := ch; INC(i); rd.ReadChar(ch) END;
309 path[i] := 0X; len := i
310 END ReadPath;
312 PROCEDURE WriteString(w: Files.Writer; IN str: ARRAY OF CHAR; len: INTEGER);
313 VAR i: INTEGER;
314 BEGIN
315 i := 0;
316 WHILE i < len DO
317 IF ORD(str[i]) > MAX(BYTE) THEN w.WriteByte(SHORT(SHORT(ORD(str[i]) - 256)))
318 ELSE w.WriteByte(SHORT(SHORT(ORD(str[i]))))
319 END;
320 INC(i)
321 END
322 END WriteString;
324 PROCEDURE EncodeFileList*;
325 TYPE
326 FileList = POINTER TO RECORD
327 next: FileList;
328 f: Files.File
329 END;
330 VAR
331 beg, end, i, j, n: INTEGER; err: BOOLEAN;
332 files, last: FileList;
333 list, f: Files.File; w: Files.Writer; loc: Files.Locator;
334 rd: TextModels.Reader; wr: TextModels.Writer; t: TextModels.Model;
335 c: TextControllers.Controller;
336 name: Files.Name; path, next: ARRAY 2048 OF CHAR;
337 BEGIN
338 c := TextControllers.Focus();
339 IF (c # NIL) & c.HasSelection() THEN c.GetSelection(beg, end);
340 rd := c.text.NewReader(NIL); rd.SetPos(beg); err := FALSE;
341 list := Files.dir.Temp(); w := list.NewWriter(NIL); files := NIL; last := NIL;
342 ReadPath(rd, path, i);
343 WHILE (path # "") & (rd.Pos() - i < end) & ~err DO
344 GetFile(path, loc, name);
345 IF loc # NIL THEN
346 f := Files.dir.Old(loc, name, TRUE); err := f = NIL;
347 IF ~err THEN
348 IF last = NIL THEN NEW(last); files := last ELSE NEW(last.next); last := last.next END;
349 last.f := f;
350 ReadPath(rd, next, j);
351 IF (next = "=>") & (rd.Pos() - j < end) THEN
352 ReadPath(rd, next, j);
353 IF next # "" THEN WriteString(w, next, j + 1); ReadPath(rd, next, j)
354 ELSE err := TRUE
355 END
356 ELSE WriteString(w, path, i + 1)
357 END;
358 path := next; i := j
359 END
360 ELSE err := TRUE
361 END
362 END;
363 IF ~err & (files # NIL) THEN
364 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
365 n := 0; WriteHeader(wr, n, "", List);
366 WriteFileType(wr, n, list.type); WriteFile(wr, n, list);
367 WHILE files # NIL DO
368 WriteFileType(wr, n, files.f.type); WriteFile(wr, n, files.f); files := files.next
369 END;
370 ShowText(t)
371 ELSIF err THEN
372 IF path = "" THEN ShowError(7, path)
373 ELSIF loc # NIL THEN ShowError(6, path)
374 ELSE ShowError(5, path)
375 END
376 END
377 END
378 END EncodeFileList;
380 PROCEDURE DecodeView(rd: TextModels.Reader; name: Files.Name);
381 VAR res: INTEGER; f: Files.File; ftype: Files.Type; rds: Stores.Reader; v: Views.View;
382 BEGIN
383 ReadFileType(rd, res, ftype);
384 IF res = 0 THEN
385 f := Files.dir.Temp(); ReadFile(rd, res, f);
386 IF res = 0 THEN
387 rds.ConnectTo(f); Views.ReadView(rds, v); Views.Open(v, NIL, name, NIL);
388 Views.SetDirty(v)
389 ELSE ShowError(res, "")
390 END
391 ELSE ShowError(res, "")
392 END
393 END DecodeView;
395 PROCEDURE DecodeFile(rd: TextModels.Reader; name: Files.Name);
396 VAR res: INTEGER; ftype: Files.Type; loc: Files.Locator; f: Files.File;
397 BEGIN
398 ReadFileType(rd, res, ftype);
399 IF res = 0 THEN
400 Dialog.GetExtSpec(name, ftype, loc, name);
401 IF loc # NIL THEN
402 f := Files.dir.New(loc, Files.ask);
403 IF f # NIL THEN
404 ReadFile(rd, res, f);
405 IF res = 0 THEN
406 f.Register(name, ftype, Files.ask, res);
407 IF res # 0 THEN ShowError(4, "") END
408 ELSE ShowError(res, "")
409 END
410 ELSIF loc.res = 4 THEN ShowError(9, "")
411 ELSIF loc.res = 5 THEN ShowError(10, "")
412 END
413 END
414 ELSE ShowError(res, "")
415 END
416 END DecodeFile;
418 PROCEDURE DecodeFileList (rd: TextModels.Reader; VAR files: FileList; VAR len, res: INTEGER);
419 VAR i, n: INTEGER; b: BYTE; p: FileList;
420 ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
421 BEGIN
422 ReadFileType(rd, res, ftype);
423 IF res = 0 THEN
424 f := Files.dir.Temp(); ReadFile(rd, res, f);
425 IF res = 0 THEN
426 files := NIL; p := NIL; n := 0;
427 frd := f.NewReader(NIL); frd.ReadByte(b);
428 WHILE ~frd.eof & (res = 0) DO
429 INC(n); i := 0;
430 WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
431 IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
432 & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
433 THEN path[i - 4] := 0X
434 ELSE path[i] := 0X
435 END;
436 IF ~frd.eof THEN
437 IF p = NIL THEN NEW(p); files := p ELSE NEW(p.next); p := p.next END;
438 p.name := path;
439 frd.ReadByte(b)
440 ELSE res := 1
441 END
442 END;
443 p := files; len := n;
444 WHILE (res = 0) & (p # NIL) DO
445 ReadFileType(rd, res, p.type);
446 IF res = 0 THEN p.file := Files.dir.Temp(); ReadFile(rd, res, p.file) END;
447 p := p.next
448 END
449 END
450 END
451 END DecodeFileList;
453 PROCEDURE OpenDialog(files: FileList; len: INTEGER);
454 VAR i: INTEGER; p: FileList;
455 BEGIN
456 par.files := files; par.list.SetLen(len);
457 p := files; i := 0;
458 WHILE p # NIL DO par.list.SetItem(i, p.name); INC(i); p := p.next END;
459 par.storeAs := "";
460 Dialog.Update(par); Dialog.UpdateList(par.list);
461 StdCmds.OpenAuxDialog("Std/Rsrc/Coder", "Decode")
462 END OpenDialog;
464 PROCEDURE CloseDialog*;
465 BEGIN
466 par.files := NIL; par.list.SetLen(0); par.storeAs := "";
467 Dialog.UpdateList(par.list); Dialog.Update(par)
468 END CloseDialog;
470 PROCEDURE Select*(op, from, to: INTEGER);
471 VAR p: FileList; i: INTEGER;
472 BEGIN
473 IF (op = Dialog.included) OR (op = Dialog.excluded) OR (op = Dialog.set) THEN
474 IF NofSelections(par.list) = 1 THEN
475 i := 0; p := par.files;
476 WHILE ~par.list.In(i) DO INC(i); p := p.next END;
477 par.storeAs := p.name
478 ELSE par.storeAs := ""
479 END;
480 Dialog.Update(par)
481 END
482 END Select;
484 PROCEDURE CopyFile(from: Files.File; loc: Files.Locator; name: Files.Name; type: Files.Type);
485 CONST BufSize = 4096;
486 VAR res, k, l: INTEGER; f: Files.File; r: Files.Reader; w: Files.Writer;
487 buf: ARRAY BufSize OF BYTE;
488 BEGIN
489 f := Files.dir.New(loc, Files.ask);
490 IF f # NIL THEN
491 r := from.NewReader(NIL); w := f.NewWriter(NIL); l := from.Length();
492 WHILE l # 0 DO
493 IF l <= BufSize THEN k := l ELSE k := BufSize END;
494 r.ReadBytes(buf, 0, k); w.WriteBytes(buf, 0, k);
495 l := l - k
496 END;
497 f.Register(name, type, Files.ask, res);
498 IF res # 0 THEN ShowError(4, "") END
499 ELSIF loc.res = 4 THEN ShowError(9, "")
500 ELSIF loc.res = 5 THEN ShowError(10, "")
501 END
502 END CopyFile;
504 PROCEDURE StoreSelection*;
505 VAR i, n: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
506 BEGIN
507 n := NofSelections(par.list);
508 IF n > 1 THEN
509 i := 0; p := par.files;
510 WHILE n # 0 DO
511 WHILE ~par.list.In(i) DO INC(i); p := p.next END;
512 GetFile(p.name, loc, name); CopyFile(p.file, loc, name, p.type);
513 DEC(n); INC(i); p := p.next
514 END
515 ELSIF (n = 1) & (par.storeAs # "") THEN
516 i := 0; p := par.files;
517 WHILE ~par.list.In(i) DO INC(i); p := p.next END;
518 GetFile(par.storeAs, loc, name); CopyFile(p.file, loc, name, p.type)
519 END
520 END StoreSelection;
522 PROCEDURE StoreSelectionGuard*(VAR p: Dialog.Par);
523 VAR n: INTEGER;
524 BEGIN
525 n := NofSelections(par.list);
526 p.disabled := (n = 0) OR ((n = 1) & (par.storeAs = ""))
527 END StoreSelectionGuard;
529 PROCEDURE StoreSingle*;
530 VAR i: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
531 BEGIN
532 IF NofSelections(par.list) = 1 THEN
533 i := 0; p := par.files;
534 WHILE ~par.list.In(i) DO INC(i); p := p.next END;
535 GetFile(p.name, loc, name);
536 Dialog.GetExtSpec(name, p.type, loc, name);
537 IF loc # NIL THEN CopyFile(p.file, loc, name, p.type) END
538 END
539 END StoreSingle;
541 PROCEDURE StoreSingleGuard*(VAR p: Dialog.Par);
542 BEGIN
543 p.disabled := NofSelections(par.list) # 1
544 END StoreSingleGuard;
546 PROCEDURE StoreAllFiles(files: FileList);
547 VAR loc: Files.Locator; name: Files.Name;
548 BEGIN
549 WHILE files # NIL DO
550 GetFile(files.name, loc, name); CopyFile(files.file, loc, name, files.type); files := files.next
551 END
552 END StoreAllFiles;
554 PROCEDURE StoreAll*;
555 BEGIN
556 StoreAllFiles(par.files)
557 END StoreAll;
559 PROCEDURE DecodeAllFromText*(text: TextModels.Model; beg: INTEGER; ask: BOOLEAN);
560 VAR res, i: INTEGER; type: BYTE; name: Files.Name; rd: TextModels.Reader; files: FileList;
561 BEGIN
562 CloseDialog;
563 rd := text.NewReader(NIL); rd.SetPos(beg);
564 ReadHeader(rd, res, name, type);
565 i := 0;
566 WHILE name[i] # 0X DO INC(i) END;
567 IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
568 & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
569 THEN name[i - 4] := 0X
570 END;
571 IF res = 0 THEN
572 IF type = View THEN DecodeView(rd, name)
573 ELSIF type = File THEN DecodeFile(rd, name)
574 ELSIF type = List THEN
575 DecodeFileList(rd, files, i, res);
576 IF res = 0 THEN
577 IF ask THEN OpenDialog(files, i) ELSE StoreAllFiles(files) END
578 ELSE ShowError(res, "")
579 END
580 ELSE ShowError(3, "")
581 END
582 ELSE ShowError(res, "")
583 END
584 END DecodeAllFromText;
586 PROCEDURE Decode*;
587 VAR beg, end: INTEGER; c: TextControllers.Controller;
588 BEGIN
589 CloseDialog;
590 c := TextControllers.Focus();
591 IF c # NIL THEN
592 IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
593 DecodeAllFromText(c.text, beg, TRUE)
594 END
595 END Decode;
597 PROCEDURE ListFiles(rd: TextModels.Reader; VAR wr: TextMappers.Formatter);
598 VAR i, n, res: INTEGER; b: BYTE;
599 ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
600 BEGIN
601 ReadFileType(rd, res, ftype);
602 IF res = 0 THEN
603 f := Files.dir.Temp(); ReadFile(rd, res, f);
604 IF res = 0 THEN
605 n := 0;
606 frd := f.NewReader(NIL); frd.ReadByte(b);
607 WHILE ~frd.eof & (res = 0) DO
608 INC(n); i := 0;
609 WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
610 IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
611 & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
612 THEN path[i - 4] := 0X
613 ELSE path[i] := 0X
614 END;
615 IF ~frd.eof THEN wr.WriteString(path); wr.WriteLn; frd.ReadByte(b) ELSE res := 1 END
616 END
617 ELSE ShowError(res, "")
618 END
619 ELSE ShowError(res, "")
620 END
621 END ListFiles;
623 PROCEDURE ListSingleton(type, name: ARRAY OF CHAR; VAR wr: TextMappers.Formatter);
624 BEGIN
625 wr.WriteString(type);
626 IF name # "" THEN wr.WriteString(": '"); wr.WriteString(name); wr.WriteChar("'") END;
627 wr.WriteLn
628 END ListSingleton;
630 PROCEDURE EncodedInText*(text: TextModels.Model; beg: INTEGER): TextModels.Model;
631 VAR res, i: INTEGER; type: BYTE; name: Files.Name;
632 rd: TextModels.Reader; report: TextModels.Model; wr: TextMappers.Formatter;
633 BEGIN
634 report := TextModels.dir.New(); wr.ConnectTo(report);
635 rd := text.NewReader(NIL); rd.SetPos(beg);
636 ReadHeader(rd, res, name, type);
637 i := 0;
638 WHILE name[i] # 0X DO INC(i) END;
639 IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
640 & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
641 THEN name[i - 4] := 0X
642 END;
643 IF res = 0 THEN
644 IF type = View THEN ListSingleton("View", name, wr)
645 ELSIF type = File THEN ListSingleton("File", name, wr)
646 ELSIF type = List THEN ListFiles(rd, wr)
647 ELSE ShowError(3, "")
648 END
649 ELSE ShowError(res, "")
650 END;
651 RETURN report
652 END EncodedInText;
654 PROCEDURE ListEncodedMaterial*;
655 VAR beg, end: INTEGER; c: TextControllers.Controller;
656 BEGIN
657 c := TextControllers.Focus();
658 IF c # NIL THEN
659 IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
660 Views.OpenView(TextViews.dir.New(EncodedInText(c.text, beg)))
661 END
662 END ListEncodedMaterial;
664 PROCEDURE InitCodes;
665 VAR i: BYTE; j: INTEGER;
666 BEGIN
667 j := 0;
668 WHILE j # 256 DO revCode[j] := -1; INC(j) END;
669 code[0] := "."; revCode[ORD(".")] := 0; code[1] := ","; revCode[ORD(",")] := 1;
670 i := 2; j := ORD("0");
671 WHILE j <= ORD("9") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
672 j := ORD("A");
673 WHILE j <= ORD("Z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
674 j := ORD("a");
675 WHILE j <= ORD("z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
676 ASSERT(i = 64, 60)
677 END InitCodes;
679 BEGIN
680 InitCodes;
681 stdDocuType[0] := 3X; stdDocuType[1] := 3X; stdDocuType[2] := 3X; stdDocuType[3] := 0X
682 END StdCoder.