/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org/packages/xpce/ Copyright (c) 2010, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(texinfo, [ texinfo_open/0, texinfo_open/1, texinfo_close/0, texinfo_class/1, texi/0, texi/1 ]). :- use_module(library(pce)). :- use_module(library(pce_manual)). :- require([ flush/0 , start_emacs/0 , append/3 , between/3 , format/1 , ignore/1 , is_list/1 , shell/1 , term_to_atom/2 ]). :- use_module(library(re_parse)). :- dynamic drain/1, % the output object (editor) class_needs_page/0, % flag to insert @page fetched_description/2, % cache for computed descriptions regex/2, % cache for created regular expr. no_inherit_description/3. % Forbit inheritance of description :- pce_global(@documented, new(chain)). % Chain with documented objects texinfo_class(Class) :- start('Class %s', Class?name), ( class_needs_page -> output('@page\n') ; assert(class_needs_page) ), label_object(Class), summary(Class, Summary), name_of(Class, ClassName), output('@class{%s}\n', ClassName), output('@section Class %s --- %s\n', [ClassName, Summary]), output('@ciindex %s\n\n', ClassName), cindex(Class), class_inheritance(Class), description(Class), output('\n'), instance_variables(Class), behaviour(Class), end, !. texinfo_class(_) :- trace, fail. summary(Obj, Summary) :- get(Obj, summary, Summary), Summary \== @nil, !. summary(_, ''). name_of(Obj, TeXInfoName) :- get(Obj, name, Name), texinfo_escape(Name, TeXInfoName). /******************************* * INHERITANCE/DELEGATION * *******************************/ class_inheritance(Class) :- output('@b{Inheritance:} '), show_inheritance(Class), output('\n'), ( get(Class, delegate, Chain), \+ send(Chain, empty) -> output('@b{Delegation:} '), show_delegation(Chain, 1) ; true ), output('\n'). show_inheritance(@nil) :- !, output('\n'). show_inheritance(Class) :- name_of(Class, ClassName), output('@result{} %s ', [ClassName]), get(Class, super_class, Super), show_inheritance(Super). show_delegation(Chain, N) :- get(Chain, nth1, N, Var), !, output('%s (%s)', [Var?name, Var?type?name]), ( get(Chain, tail, Var) -> output('\n') ; output(', '), NN is N + 1, show_delegation(Chain, NN) ). show_delegation(_, _) :- output('\n'). /******************************* * DESCRIPTION * *******************************/ excluded(Obj, InheritedFrom, _Description) :- no_inherit_description(Type, FromClass, Selector), send(Obj, instance_of, Type), get(Obj, name, Selector), send(InheritedFrom?context, is_a, FromClass). texi_description(@Obj, Description) :- fetched_description(Obj, Description), !. texi_description(Obj, Description) :- ( get(Obj, attribute, man_description, S0) ; get(Obj, man_attribute, description, S0) ; get(Obj, man_inherited_attribute, description, tuple(From, S0)), \+ excluded(Obj, From, S0) ; get(Obj, summary, S0) ; new(S0, string), send(S0, lock_object, @on) ), S0 \== @nil, !, Obj = @Ref, assert(fetched_description(Ref, S0)), Description = S0. :- pce_extend_class(object). texi_description(Obj, Description) :<- "Cached description slot for texinfo generation":: texi_description(Obj, Description). :- pce_end_class. description(Obj) :- texi_description(Obj, S0), get(S0, copy, S1), texinfo_description(S1), output('%s\n', S1). % to_regex(+Pattern, -Regex) % % Convert pattern to regex, maintaining a store of regex objects % to avoid unnecessary recompilation. We cannot blindly reuse % the regex as they are used recursively. to_regex(Pattern, Regex) :- retract(regex(Pattern, Regex)), !. to_regex(Pattern, Regex) :- get(@pce, convert, string(Pattern), regex, Regex), send(Regex, lock_object, @on), send(Regex, compile, @on). done_regex(Pattern, Regex) :- assert(regex(Pattern, Regex)). substitute(_, []) :- !. substitute(S, [Search, Replace | Rest]) :- to_regex(Search, Re), ( Replace = call(Head) -> Head =.. [Pred|Args], append(Args, [@arg1, @arg2], AllArgs), Msg =.. [message, @prolog, Pred | AllArgs], send(Re, for_all, S, Msg) ; send(Re, for_all, S, message(@arg1, replace, @arg2, string(Replace))) ), done_regex(Search, Re), substitute(S, Rest). texinfo_description(S) :- send(S, ensure_nl), substitute(S, ['\n\\s +\n', '\n\n']), % cannonise texinfo_escape(S), texinfo_lists(S), substitute(S, [ % HEADING '\n\n\\s *\\([A-Z ?!._-]+\\)\\s *\n\n', call(header), % uses \1 % ** SubHeader '\n\n\\*\\*+\\s +\\(.*\\)\n\n', '\n\n@subsubheading \\1\n\n', % *bold* '\\*\\([^ ]+\\)\\*', '@strong{\\1}' ]), send(S, strip). texinfo_lists(S) :- substitute(S, [ % 1) % 2) '\n\n+\\(\t\\sd+).*\\(\n\t.*\\|\n *\\)*\\)', call(enumerate), % aap noot % zus jet '\n\n\\(\\(\n*\t[^\t\n]+\t.*\n\\)+\\)', call(table), % * header % text '\n\n+\\(\t\\*.*\\(\n\t.*\\|\n *\\)*\\)', call(itemize), % # text % more text '\n\n+\\(\t#.*\\(\n\t.*\\|\n *\\)*\\)', call(description), % Indented by tabs % '\n\n+\\(\\(\n*\t.*\\)+\\)', % fails on regex 0.12 '\n+\\(\\(\n+\t.*\\)+\\)', call(example) ]). example(Re, String) :- get(Re, register_value, String, 1, S2), substitute(S2, ['^\t\\(.*\\)', '\\1']), send(S2, untabify, 4), send(S2, prepend, string('\n\n@example\n')), send(S2, append, string('@end example\n\n')), send(Re, register_value, String, S2). list(description, Re, String) :- get(Re, register_value, String, 1, L1), get(Re, register_value, String, 2, RestLines), substitute(RestLines, ['\n\t', '\n']), send(RestLines, strip, trailing), send(RestLines, ensure_nl), texinfo_lists(RestLines), % sub-lists send(RestLines, strip), send(RestLines, ensure_nl), send(RestLines, prepend, string('@item %s @*\n', L1)), send(Re, register_value, String, RestLines). list(itemize, Re, String) :- get(Re, register_value, String, 1, L1), get(Re, register_value, String, 2, RestLines), new(S0, string('\n%s%s', L1, RestLines)), substitute(S0, ['\n\t', '\n']), send(S0, strip, trailing), send(S0, ensure_nl), texinfo_lists(S0), % sub-lists send(S0, strip), send(S0, ensure_nl), send(S0, prepend, string('@item\n')), send(Re, register_value, String, S0). itemize(Re, String) :- get(Re, register_value, String, 1, S2), substitute(S2, [ '\n*\t\\*\\s *\\(.*\\)\\(\\(\n\t[^*].*\\|\n *\\)*\\)', call(list(itemize)) ]), send(S2, prepend, string('\n\n@itemize @bullet\n')), send(S2, ensure_nl), send(S2, append, string('@end itemize\n\n')), send(Re, register_value, String, S2). description(Re, String) :- get(Re, register_value, String, 1, S2), substitute(S2, [ '\n*\t#\\s *\\(.*\\)\\(\\(\n\t[^#].*\\|\n *\\)*\\)', call(list(description)) ]), send(S2, ensure_nl), send(S2, prepend, string('\n\n@itemize @bullet\n')), send(S2, append, string('@end itemize\n\n')), substitute(S2, ['@\\*\n@\\(item\\|end\\)', '\n@\\1']), send(Re, register_value, String, S2). enumerate(Re, String) :- get(Re, register_value, String, 1, S2), substitute(S2, [ '\n*\t\\sd+)\\s *\\(.*\\)\\(\\(\n\t[^0-9].*\\|\n *\\)*\\)', call(list(itemize)) ]), send(S2, ensure_nl), send(S2, prepend, string('\n\n@enumerate\n')), send(S2, append, string('@end enumerate\n\n')), send(Re, register_value, String, S2). table(Re, String) :- get(Re, register_value, String, 1, S2), texinfo_unescape(S2), tex_escape(S2), substitute(S2, [ '\n*\t\\([^\t]+\\)\t+\\(.*\\)\n', '\\1&\\2\\cr\n' ]), send(S2, prepend, string('\\halign{\\hskip\\tableindent#\\hfil&#\\hfil\\cr\n')), send(S2, prepend, string('\n\n@quotation\n@tex\n\\vskip 0.8ex\\tabskip 1em\n')), send(S2, append, string('}\n@end tex\n@end quotation\n\n')), send(Re, register_value, String, S2). header(Re, String) :- get(Re, register_value, String, 1, ALLCAPITALS), get(ALLCAPITALS, capitalise, Capitals), send(Re, register_value, String, string('@heading %s', Capitals), 1). /******************************* * ESCAPING * *******************************/ texinfo_escape(S) :- substitute(S, [ '@', '@@', '{', '@{', '}', '@}', '<->', '@botharrow{}', '->', '@sendarrow{}', '<-', '@getarrow{}' ]). texinfo_escape(In, Out) :- new(Out, string('%s', In)), texinfo_escape(Out). texinfo_identifier(S) :- substitute(S, [ '@', 'atsign' ]). texinfo_identifier(In, Out) :- new(Out, string('%s', In)), texinfo_identifier(Out). texinfo_unescape(S) :- substitute(S, [ '@@', '@', '@{', '{', '@}', '}', '@botharrow{}', '<->', '@sendarrow{}', '->', '@getarrow{}', '<-' ]). tex_escape(S) :- substitute(S, [ '\\$', '@@$@@', '\\\\', '$\\backslash$', '@@$@@','\\$', '@', '\\@', % for texinfo only '~', '$\\sim$', '\\^', '\\^~', '<->', '$\\leftrightarrow$', '->', '$\\rightarrow$', '<-', '$\\leftarrow$', '>', '$>$', '<', '$<$', '_', '\\_', '#', '\\#', '|', '$\\mid$', '%', '\\%', '&', '\\&', '{', '$\\lbrace$', '}', '$\\rbrace$' ]). tex_escape(In, Out) :- new(Out, string('%s', In)), tex_escape(Out). /******************************* * BEHAVIOUR * *******************************/ behaviour(Class) :- output('@subheading Behaviour\n\n'), collect_behaviour(Class, Chain), group_objects(Chain, Groups), send(Groups, for_all, message(@prolog, texinfo_group, Class, @arg1?name, @arg1?value)). collect_behaviour(Class, Behaviour) :- new(Behaviour, chain), new(Merge, message(Behaviour, append, @arg1)), send(Class?get_methods, for_all, Merge), send(Class?send_methods, for_all, Merge), send(Class?instance_variables, for_all, if(@arg1?context == Class, message(Behaviour, append, @arg1))), exclude(Class, Behaviour). group_objects(Chain, Groups) :- new(Groups, sheet), Group = when(@arg1?group, @arg1?group, behaviour), send(Chain, for_all, if(Group, if(message(Groups, is_attribute, Group), message(?(Groups, value, Group), append, @arg1), message(Groups, value, Group, ?(@pce, instance, chain, @arg1))), if(@arg1?message == @nil, message(@arg1, report, warning, 'Skipped %N: no group', @arg1)))), SortByName = ?(@arg1?name, compare, @arg2?name), order_groups(Groups), send(Groups?members, for_all, message(@arg1?value, sort, quote_function(SortByName))). texinfo_group(Class, Group, Elements) :- get(Group, capitalise, CGroup), ( group_summary(Group, Summary) -> output('@subsection %s --- %s\n\n', [CGroup, Summary]) ; output('@subsection %s\n\n', [CGroup]) ), output('@giindex %s\n', Group), ( group_description(Class, Group, S0) -> get(S0, copy, S1), texinfo_description(S1), output('%s\n\n', S1) ; true ), combine_behaviour(Elements, Clusters), send(Clusters, for_all, message(@prolog, texinfo_cluster, @arg1)). combine_behaviour(Chain, Combined) :- new(Combined, chain), send(Chain, for_all, and(assign(new(B, var), @arg1), or(and(assign(new(Ch, var), ?(Combined, find, message(@arg1?head?texi_description, equal, B?texi_description))), message(Ch, append, B)), message(Combined, append, ?(@pce, instance, chain, B))))). texinfo_cluster(Chain) :- send(@documented, merge, Chain), send(Chain, sort, ?(@prolog, compare_cluster_elements, @arg1?class_name, @arg2?class_name)), send(Chain, for_all, message(@prolog, label_object, @arg1)), send(Chain, for_all, and(if(@arg1 == Chain?head, message(@prolog, output, '@deffn '), message(@prolog, output, '@deffnx ')), message(@prolog, texinfo_behaviour, @arg1), message(@prolog, cindex, @arg1))), get(Chain, head, First), refinement_of(First), description(First), bugs(Chain), output('@end deffn\n\n'). compare_cluster_elements(X, X, equal). compare_cluster_elements(delegate_variable, _, smaller). compare_cluster_elements(variable, _, smaller). compare_cluster_elements(get_method, _, smaller). compare_cluster_elements(send_method, _, larger). compare_cluster_elements(X, _, _) :- format('[WARNING: compare_cluster_elements/3: Illegal first element ~w]~n', X), fail. refinement_of(M) :- send(M, has_get_method, inherited_from), get(M, inherited_from, SuperMethod), !, get(SuperMethod, man_name, S0), substitute(S0, ['.*\t', '']), output('@b{Refinement of:} %s @*', S0). refinement_of(_). bugs(Chain) :- get(Chain, map, ?(@arg1, man_attribute, bugs), Bugs), send(Bugs, unique), send(Bugs, for_all, message(@prolog, footnote, @arg1)). footnote(Text) :- new(S0, string('%s', Text)), texinfo_escape(S0), substitute(S0, [ '^\\s *[*#]', '@bullet ' ]), output('@footnote{%s}\n', S0). texinfo_behaviour(M) :- send(M, instance_of, send_method), !, get(M, name, Name), get(M, types, TypeVector), output('{Send Method} '), output(' %s ', Name), argument_vector(TypeVector), output('\n'), get(M?context, name, CName), texinfo_escape(Name, TeXName), texinfo_escape(CName, TeXCName), output('@biindex %s (@sendarrow{} %s)\n', [TeXName, TeXCName]). texinfo_behaviour(M) :- send(M, instance_of, get_method), !, get(M, name, Name), get(M, return_type, Type), get(M, types, TypeVector), output('{Get Method} '), output(' %s ', Name), argument_vector(TypeVector), output(' @result{'), type(Type), output('}\n'), output('@biindex %s (@getarrow %s)\n', [Name, M?context?name]). texinfo_behaviour(M) :- send(M, instance_of, variable), !, get(M, name, Name), get(M, type, Type), output('{Variable} '), output(' %s ', Name), type(Type), get(M, access_arrow, Arrow), new(SA, string(' (%s)', Arrow)), texinfo_escape(SA), % get arrows right output('%s', SA), ( get(M?context, resource, Name, Resource) -> get(Resource, string_value, String), get(Resource, resource_class_name, Class), new(R0, string(' [Pce.%s.%s: %s]', Class, Name, String)), texinfo_escape(R0), output('%s', R0) ; true ), get(M, access_arrow, ArrowName), texinfo_escape(ArrowName, TexInfoName), output('\n@biindex %s (%s %s)\n', [Name, TexInfoName, M?context?name]). cindex(Obj) :- get(Obj, attribute, ci_index, Concepts), !, send(Concepts, for_all, message(@prolog, write_cindex, @arg1)). cindex(_). write_cindex(Kwd) :- texinfo_escape(Kwd, S0), output('@cindex %s\n', S0). man_id(Obj, TheId) :- ( send(Obj, '_instance_of', function) -> get(Obj, '_man_id', Id) ; get(Obj, man_id, Id) ), new(S, string('%s', Id)), substitute(S, [ '\\\\==', ne, '@=', atsign ]), get(S, value, TheId). label_object(Obj) :- man_id(Obj, Id), texinfo_escape(Id, TeXId), output('@setref{%s}\n', TeXId). /******************************* * INSTANCE VARIABLES * *******************************/ instance_variables(Class) :- get(Class, instance_variables, Vector), new(Local, chain), new(Inherited, chain), send(Vector, for_all, if(@arg1?context == Class, message(Local, append, @arg1), message(Inherited, append, @arg1))), exclude(Class, Local), exclude(Class, Inherited), ( send(Local, empty), send(Inherited, empty) -> true ; output('@subheading Instance Variables\n\n'), ( \+ send(Local, empty) -> % output('@heading Locals\n\n'), texi_instance_variables(Local) ; true ), ( \+ send(Inherited, empty), fail % not sure -> output('@heading Inherited\n\n'), texi_instance_variables(Inherited) ; true ) ). parbox_column(Width) :- output('\\parbox{%s}{#}', [Width]). texi_instance_variables(Vars) :- group_objects(Vars, Groups), output('@tex\n\\vskip 1.5ex\n\\tabskip=1em\n'), output('\\halign{'), parbox_column('22ex'), output('&'), % name output('\\hfil#\\hfil&'), % access arrow parbox_column('30ex'), output('&'), % type parbox_column('45ex'), output('\\cr\n'), % type send(Groups, for_all, message(@prolog, texi_instance_variable_group, @arg1?name, @arg1?value)), output('}\n@end tex\n\n'). texi_instance_variable_group(Name, Vars) :- tex_escape(Name, S0), output('\\hskip -1em {\\bf %s}\\cr\n', [S0]), send(Vars, for_all, message(@prolog, texi_instance_variable_summary, @arg1)). texi_instance_variable_summary(Var) :- get(Var, name, Name), get(Var, access_arrow, AccessArrow), get(Var?type, name, Type), get(Var, summary, Summary), tex_escape(Name, S0), tex_escape(AccessArrow, S1), tex_escape(Type, S2), substitute(S2, [',', ',\\penalty0']), tex_escape(Summary, S3), output('\\mbox{%s}&%s&%s&%s\\cr\n', [S0, S1, S2, S3]). /******************************* * TYPE * *******************************/ type(Type) :- get(Type, name, Name), texinfo_escape(Name, S), output('%s', S). /******************************* * ARGUMENT VECTOR * *******************************/ argument_vector(V) :- get(V, size, Size), between(1, Size, Arg), get(V, element, Arg, Type), get(Type, name, TypeName), texinfo_escape(TypeName, TN), ( get(Type, argument_name, ArgName), ArgName \== @nil -> output('@var{%s}=%s', [ArgName, TN]) ; output('%s', TN) ), (Size \== Arg -> output(', ') ; true), fail ; true. /******************************* * GLOBAL OBJECTS * *******************************/ texinfo_global_objects :- start('Global Objects'), get(@manual, module, objects, @on, Module), new(Globals, chain), send(Module?id_table, for_all, message(Globals, append, @arg2)), send(Globals, sort, ?(@arg1?identifier, compare, @arg2?identifier)), send(Globals, for_all, if(not(message(@prolog, check_global, @arg1)), message(Globals, delete, @arg1))), combine_behaviour(Globals, Combined), send(Combined, for_all, message(@prolog, texinfo_global_cluster, @arg1)), end. check_global(Card) :- texi_description(Card, _), % has description? get(Card, identifier, Id), atom_concat('O.', Ref, Id), object(@Ref). % object exists texinfo_global_cluster(Cluster) :- send(Cluster, for_all, if(Cluster?head == @arg1, message(@prolog, global_deffn, @arg1, deffn), message(@prolog, global_deffn, @arg1, deffnx))), get(Cluster, head, Head), description(Head), output('@end deffn\n\n'). global_deffn(Card, Type) :- get(Card, identifier, Id), atom_concat('O.', Ref, Id), object(@Ref), label_object(@Ref), get(@Ref, '_class_name', ClassName), get(ClassName, capitalise, TypeName), output('@%s {%s} @@%s\n', [Type, TypeName, Ref]). /******************************* * OUTPUT SECTION * *******************************/ output(Format) :- output(Format, []). output(Format, Arg) :- \+ is_list(Arg), !, output(Format, [Arg]). output('%s\n', [String]) :- % HACK to avoid crash on long description !, drain(Obj), send(Obj, append, String), send(Obj, format, '\n'). output(Format, Args) :- drain(Obj), Term =.. [send, Obj, format, Format | Args], Term. texinfo_open(Obj) :- asserta(drain(Obj)). texinfo_close :- retract(drain(Obj)), ignore(pce_catch_error(no_behaviour, send(Obj, close))). start(Format) :- start(Format, []). start(Format, Arg) :- \+ is_list(Arg), !, start(Format, [Arg]). start(Format, Args) :- Term =.. [string, Format | Args], get(Term, value, Atom), format(' (~w', Atom), flush. end :- format(')'), flush. :- pce_global(@texinfo_view, make_texinfo_view). make_texinfo_view(V) :- new(V, view('TexInfo test view')), send(new(D, dialog), below, V), send(D, append, button(clear, message(V, clear))), send(D, append, button(quit, message(D, destroy))), send(V, open). texinfo_open :- send(@texinfo_view, open), texinfo_open(@texinfo_view). /******************************* * DEFINITION FILE * *******************************/ :- pce_global(@document, make_document). make_document(Sheet) :- new(Sheet, sheet), send(Sheet, append, attribute(group_list, new(chain))), send(Sheet, append, attribute(document_list, new(chain))), send(Sheet, append, attribute(group_summaries, new(hash_table))), send(Sheet, append, attribute(classes, new(hash_table))), load_definitions('manual.def'). % ACCESS PREDICATES document_class_properties(Class, Name, Properties) :- get(@document, value, classes, HashTable), get(HashTable, member, Class, Sheet), get(Sheet, value, Name, Properties). % exclude(+Class, +Object) % True if object is to be excluded from the class description exclude(Class, Object) :- document_class_properties(Class, exclude, Exclude), send(Exclude, member, Object). exclude(Class, Chain) :- document_class_properties(Class, exclude, Exclude), send(Chain, subtract, Exclude). % group_description(+Class, +Group, -String) group_description(Class, Group, String) :- document_class_properties(Class, group_descriptions, DescriptionSheet), get(DescriptionSheet, value, Group, String). group_summary(Group, Summary) :- get(@document?group_summaries, member, Group, Summary). % order_groups(Groups) % Order chain of groups order_groups(Sheet) :- get(@document, group_list, AllGroupsChain), get(Sheet, members, Chain), new(Unordered, chain), send(Chain, for_all, if(not(message(AllGroupsChain, member, @arg1?name)), and(message(@document, report, warning, 'No group named %s', @arg1?name), message(Unordered, append, @arg1), message(Chain, delete, @arg1)))), send(Chain, sort, message(AllGroupsChain, before, @arg1?name, @arg2?name)), send(Chain, merge, Unordered). % LOADING load_definitions(File) :- start('%s', File), new(F, file(File)), send(F, open, read), re_parse_loop(F, Re, A, global_pattern(F, Re, A), @nil), send(F, close), end. global_pattern(_, % blank line '\\s *$', true). global_pattern(_, % comment line '\\s *%', true). global_pattern(_, '#group\\s *\\(\\w+\\)\\s *"\\(.*\\)"\\s *$', def_group(1:name, 2)). global_pattern(F, '#class\\s *\\(.*\\)', def_class(F, 1:name)). global_pattern(F, '#chapter\\s +\\(.*\\)', def_chapter(F, 1)). global_pattern(F, '#texinfo\\s *', def_texinfo(F)). global_pattern(F, '#includealways\\s *\\(.*\\)', includealways(F, 1)). global_pattern(F, '#includeonly\\s *\\(.*\\)', includeonly(F, 1)). global_pattern(F, '#include\\s *\\([^ \n]*\\)', include(F, 1:name)). global_pattern(_, '#call\\s *\\(.*\\)', call_atom(1:name)). global_pattern(_, '#noinheritdescription\\s *\\(\\w+\\)\\s *\\(?\\)\\s *\\(\\w+\\)', def_no_inherit_description(1:name, 2:name, 3:name)). :- pce_global(@file_name_regex, new(regex('[a-zA-Z.#@%_+-]+'))). includealways(F, String) :- new(C, chain), send(@file_name_regex, for_all, String, message(C, append, ?(@file_name_regex, register_value, String)?value)), send(F, attribute, attribute(includealways, C)). includeonly(F, String) :- new(C, chain), send(@file_name_regex, for_all, String, message(C, append, ?(@file_name_regex, register_value, String)?value)), send(F, attribute, attribute(includeonly, C)). include(F, Name) :- ( get(F, attribute, includeonly, Only), ( ( send(Only, member, Name) ; get(F, attribute, includealways, Always), send(Always, member, Name) ) -> load_definitions(Name) ; true ) ; load_definitions(Name) ). map_arrow((->), send_method). map_arrow((<-), get_method). map_arrow((-), variable). def_no_inherit_description(ClassName, Access, Selector) :- map_arrow(Access, Type), assert(no_inherit_description(Type, ClassName, Selector)). call_atom(Atom) :- term_to_atom(Code, Atom), send(@document?document_list, append, Code). def_group(Name, Summary) :- send(@document?group_list, append, Name), send(@document?group_summaries, append, Name, Summary). def_texinfo(File) :- new(S, string), re_parse_loop(File, Re, A, description_pattern(S, Re, A), '#end\\s +texinfo'), send(@document?document_list, append, S). def_chapter(File, Title) :- new(S, string), re_parse_loop(File, Re, A, description_pattern(S, Re, A), '#end\\s +chapter'), texinfo_description(S), send(S, prepend, string('\n\n@node %s\n@chapter %s\n\n', Title, Title)), send(S, append, string('\n\n')), send(@document?document_list, append, S), send(@document?document_list, append, % HACK ... message(@prolog, retractall, class_needs_page)). def_class(File, ClassName) :- get(@pce, convert, ClassName, class, Class), send(@document?document_list, append, Class), send(@document?classes, append, Class, sheet(attribute(exclude, new(chain)), attribute(group_descriptions, new(sheet)))), re_parse_loop(File, Re, A, class_pattern(File, Class, Re, A), '#end\\s +class'). class_pattern(_, _, % blank line '\\s *$', true). class_pattern(_, _, % comment line '\\s *%', true). class_pattern(_, Class, '#exclude\\s +->\\(\\w+\\)\\s *$', class_exclude(Class, send_method, 1:name)). class_pattern(_, Class, '#exclude\\s +<-\\(\\w+\\)\\s *$', class_exclude(Class, get_method, 1:name)). class_pattern(File, Class, '#description\\s +group\\s +\\(.*\\)', class_group_description(File, Class, 1:name)). class_pattern(File, Class, '#description\\s *\\(<-\\|->\\|-\\)\\(\\w+\\)', class_behaviour_description(File, Class, 1:name, 2:name)). class_pattern(File, Class, '#description\\s *$', class_description(File, Class)). class_exclude(Class, Type, Name) :- get(Class, Type, Name, Method), get(@document, classes, Classes), get(Classes, member, Class, Sheet), get(Sheet, value, exclude, Chain), send(Chain, add, Method). class_group_description(File, Class, Group) :- new(S, string), re_parse_loop(File, Re, A, description_pattern(S, Re, A), '#end\\s +description'), get(@document, classes, Classes), get(Classes, member, Class, Sheet), get(Sheet, value, group_descriptions, DescriptionSheet), send(DescriptionSheet, value, Group, S). % #description % #end description class_description(File, Class) :- new(S, string), re_parse_loop(File, Re, A, description_pattern(S, Re, A), '#end\\s +description'), send(Class, attribute, attribute(man_description, S)). % #description -|<-|->selector % #end description class_behaviour_description(File, Class, Arrow, Name) :- new(S, string), arrow_behaviour(Arrow, BehaviourType), ( get(Class, BehaviourType, Name, Behaviour) -> re_parse_loop(File, Re, A, description_pattern(S, Re, A), '#end\\s +description'), send(Behaviour, attribute, attribute(man_description, S)) ; send(Class, report, warning, 'Cannot find %s %s', BehaviourType, Name) ). arrow_behaviour(-, instance_variable). arrow_behaviour('<-', get_method). arrow_behaviour('->', send_method). description_pattern(S, '.*\n', send(S, append, 0)). /******************************* * GROUP SUMMARY * *******************************/ group_summary :- start('Group summary'), group_objects(@documented, Groups), send(Groups?members, sort, ?(@arg1?name, compare, @arg2?name)), send(Groups, for_all, message(@prolog, texi_group_summary, @arg1?name, @arg1?value)), end. texi_group_summary(Name, Objects) :- start(Name), ( group_summary(Name, Description) -> output('\n@section %s --- %s\n\n', [Name, Description]) ; output('\n@section %s\n\n', [Name]) ), send(Objects, sort, ?(@prolog, compare_group_members, @arg1, @arg2)), output('@tex\n\\vskip 1.5ex\n\\tabskip=0.2em\n'), output('\\def\\ibox#1{\\vtop{\\hsize 2em\\hfil#1\\hfil}}\n'), output('\\def\\nbox#1{\\vtop{\\hsize 3em\\hfill#1}}\n'), output('\\halign{\\ibox{#}&'), % identifier parbox_column('35ex'), output('&'), % name parbox_column('50ex'), output('&'), % summary output('\\nbox{#}\\cr\n'), % page number send(Objects, for_all, message(@prolog, object_summary, @arg1)), output('}\n@end tex\n\n'), end. compare_group_members(O1, O2, Result) :- get(O1?name, compare, O2?name, Result), Result \== equal, !. compare_group_members(O1, O2, Result) :- get(O1?context?name, compare, O2?context?name, Result), Result \== equal, !. compare_group_members(O1, O2, Result) :- get(O1, class_name, C1), get(O2, class_name, C2), compare_cluster_elements(C1, C2, Result). object_summary(Obj) :- get(Obj, man_indicator, Id), ( get(Obj, summary, Summary) -> true ; Summary = '(undocumented)' ), get(Obj, name, Name), get(Obj, access_arrow, Arrow), get(Obj?context, name, ClassName), man_id(Obj, Identifier), tex_escape(Name, S1), tex_escape(Arrow, S2), tex_escape(ClassName, S3), tex_escape(Summary, S4), texinfo_identifier(Identifier, S5), output('%s&\\mbox{%s} (%s%s)&%s&\\pageref{%s}\\cr\n', [Id, S1, S2, S3, S4, S5]). /******************************** * SETTING VARIABLES * ********************************/ texi_set_version :- % @set version 4.5.8 get(@pce, version, Version), new(V, string('%s', Version)), substitute(V, [',.*', '']), output('@set version %s\n', V). texi_set_month :- % @set update-month July 1993 get(@pce, version, Version), new(V, string('%s', Version)), substitute(V, ['[^,]*,\\s *', '']), output('@set update-month %s\n', V). /******************************* * KEYWORDS (CONCEPT INDEX) * *******************************/ attach_keywords :- start('keywords'), get(@manual, module, keywords, @on, Module), send(Module?id_table, for_all, message(@prolog, attach_keyword, @arg2)), end. attach_keyword(Card) :- get(Card, related, see_also, Objects), new(Synonyms, chain(Card?name)), new(IsKwd, message(@arg1, instance_of, man_keyword_card)), send(Objects, for_all, if(IsKwd, message(Synonyms, add, @arg1?name))), get(Synonyms, map, when(message(@arg1, suffix, '*'), ?(@arg1, delete_suffix, '*'), @arg1?self), S2), send(S2, unique), send(Objects, for_all, if(not(IsKwd), if(message(@prolog, add_ci_index, @arg1?object, S2)))). add_ci_index(Obj, Concepts) :- get(Obj, attribute, ci_index, Chain), !, send(Chain, union, Concepts). add_ci_index(Obj, Concepts) :- send(Obj, attribute, attribute(ci_index, Concepts)). /******************************* * CHECKING * *******************************/ check_documented_all_classes :- get(@document, document_list, List), check_documented_all_classes(List). check_documented_all_classes(List) :- get(List, map, when(message(@arg1, instance_of, class), @arg1), DocumentedClasses), new(AllClasses, chain), send(@classes, for_all, if(@arg2?creator == built_in, message(AllClasses, append, @arg2))), send(AllClasses, subtract, DocumentedClasses), ( send(AllClasses, empty) -> true ; format('[WARNING: Undocumented classes:~n'), send(AllClasses, for_all, message(@pce, format, '\t%s\n', @arg1?name)) ). /******************************* * TOPLEVEL * *******************************/ texi(ClassName) :- get(@pce, convert, ClassName, class, Class), make_preview_view(V), send(V, label, string('TexInfo for %s %s', Class?class_name, Class?name)), send(V, confirm_done, @off), generate(V, chain(Class)), send(V, open). texi :- make_preview_view(V), free(@document), get(@document, document_list, ClassList), generate(V, ClassList). make_preview_view(V) :- new(V, view(string('TexInfo for XPCE reference manual'))), send(new(D, dialog), below, V), send(D, append, new(label)), % report messages send(D, append, button(generate, message(@prolog, generate, V))), send(D, append, button('TeX', message(@prolog, tex, V))), send(D, append, button('TeX Index', message(@prolog, texindex, V))), send(D, append, button(preview, message(@prolog, preview, V))), send(D, append, button(quit, message(D?frame, destroy))), send(V, open). generate(V, Classes) :- send(V, attribute, attribute(document_list, Classes)), retractall(fetched_description(_,_)), free(@documented), generate(V). generate(V) :- get(V, document_list, Document), texinfo_open(V), send(V, clear), attach_keywords, Class = ?(@pce, convert, @arg1, class), send(Document, for_all, if(message(@arg1, instance_of, char_array), message(@prolog, output, '%s', @arg1), if(message(@arg1, instance_of, code), message(@arg1, forward), or(message(@prolog, texinfo_class, Class), message(Class, report, warning, 'Failed for make texinfo'))))), output('@bye\n'), send(V, save, 'refman.texinfo'), send(V, caret, 0), texinfo_close. tex(V) :- send(V, save), get(string('tex %s', V?file?name), value, Cmd), unix(Cmd). texindex(V) :- get(V?file, name, Path), atom_concat(Base, '.texinfo', Path), get(string('texindex %s.??', Base), value, Cmd), shell(Cmd). preview(V) :- get(V?file, name, Path), atom_concat(Base, '.texinfo', Path), get(string('xdvi %s &', Base), value, Cmd), shell(Cmd). unix(Command) :- start_emacs, new(P, process('/bin/sh', '-c', Command)), new(B, emacs_process_buffer(P, string('*%s*', Command))), send(B, open), send(B, start_process).