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