1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        jan@swi.psy.uva.nl
5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6    Copyright (c)  2000-2014, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(xml_browse, []).
36:- use_module(library(pce)).
37:- use_module(library('doc/load')).
38:- use_module(library('doc/xml_hierarchy')).
39:- use_module(library(pprint)).
40:- use_module(library(toolbar)).
41:- use_module(library(pce_report)).
42:- use_module(library(find_file)).
43
44:- pce_global(@finder, new(finder)).
45
46:- multifile
47    doc:caption/2.
48
49:- pce_begin_class(xml_browser, frame,
50                   "Browse XML document").
51
52initialise(B, XML:[prolog]) :->
53    send_super(B, initialise, 'XML structure browser'),
54    send(B, append, new(D, tool_dialog(B))),
55    send(B, fill_dialog(D)),
56    new(H, xml_browse_hierarchy(XML)),
57    send(new(doc_window), right, H),
58    send(H, below, D),
59    send(new(report_dialog), below, H).
60
61fill_dialog(B, D:tool_dialog) :->
62    send_list(D, append,
63              [ new(F, popup(file)),
64                new(V, popup(view)),
65                new(S, popup(search)),
66                new(H, popup(help))
67              ]),
68    send_list(F, append,
69              [ menu_item(open_file,
70                          message(B, open_file)),
71                gap,
72                menu_item(exit,
73                          message(B, destroy))
74              ]),
75    send_list(V, append,
76              [ menu_item(dom,
77                          message(B, view_dom),
78                          'DOM')
79              ]),
80    send_list(S, append,
81              [ menu_item(find_elements,
82                          message(B, search))
83              ]),
84    send_list(H, append,
85              [ menu_item(about,
86                          message(B, about))
87              ]).
88
89
90xml(B, XML:prolog) :->
91    get(B, member, doc_window, DW),
92    send(DW, clear),
93    get(B, member, xml_browse_hierarchy, H),
94    send(H, xml, XML).
95
96show_xml(B, Tokens:prolog) :->
97    "Show parsed XML in browser"::
98    get(B, member, doc_window, DW),
99    send(DW, show, Tokens).
100
101:- pce_group(action).
102
103open_file(B) :->
104    "Open SGML/XML/HTML file"::
105    get(@finder, file, open,
106        chain(tuple('HTML files', chain(html,htm)),
107              tuple('XML files', xml),
108              tuple('SGML files', chain(sgml,sgm)),
109              tuple('All files', '*')),
110        FileName),
111    file_name_extension(_, Ext, FileName),
112    dialect(Ext, Dialect),
113    (   Dialect == html
114    ->  load_html_file(FileName, DOM)
115    ;   load_structure(FileName, DOM,
116                       [ dialect(Dialect)
117                       ])
118    ),
119    send(B, xml, DOM).
120
121dialect(html, html).
122dialect(htm,  html).
123dialect(xml,  xml).
124dialect(sgml, sgml).
125dialect(sgm,  sgml).
126
127about(_B) :->
128    send(@display, inform,
129         'Visualise HTML/XML/SGML DOM structure\n\c
130              as produced by library(sgml)\n\n\c
131              By Jan Wielemaker\n\c
132              jan@swi.psy.uva.nl').
133
134view_dom(B) :->
135    get(B, member, xml_browse_hierarchy, H),
136    get_chain(H, selection, Selection),
137    (   Selection == []
138    ->  send(B, report, warning, 'No selection')
139    ;   new(V, view),
140        pce_open(V, write, Fd),
141        forall(member(Node, Selection),
142               (   get(Node, xml, DOM),
143                   print_term(DOM,
144                              [ output(Fd),
145                                right_margin(78)
146                              ])
147               )),
148        close(Fd),
149        send(V, caret, 0),
150        send(V, open)
151    ).
152
153search(B) :->
154    "Search the hierarchy"::
155    new(D, dialog('Search DOM')),
156    send(D, append, new(T, text_item(text))),
157    send(D, append, new(E, text_item(element))),
158    send(D, append, new(A, text_item(attribute))),
159    send(D, append, new(V, text_item(value))),
160    send(D, append, button(search, message(B, search_for,
161                                           T?selection,
162                                           E?selection,
163                                           A?selection,
164                                           V?selection))),
165    send(D, append, button(done, message(D, destroy))),
166    send(D, default_button(search)),
167    send(D, transient_for, B),
168    send(D, open_centered, B?area?center).
169
170search_for(B,
171           Text0:name,
172           Element0:name,
173           Attribute0:name,
174           Value0:name) :->
175    "Execute search"::
176    mkvar(Text0, Text),
177    mkvar(Element0, Element),
178    mkvar(Attribute0, Attribute),
179    mkvar(Value0, Value),
180    (   var(Attribute),
181        var(Value)
182    ->  true
183    ;   A = (Attribute = Value)
184    ),
185    get(B, member, xml_browse_hierarchy, H),
186    get(H, root, Root),
187    send(Root, collapsed, @on),
188    send(H, selection, @nil),
189    get(H, xml, DOM),
190    findall(Node, find_node(B, DOM, Element, A, Text, Node), Nodes),
191    (   Nodes == []
192    ->  send(B, report, warning, 'No match')
193    ;   length(Nodes, Len),
194        send(B, report, status, 'Found %d matching elements', Len),
195        send(H, normalise, Nodes)
196    ).
197
198mkvar('', _) :- !.
199mkvar(X, X).
200
201find_node(B, DOM, E, A, T, Node) :-
202    find(DOM, E, A, T, Path),
203    get(B, member, xml_browse_hierarchy, H),
204    get(H, node_from_path, Path, Node),
205    send(Node, selected, @on).
206
207find(element(E, AL, Content), E, A, Text, []) :-
208    (   var(A)
209    ->  true
210    ;   memberchk(A, AL)
211    ),
212    (   var(Text)
213    ->  true
214    ;   member(Atom, Content),
215        atom(Atom),
216        sub_atom(Atom, _, _, _, Text)
217    ->  true
218    ).
219find(element(_, _, Content), E, A, Text, [N|T]) :-
220    nth_element(N, Content, Sub),
221    find(Sub, E, A, Text, T).
222
223%       nth_element(-N, +List, -Element)
224%
225%       As nth1/3, but only counts the element(_,_,_) terms in the
226%       list.
227
228nth_element(N, Content, E) :-
229    nth_element(Content, E, 1, N).
230
231nth_element([Elem|_], Elem, Base, Base) :-
232    Elem = element(_,_,_).
233nth_element([H|Tail], Elem, N, Base) :-
234    (   H = element(_,_,_)
235    ->  succ(N, M)
236    ;   M = N
237    ),
238    nth_element(Tail, Elem, M, Base).
239
240:- pce_end_class(xml_browser).
241
242                 /*******************************
243                 *            HIERARCHY         *
244                 *******************************/
245
246:- pce_begin_class(xml_browse_hierarchy, xml_hierarchy,
247                   "Browse an XML hierarchy").
248
249select_node(H, Node:xml_node) :->
250    "Show content of selected node"::
251    get(Node, xml, Tokens),
252    send(H?frame, show_xml, Tokens).
253
254caption(H, XML:prolog, Caption:name) :<-
255    "Provide caption"::
256    (   doc:caption(XML, Caption)
257    ->  true
258    ;   get_super(H, caption, XML, Caption)
259    ->  true
260    ;   XML=[_|_]
261    ->  Caption = '<Elements>'
262    ;   Caption = '??'
263    ).
264
265:- pce_end_class.
266
267