/pliant/language/type/text/language.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2
3	module "/pliant/language/compiler.pli"
4	module "/pliant/language/schedule/threads_engine.pli"
5	module "/pliant/language/parser.pli"
6	module "/pliant/admin/file.pli"
7	module "/pliant/language/stream.pli"
8
9	gvar Array:Str languages
10	gvar (Dictionary Str Int) mapping
11	gvar Sem sem
12
13	languages += "en"
14	mapping insert "en" 0
15
16
17	function language_declare name -> index
18	arg Str name ; arg Int index
19	sem request
20	var Pointer:Int pindex :> mapping first name
21	if exists:pindex
22	index := pindex
23	else
24	index := mapping size
25	languages += name
26	mapping insert name index
27	sem release
28
29	function language_index name -> index
30	arg Str name ; arg Int index
31	sem rd_request
32	var Pointer:Int pindex :> mapping first name
33	index := shunt exists:pindex pindex (cast undefined Int)
34	sem rd_release
35
36	function language_list -> langs
37	arg Array:Str langs
38	sem rd_request
39	langs := languages
40	sem rd_release
41
42
43	type lStr
44	field Address buffer
45	field Int nlang
46
47
48	function build l
49	arg_w lStr l
50	l buffer := null
51	l nlang := 0
52
53	function destroy l
54	arg_w lStr l
55	memory_free l:buffer
56
57	function copy s d
58	arg lStr s ; arg_w lStr d
59	var Int size := s:nlang*Int:size+(shunt s:nlang=0 0 (s:buffer map Int s:nlang-1))
60	memory_free d:buffer
61	d buffer := memory_allocate size addressof:d
62	memory_copy s:buffer d:buffer size
63	d nlang := s nlang
64
65
66	method l set lang value
67	arg_rw lStr l ; arg Int lang ; arg Str value
68	check lang>=0 and lang<mapping:size
69	var Int len
70	if lang>=0 and lang<l:nlang
71	var Int off := shunt lang<>0 (l:buffer map Int lang-1) 0
72	len := (l:buffer map Int lang)-off
73	else
74	len := 0
75	len := (shunt l:nlang=0 0 (l:buffer map Int l:nlang-1))+value:len-len
76	var Int nlang := max l:nlang lang+1
77	var Address buffer := memory_allocate nlang*Int:size+len addressof:l
78	var Int offset := 0
79	for (var Int i) 0 nlang-1
80	var Address src ; var Int len
81	if i=lang
82	len := value len
83	src := value characters
84	eif i<l:nlang
85	var Int off := shunt i<>0 (l:buffer map Int i-1) 0
86	len := (l:buffer map Int i)-off
87	src := (l:buffer translate Int l:nlang) translate Char off
88	else
89	len := 0
90	memory_copy src ((buffer translate Int nlang) translate Char offset) len
91	offset += len
92	buffer map Int i := offset
93	memory_free l:buffer
94	l buffer := buffer
95	l nlang := nlang
96
97
98	method l set lang value
99	arg_rw lStr l ; arg Str lang ; arg Str value
100	var Int index := language_index lang
101	if index<>undefined
102	l set index value
103
104
105	method l get lang -> s
106	arg lStr l ; arg Int lang ; arg Str s
107	check lang>=0
108	if lang<l:nlang
109	var Int offset := shunt lang<>0 (l:buffer map Int lang-1) 0
110	var Int len := (l:buffer map Int lang)-offset
111	s set ((l:buffer translate Int l:nlang) translate Char offset) len false
112	else
113	s := ""
114	((the_function '. get' lStr Int -> Str) arg 2) maps := 1
115
116	method l get lang -> value
117	arg lStr l ; arg Str lang ; arg Str value
118	var Int index := language_index lang
119	if index<>undefined
120	value := l get index
121	else
122	value := ""
123	((the_function '. get' lStr Str -> Str) arg 2) maps := 1
124
125
126	function 'cast Str' l -> s
127	arg lStr l ; arg Str s
128	extension
129	var Int index := current_thread_header language_index
130	s := l get index
131	if s:len=0 and index<>0
132	s := l get 0
133	((the_function 'cast Str' lStr -> Str) arg 1) maps := 1
134
135
136	export language_declare language_index language_list
137	export lStr '. get' '. set'
138	export 'cast Str'
139
140
141	function parse_lstr context line parameter
142	arg_rw ParserContext context ; arg Str line ; arg Address parameter
143	if (line 0 1)<>"[dq]"
144	return
145	var Int i := 1
146	var Link:lStr l :> new lStr
147	var Str lang := "en"
148	var CBool some := false
149	while i<line:len
150	if line:i="[dq]"
151	if some
152	var Str name := context:module name
153	name := name 0 (name search_last "." name:len)
154	var Array:FileInfo files := file_list (name 0 (name search_last "/" name:len)+1) standard
155	for (var Int j) 0 files:size-1
156	var Str ext := files:j:extension
157	if (files:j:name 0 name:len)=name and files:j:name<>context:module:name and (ext 0 1)="."
158	(var Stream file) open files:j:name in+safe
159	while not file:atend
160	if (file:readline parse (var Str en) (var Str translation))
161	if en=(l get 0)
162	language_declare (ext 1 ext:len)
163	l set (ext 1 ext:len) translation
164	context add_token addressof:l
165	context forward i+1
166	return
167	eif line:i="[lb]"
168	if ((line i line:len) eparse "[lb]" any:(var Str code) "[rb]" any)
169	if code="l"
170	some := true
171	eif code:len>0 and (code code:len-1)=":"
172	lang := code 0 code:len-1 ; language_declare lang ; some := true
173	eif ("[dq][lb]"+code+"[rb][dq]" parse (var Str char))
174	l set lang (l get lang)+char
175	else
176	return
177	i += 2+code:len
178	else
179	return
180	else
181	l set lang (l get lang)+line:i
182	i += 1
183
184	gvar ParserFilter lstr_filter
185	lstr_filter function :> the_function parse_lstr ParserContext Str Address
186	constant 'pliant parser basic types' lstr_filter
187	export 'pliant parser basic types'
188
189
190	function language_encode l -> s
191	arg lStr l ; arg Str s
192	s := ""
193	for (var Int i) 0 l:nlang-1
194	var Str v := l get i
195	if v:len>0
196	s += (shunt s:len>0 " " "")+languages:i+" "+string:v
197
198	function language_decode s create_langs -> l
199	arg Str s ; arg CBool create_langs ; arg lStr l
200	l := var lStr empty_string
201	var Str all := s
202	while (all parse any:(var Str lang) _ (var Str value) any:(var Str remain))
203	if create_langs
204	l set lang value
205	else
206	var Int index := language_index lang
207	if index<>undefined
208	l set index value
209	all := remain
210
211	export language_encode language_decode
212
213
214	method data 'to string' options -> string
215	arg lStr data ; arg Str options ; arg Str string
216	if options="raw"
217	string := language_encode data
218	eif options="db" or options="con"
219	string := cast data Str
220	else
221	string := string (cast data Str)
222
223	method data 'from string' string options may_skip skiped offset -> status
224	arg_w lStr data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
225	if options="raw"
226	data := language_decode string false
227	skiped := 0
228	offset := string len
229	return success
230	eif options="db" or options="con"
231	data set (current_thread_header language_index) string
232	skiped := 0
233	offset := string len
234	return success
235	else
236	var Link:Str s :> new Str
237	status := s 'from string' string options may_skip skiped offset
238	data set (current_thread_header language_index) s