/pliant/appli/type_browser.pli
1	# Copyright  Patrice Ossona de Mendez
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/language/os.pli"
17	module "/pliant/language/compiler.pli"
18	module "type_browser/page.pli"
19	module "/pliant/protocol/http/server.pli"
20	module "/pliant/protocol/http/style/default.style"
21
22	public
23
24	method page show_castto t
25	arg_rw HtmlPage page; arg Type t
26	var Link:(Index Str Arrow) fl :> t find_castto
27	var Pointer:Function f
28	var Pointer:PairFunctionModule p
29	implicit page
30	table columns 2
31	each c fl
32	p :> c map PairFunctionModule
33	f :> p f
34	cell
35	var Str mn :=  (fl key c)+" -> "+t:name
36	var Str source := f:position 0 (f:position search " " f:position:len)
37	if source<>""
38	var Str fn := f:name
39	if (fn search " " -1)>=0
40	fn := "'"+fn+"'"
41	link mn source section "function "+fn
42	else
43	bold
44	text mn
45	if (addressof p:m)<>null
46	eol
47	small
48	[(]
49	show_module p:m
50	[)]
51	if f:name<>"cast "+t:name
52	eol
53	[(alias of ];text f:name;[)]
54	cell
55	var Bool some := false
56	if (f:flags .and. function_flag_implicit)<>0
57	[implicit]; some:=true
58	if (f:flags .and. function_flag_extension)<>0
59	if some
60	[, ]
61	else
62	some:=true
63	[extension]
64	if (f:flags .and. function_flag_reduction)<>0
65	if some
66	[, ]
67	else
68	some:=true
69	[reduction]
70	if not some
71	fixed:[ ]
72
73	method page show_castfrom t
74	arg_rw HtmlPage page; arg Type t
75	var Link:(Index Str Arrow) fl :> t find_castfrom
76	var Pointer:Function f
77	var Pointer:PairFunctionModule p
78	implicit page
79	table columns 2
80	each c fl
81	p :> c map PairFunctionModule
82	f :> p f
83	cell
84	var Str mn :=  t:name+" -> "+(fl key c)
85	var Str source := f:position 0 (f:position search " " f:position:len)
86	if source<>""
87	var Str fn := f:name
88	if (fn search " " -1)>=0
89	fn := "'"+fn+"'"
90	link mn source section "function "+fn
91	else
92	bold
93	text mn
94	if (addressof p:m)<>null
95	eol
96	small
97	[(]
98	show_module p:m
99	[)]
100	if f:name<>"cast "+(fl key c)
101	eol
102	[(alias of ];text f:name;[)]
103	cell
104	var Bool some := false
105	if (f:flags .and. function_flag_implicit)<>0
106	[implicit]; some:=true
107	if (f:flags .and. function_flag_extension)<>0
108	if some
109	[, ]
110	else
111	some:=true
112	[extension]
113	if (f:flags .and. function_flag_reduction)<>0
114	if some
115	[, ]
116	else
117	some:=true
118	[reduction]
119	if not some
120	fixed:[ ]
121
122
123	method page show_methods t
124	arg_rw HtmlPage page; arg Type t
125	var Link:(Index Str Arrow) fl :> t find_methods
126	var Pointer:FunctionPrototype fp
127	var Int maxa := 0
128	var Bool res := false
129	var Pointer:Function f
130	var Pointer:PairFunctionModule p
131	each c fl
132	p :> c map PairFunctionModule
133	f :> p f
134	if f:nb_args>maxa
135	maxa := f:nb_args
136	if not:res and f:nb_args<>f:nb_args_with_result
137	res:=true
138	var Pointer:Function f
139	var Int maxc := (shunt res 3 4)+maxa
140	implicit page
141	center
142	table columns maxc border 1
143	html "<tr><td rowspan=2></td><td colspan="+string:maxc+"></td><td rowspan=2></td></tr>"
144	html "<tr><td>"
145	center
146	[Method name]
147	html "</td>"
148	html "<td colspan="+string:(maxa+1)+">"
149	center
150	[Arguments]
151	html "</td>"
152	if res
153	html "<td>"
154	center
155	[Result]
156	html "</td>"
157	html "</tr>"
158	each c fl
159	html "<tr><td rowspan=4></td><td colspan="+string:maxc+"></td><td rowspan=4></td></tr>"
160	p :> c map PairFunctionModule
161	f :> p f
162	html "<tr><td rowspan=3>"
163	var Str mn := fl key c
164	if mn<>f:name
165	mn+= " (alias of "+f:name+")"
166	var Str source := f:position 0 (f:position search " " f:position:len)
167	if source<>""
168	link (mn 2 mn:len) source section "method "+(f:name 2 f:name:len)
169	if (f:flags .and. function_flag_generic <> 0)
170	italic:[ (generic)]
171	else
172	bold
173	text (mn 2 mn:len)
174	if (f:flags .and. function_flag_generic <> 0)
175	italic:[ (generic)]
176	if (addressof p:m)<>null
177	eol
178	small
179	[(]
180	show_module p:m
181	[)]
182	html "</td>"
183	html "<td>"
184	center
185	italic:[Name]
186	html "</td>"
187	for (var Int i) 0 f:nb_args-1
188	fp :> f arg i
189	html "<td>"
190	center
191	fixed
192	text (shunt fp:name="" " " fp:name)
193	html "</td>"
194	if f:nb_args <> maxa
195	html "<td colspan="+string:(maxa-f:nb_args)+" rowspan=3>"
196	fixed:[ ]
197	html "</td>"
198	if res
199	if f:nb_args_with_result<>f:nb_args
200	html "<td>"
201	fixed:[ ]
202	html "</td>"
203	else
204	html "<td rowspan=3>"
205	fixed:[ ]
206	html "</td>"
207	html "</tr>"
208	html "<tr>"
209	html "<td>"
210	center
211	italic:[Type]
212	html "</td>"
213	for (var Int i) 0 f:nb_args_with_result-1
214	fp :> f arg i
215	html "<td>"
216	center
217	text fp:type:name
218	html "</td>"
219	html "</tr><tr>"
220	html "<td>"
221	center
222	italic:[Access]
223	html "</td>"
224	for (var Int i) 0 f:nb_args_with_result-1
225	fp :> f arg i
226	html "<td>"
227	center
228	fixed
229	text access_to_string:(fp access)
230	html "</td>"
231	html "</tr>"
232	html "<tr><td colspan="+string:(maxc+2)+"></td></tr>"
233
234	function compute_tindex -> newd
235	arg Link:(Index Str Address) newd
236	newd :> new (Index Str Address)
237	each t pliant_general_dictionary type Type
238	if t:name:0<>"("
239	newd insert t:name addressof:t
240
241	method page listtypes
242	arg_rw HtmlPage page
243	var Link:(Index Str Address) newd :> compute_tindex
244	var Int x:=0
245	implicit page
246	table columns 2 border 0
247	var Pointer:Address c :> newd first
248	while addressof:c<>null
249	var Pointer:Type t :> c map Type
250	var Str source := t:position 0 (t:position search " " t:position:len)
251	cell
252	link t:name t:name no_extension
253	cell
254	if source<>""
255	text "  (defined in "
256	link source source section "type "+t:name
257	text ")"
258	else
259	fixed:[ ]
260	c :> newd next c
261
262	method page type_browser tname
263	arg_rw HtmlPage page; arg Str tname
264	implicit page
265	if tname=""
266	title "Type Browser"
267	para
268	[You may access directly a type using the following form, or scroll on the huge list bellow.]
269	eol
270	[To enter complex data types, please use parenthesized form, like ];fixed:[(Array Int)];[.]
271	eol
272	var Link:(Index Str Address) td :> compute_tindex
273	var Str ttt:=""
274	table columns 3 border 0
275	cell
276	[Choose a type in the list]
277	cell
278	select "" (var Str tt) noeol
279	var Pointer:Address v :> td first
280	while addressof:v<>null
281	option (td key v) (td key v)
282	v :> td next v
283	cell
284	fixed:[  ]
285	cell
286	[... or enter it here]
287	cell
288	input "" ttt noeol
289	cell
290	button "See the description"
291	goto_url (shunt ttt="" tt ttt) no_extension
292	para
293	[Here is an indicative list of Pliant types: we list here the ones which are actually registered ]
294	[ in the ];fixed:[pliant_general_dictionary];[ and which are simple one (no type with name ]
295	[with a ];fixed:['('];[ is listed here).]
296	para
297	listtypes
298	else
299	var Pointer:Type t :> get_type tname
300	if addressof:t=null
301	title "Type [dq]"+tname+"[dq] unknown"
302	else
303	var Str source := t:position 0 (t:position search " " t:position:len)
304	title "Description of [dq]"+tname+"[dq] Data Type"
305	if source<>""
306	para
307	[The type [dq]]; text tname; [[dq] is defined in ]
308	link source source section "type "+t:name
309	[ module.]
310	var Pointer:List mb :> t maybe
311	var Pointer:Arrow c :> mb first
312	var Str mbt mbs
313	if c<>null
314	header "Maybe list"
315	text "Type "+t:name+" may be "
316	mbt := (c map Type):name
317	mbs := (c map Type):position
318	mbs := mbs 0 (mbs search " " mbs:len)
319	if mbs<>""
320	link mbt mbs section "type "+mbt
321	else
322	bold
323	text mbt
324	while {c :> mb next c; c<>null}
325	text ", "
326	mbt := (c map Type):name
327	mbs := (c map Type):position
328	mbs := mbs 0 (mbs search " " mbs:len)
329	if mbs<>""
330	link mbt mbs section "type "+mbt
331	else
332	bold
333	text mbt
334	header "Type description"
335	center
336	show_type t
337	header "Type methods"
338	show_methods t
339	header "Casts to "+tname
340	center
341	show_castto t
342	header "Casts from "+tname
343	center
344	show_castfrom t
345
346
347