Seamless work with plain UTF-8 CP files

Conv/Mod/Utf8.cp

@@ -0,0 +1,92 @@
+MODULE ConvUtf8;
+
+	(*
+		Converter for Import / Export filter for 8-bit Unicode Transformation Format
+	*)
+
+	IMPORT
+		Files, Stores, TextModels, TextViews;
+
+	CONST
+		CR = 0DX; LF = 0AX;
+
+		font1 = "Arial Unicode MS";
+		font2 = "Lucida Sans Unicode";
+		unicodefont = font1;
+
+	PROCEDURE SetFont (md: TextModels.Model);
+		VAR at: TextModels.Attributes; beg, end: INTEGER;
+	BEGIN
+		beg := 0; end := md.Length();
+		NEW(at); at.InitFromProp(md.Prop(beg, end));
+		at := TextModels.NewTypeface(at, unicodefont);
+		md.SetAttr(beg, end, at);
+	END SetFont;
+
+	PROCEDURE ReadChar (IN rd: Stores.Reader; VAR ch: CHAR);
+		VAR
+			c1, c2, c3: BYTE;
+	BEGIN	(* UTF-8 format *)
+		rd.ReadByte(c1);
+		ch := CHR(c1);
+		IF c1 < 0 THEN (* c1 < 0 &  c1 > -64 = C0 = 110x xxxx *)
+			rd.ReadByte(c2);
+			ch := CHR(64 * (c1 MOD 32) + (c2 MOD 64));
+			IF c1 >=  - 32 THEN (* c1 < 0 & c1 >= -32 = E0 = 1110 xxxxx *)
+				rd.ReadByte(c3);
+				ch := CHR(4096 * (c1 MOD 16) + 64 * (c2 MOD 64) + (c3 MOD 64));
+			END;
+		END;
+	END ReadChar;
+
+	PROCEDURE WriteChar (IN wr: Stores.Writer; ch: CHAR);
+	BEGIN	(* UTF-8 format *)
+		IF ch <= 7FX THEN
+			wr.WriteByte(SHORT(SHORT(ORD(ch))))
+		ELSIF ch <= 7FFX THEN
+			wr.WriteByte(SHORT(SHORT( - 64 + ORD(ch) DIV 64)));
+			wr.WriteByte(SHORT(SHORT( - 128 + ORD(ch) MOD 64)))
+		ELSE
+			wr.WriteByte(SHORT(SHORT( - 32 + ORD(ch) DIV 4096)));
+			wr.WriteByte(SHORT(SHORT( - 128 + ORD(ch) DIV 64 MOD 64)));
+			wr.WriteByte(SHORT(SHORT( - 128 + ORD(ch) MOD 64)))
+		END
+	END WriteChar;
+
+	PROCEDURE ImportUtf8* (f: Files.File; OUT s: Stores.Store);
+		VAR
+			rd: Stores.Reader; md: TextModels.Model; wr: TextModels.Writer; ch, nch: CHAR;
+	BEGIN
+		ASSERT(f # NIL, 20);
+		rd.ConnectTo(f); rd.SetPos(0);
+		md := TextModels.dir.New(); wr := md.NewWriter(NIL);
+		ReadChar(rd, ch);
+		WHILE ~rd.rider.eof DO
+			ReadChar(rd, nch);
+			IF (ch = CR) & (nch = LF) THEN ReadChar(rd, nch)
+			ELSIF ch = LF THEN ch := CR
+			END;
+			wr.WriteChar(ch);
+			ch := nch;
+		END;
+		SetFont(md);
+		s := TextViews.dir.New(md)
+	END ImportUtf8;
+
+	PROCEDURE ExportUtf8* (s: Stores.Store; f: Files.File);
+		VAR wr: Stores.Writer; md: TextModels.Model; rd: TextModels.Reader; ch: CHAR;
+	BEGIN
+		ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
+		wr.ConnectTo(f); wr.SetPos(0);
+		md := s(TextViews.View).ThisModel();
+		IF md # NIL THEN
+			rd := md.NewReader(NIL);
+			rd.ReadChar(ch);
+			WHILE ~rd.eot DO
+				IF ch = CR THEN WriteChar(wr, LF) ELSE WriteChar(wr, ch) END;
+				rd.ReadChar(ch)
+			END
+		END
+	END ExportUtf8;
+
+END ConvUtf8.

Std/Mod/PlainDoc.cp

@@ -0,0 +1,195 @@
+MODULE StdPlainDoc;
+
+	(*
+		Purpose: Defines a UTF-8 encoded format as default format for storage of documents instead of ODC
+		Initial version: 26 Aug 2013
+		Author: Peter Cushnir
+		Contributors: Romiras
+	*)
+
+	IMPORT
+		SYSTEM, Kernel, Utils, Services, Views, Files, Converters, Windows, Stores, Dialog, StdDialog;
+
+	CONST
+		plainTyp = 'cp';
+
+	TYPE
+		GuardAction = POINTER TO RECORD (Services.Action) 
+			adr: INTEGER;
+			next: GuardAction;
+			t: LONGINT;
+			name: Files.Name;
+			conv: Converters.Converter;
+		END;
+
+		ViewHook = POINTER TO RECORD (Views.ViewHook) 
+			guards: GuardAction;
+		END;
+
+	VAR 
+		utf8conv: Converters.Converter;
+		thisHook: ViewHook;
+		defaultHook: Views.ViewHook;
+
+	PROCEDURE Remove (VAR root: GuardAction; old: GuardAction);
+		VAR dummy, g: GuardAction;
+	BEGIN
+		ASSERT(old # NIL, 20);
+		Services.RemoveAction(old);
+		NEW(dummy); dummy.next:=root;
+		g:=dummy;
+		WHILE (g # NIL) & (old # NIL) DO
+			IF g.next=old THEN
+				g.next:=old.next; old.next:=NIL; old:=NIL;
+			END;
+			g:=g.next
+		END;
+		root:=dummy.next
+	END Remove;
+
+	PROCEDURE Add (VAR root: GuardAction; new: GuardAction);
+	BEGIN
+		ASSERT(new # NIL, 20);
+		new.next:=root;
+		root:=new;
+		Services.DoLater(new, Services.now)
+	END Add;
+
+	PROCEDURE This (root: GuardAction; adr: INTEGER): GuardAction;
+		VAR g: GuardAction;
+	BEGIN
+		g:=root;
+		WHILE (g # NIL) & (g.adr # adr) DO g:=g.next END;
+	RETURN g
+	END This;
+
+	PROCEDURE Clean (root: GuardAction);
+		VAR g: GuardAction;
+	BEGIN
+		g:=root;
+		WHILE (g # NIL) DO Services.RemoveAction(g); g:=g.next END
+	END Clean;
+
+	PROCEDURE (a: GuardAction) Do;
+		VAR g: GuardAction;
+	BEGIN
+		IF thisHook # NIL THEN
+			g:=thisHook.guards;
+			WHILE (g # NIL) & (g # a) DO g:=g.next END;
+			IF (g=a) & ((Services.Ticks()-a.t)<1000) THEN Services.DoLater(a, Services.now) 
+			ELSE
+				Remove(thisHook.guards, a)
+			END
+		END
+	END Do;
+
+	PROCEDURE (h: ViewHook) Open (v: Views.View; title: ARRAY OF CHAR; loc: Files.Locator; name: Files.Name; conv: Converters.Converter; asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN);
+		VAR this: GuardAction;
+	BEGIN
+		this:=This(h.guards, Services.AdrOf(v^));
+		IF this # NIL THEN
+			Dialog.ShowStatus('Open '+this.name$);
+			name:=this.name; conv:=this.conv;
+			Remove(h.guards, this);
+		END;
+		StdDialog.Open(v, title, loc, name, conv, asTool, asAux, noResize, allowDuplicates, neverDirty)
+	END Open;
+
+	PROCEDURE (h: ViewHook) OldView (loc: Files.Locator; name: Files.Name; VAR conv: Converters.Converter): Views.View;
+		(* Based on StdDialog.OldView *)
+		VAR w: Windows.Window; s: Stores.Store; converter: Converters.Converter; a: GuardAction;
+			fi: Files.FileInfo; vs: Dialog.String; pos: INTEGER;
+
+		PROCEDURE FixName (VAR name: ARRAY OF CHAR);
+			VAR i: INTEGER;
+		BEGIN
+			i:=0;
+			WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
+			IF name[i] = "." THEN name[i]:=0X END;
+			Utils.MakeFileName(name, plainTyp);
+		END FixName;
+
+	BEGIN
+		ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
+
+		vs:=name$;
+		FixName(vs);
+		fi:=Files.dir.FileList(loc);
+		WHILE (fi # NIL) & (fi.name$ # vs) DO fi:=fi.next END;
+
+		IF fi # NIL THEN	(* found plainTyp *)
+			FixName(name);
+			Dialog.ShowStatus('Found '+name$+' UTF-8 document');
+			converter := utf8conv;
+			NEW(a)
+		ELSE
+			Utils.MakeFileName(name, "");
+			converter := conv
+		END; 
+		s := NIL;
+		IF loc.res # 77 THEN
+			w := Windows.dir.First(); 
+			WHILE (w # NIL) & ((w.loc = NIL) OR (w.name = "") OR (w.loc.res = 77) OR ~Files.dir.SameFile(loc, name, w.loc, w.name) OR (w.conv # converter)) DO
+				w := Windows.dir.Next(w)
+			END;
+			IF w # NIL THEN s := w.doc.ThisView() END
+		END;
+		IF s = NIL THEN
+			Converters.Import(loc, name, converter, s);
+			IF s # NIL THEN 
+				IF a # NIL THEN
+					a.adr:=Services.AdrOf(s^);
+					a.t:=Services.Ticks();
+					a.name:=name;
+					a.conv:=converter;
+					Add(h.guards, a)
+				END;
+				StdDialog.RecalcView(s(Views.View))
+			END
+		END;
+		IF s # NIL THEN RETURN s(Views.View) ELSE RETURN NIL END
+	END OldView;
+
+	PROCEDURE (h: ViewHook) RegisterView (v: Views.View; loc: Files.Locator; name: Files.Name; conv: Converters.Converter);
+	BEGIN
+		ASSERT(v # NIL, 20); ASSERT(loc # NIL, 21); ASSERT(name # "", 22);
+		Utils.MakeFileName(name, "");
+		Converters.Export(loc, name, conv, v)
+	END RegisterView;
+
+	PROCEDURE GetDefaultHook;
+		VAR m: Kernel.Module; i: INTEGER; p: ANYPTR;
+	BEGIN
+		m:=Kernel.ThisMod('Views');
+		i := 0;
+		WHILE (i < m.nofptrs) & (defaultHook = NIL) DO
+			SYSTEM.GET(m.varBase + m.ptrs[i], p); INC(i);
+			IF (p # NIL) & (p IS Views.ViewHook) THEN
+				defaultHook:=p (Views.ViewHook)
+			END;
+			INC(i)
+		END;
+	END GetDefaultHook;
+
+	PROCEDURE FindUtf8Converter;
+	BEGIN
+		utf8conv := Converters.list;
+		WHILE (utf8conv # NIL) & (utf8conv.fileType$ # plainTyp) DO utf8conv := utf8conv.next END;
+		IF utf8conv = NIL THEN utf8conv := Converters.list END	(* use default document converter *)
+	END FindUtf8Converter;
+
+	PROCEDURE Init*;
+	BEGIN END Init;
+
+BEGIN
+	GetDefaultHook;
+	NEW(thisHook); Views.SetViewHook(thisHook);
+	Converters.Register ("ConvUtf8.ImportUtf8", "ConvUtf8.ExportUtf8", "TextViews.View", plainTyp, {});
+	FindUtf8Converter
+CLOSE
+	IF thisHook # NIL THEN
+		Clean(thisHook.guards);
+		Views.SetViewHook(defaultHook);
+		thisHook:=NIL
+	END;
+END StdPlainDoc.

System/Mod/Config.cp

@@ -32,6 +32,7 @@ MODULE Config;
 		OleData.Register("HostBitmaps.ImportDPictAsBitmap", "", "METAFILEPICT", "HostBitmaps.View", {});
 		OleData.Register("", "OleData.ExportPicture", "METAFILEPICT", "", {});
 
+		Dialog.Call("StdPlainDoc.Init", "", res); (* Define UTF-8 encoded with extension CP as default format for storage of documents *)
 		Dialog.Call("StdLog.Open", "", res)
 	END Setup;
 

System/Mod/Utils.cp

@@ -1,4 +1,9 @@
-MODULE Utils;
+MODULE Utils;
+
+	(*
+		Some file utilities
+		Compile & Link Order: Kernel Files Utils HostFiles StdLoader
+	*)
 
 	IMPORT Files;
 
@@ -10,7 +15,7 @@
 		objType* = "ocf";
 		symType* = "osf";
 
-		codeType* = "cp";
+		codeType* = "odc";
 		docType* = "odc";
 
 	PROCEDURE SplitName* (name: ARRAY OF CHAR; VAR head, tail: ARRAY OF CHAR);
@@ -61,13 +66,18 @@
 		ELSIF cat$ = "Mod" THEN type := codeType
 		ELSE type := ""
 		END;
-		SplitName(mod, sub, name); MakeFileName(name, type);
+		SplitName(mod, sub, name);
 		loc := Files.dir.This(sub); file := NIL;
 		IF loc # NIL THEN
 			loc := loc.This(cat);
 			IF sub = "" THEN
 				IF loc # NIL THEN
+					MakeFileName(name, type);
 					file := Files.dir.Old(loc, name, Files.shared);
+					IF (file = NIL) & (type = codeType) THEN
+						MakeFileName(name, docType);
+						file := Files.dir.Old(loc, name, Files.shared);
+					END;
 					IF file = NIL THEN loc := NIL END
 				END;
 				IF loc = NIL THEN