/pliant/language/basic/plugin.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
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/debug/compile_log.pli"
17	module "/pliant/install/ring2.pli"
18
19	constant advanced true
20	constant trace true
21
22
23	function file_database_pick filename path -> value
24	arg Str filename path value
25	value := ""
26	var Int h := file_open pliant_root_path+".."+filename 1
27	if h=(-1)
28	return
29	var Str char := " "
30	var Str line := ""
31	while (file_read h char:characters 1)=1
32	if char="[lf]"
33	var Int i := line search "path=[dq]" -1
34	if i<>(-1)
35	i := i+6
36	var Int j := i+((line i line:len) search "[dq]" -1)
37	if j>=i and (line i j-i)=path
38	var Int k := line search ">" -1
39	if k<>(-1)
40	k := k+1
41	var Int l := k+((line k line:len) search "<" -1)
42	if l>=k
43	file_close h
44	value := line k l-k
45	line := ""
46	else
47	line := line+char
48	file_close h
49
50	gvar Dictionary modules
51	gvar Str computer_name
52	gvar Str computer_domain
53	gvar Str computer_fullname
54
55	computer_name := file_database_pick "/pliant_security/this_computer.pdb" "/env/pliant/identity/name"
56	computer_domain := file_database_pick "/pliant_security/this_computer.pdb" "/env/pliant/identity/domain"
57	if computer_domain<>""
58	computer_fullname := computer_name+"."+computer_domain
59	else
60	computer_fullname := computer_name
61
62
63	meta custom e
64	if e:size<>2 or not e:0:is_pure_ident
65	return
66	var Str name := e:module:name
67	if (name 0 8)<>"/custom/"
68	return
69	name := name 8 name:len
70	var Int i := name search "/" -1
71	if i=(-1)
72	return
73	name := name i name:len
74	name := name 0 (name search " (" name:len)
75	var Pointer:Arrow c :> modules first name
76	if c=null
77	return
78	var Pointer:Dictionary d :> c map Dictionary
79	if advanced
80	var Link:PackedExpression p :> e 1
81	d insert e:0:ident true addressof:p
82	else
83	d insert e:0:ident true (addressof e:1)
84	e set_void_result
85
86
87	function the_plugin name id -> e
88	arg Str name id ; arg Link:Expression e
89	var Pointer:Arrow c :> modules first name
90	if c=null
91	modules insert name true (addressof new:Dictionary)
92	c :> modules first name
93	pliant_load_module "/custom/universal"+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
94	if computer_domain<>""
95	pliant_load_module "/custom/"+computer_domain+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
96	if computer_fullname<>""
97	pliant_load_module "/custom/"+computer_fullname+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
98	var Pointer:Dictionary d :> c map Dictionary
99	c :> d first id
100	if c<>null
101	if advanced
102	e :> c map PackedExpression
103	else
104	e :> c map Expression
105	else
106	e :> null map Expression
107
108	method e switch_module m
109	arg_rw Expression e ; arg Module m
110	e module :> m
111	for (var Int i) 0 e:size-1
112	e:i switch_module m
113
114	meta plugin e
115	if e:size<1 or e:size>2 or not e:0:is_pure_ident
116	return
117	var Str name := e:module:name
118	name := name 0 (name search " (" name:len)
119	var Link:Expression p :> the_plugin name e:0:ident
120	if addressof:p<>null
121	if trace
122	compile_log "applying plugin "+name+" "+e:0:ident
123	p switch_module e:module
124	p compile
125	if p:is_compiled
126	e suckup p
127	e set_result p:result p:access
128	eif e:size=1
129	e set_void_result
130	else
131	e:1:compile
132	if e:1:is_compiled
133	e suckup e:1
134	e set_result e:1:result e:1:access
135
136
137	export custom plugin