FEAT: added a way how to create not native codecs (keeping the original codecs infrastructure)

Author: Oldes

src/boot/sysobj.r

@@ -150,6 +150,16 @@ script: context [
 
 standard: context [
 
+	codec: context [
+		name:       ;word!
+		title:      ;string!
+		suffixes:   ;block!
+		decode:     ;[any-function! none!]
+		encode:     ;[any-function! none!]
+		identify:   ;[any-function! none!]
+			none
+	]
+
 	error: context [ ; Template used for all errors:
 		code: 0
 		type: 'user

src/mezz/sys-codec.r

@@ -17,14 +17,40 @@ REBOL [
 	}
 ]
 
+register-codec: function [
+	{Registers non-native codec to system/codecs and it's suffixes into system/options/file-types}
+	codec [object!] "Codec to register (should be based on system/standard/codec template)"
+	/local name suffixes
+][
+	if not word? name: try [codec/name][
+		cause-error 'Script 'wrong-type 'codec/name
+	]
+	
+	append system/codecs reduce [to set-word! name codec]
+
+	if block? suffixes: try [codec/suffixes][
+		append append system/options/file-types suffixes name
+	]
+	codec
+]
+
 decode: function [
  	{Decodes a series of bytes into the related datatype (e.g. image!).}
 	type [word!] {Media type (jpeg, png, etc.)}
-	data [binary!] {The data to decode}
+	data [binary! string!] {The data to decode}
 ][
 	unless all [
 		cod: select system/codecs type
-		data: do-codec cod/entry 'decode data
+		data: either handle? try [cod/entry] [
+			; original codecs were only natives
+			do-codec cod/entry 'decode data
+		][
+			either function? try [:cod/decode][
+				cod/decode data
+			][
+				cause-error 'internal 'not-done type
+			]
+		]
 	][
 		cause-error 'access 'no-codec type
 	]
@@ -39,7 +65,16 @@ encode: function [
 ][
 	unless all [
 		cod: select system/codecs type
-		data: do-codec cod/entry 'encode data
+		data: either handle? try [cod/entry] [
+			; original codecs were only natives
+			do-codec cod/entry 'encode data
+		][
+			either function? try [:cod/encode][
+				cod/encode data
+			][
+				cause-error 'internal 'not-done type
+			]
+		]
 	][
 		cause-error 'access 'no-codec type
 	]
@@ -51,11 +86,21 @@ encoding?: function [
 	data [binary!]
 ][
 	foreach [name codec] system/codecs [
-		if do-codec codec/entry 'identify data [
-			return name
+		either handle? try [cod/entry] [
+			if do-codec codec/entry 'identify data [
+				return name
+			]
+		][
+			if all [
+				function? try [:cod/identify]
+				cod/identify data
+			][
+				return name
+			]
 		]
+		
 	]
 	none
 ]
 
-export [decode encode encoding?]
+export [register-codec decode encode encoding?]