35
36:- module(pldoc_latex,
37 [ doc_latex/3, 38 latex_for_file/3, 39 latex_for_wiki_file/3, 40 latex_for_predicates/3 41 ]). 42:- use_module(library(pldoc)). 43:- use_module(library(readutil)). 44:- use_module(library(error)). 45:- use_module(library(apply)). 46:- use_module(library(option)). 47:- use_module(library(lists)). 48:- use_module(library(debug)). 49:- use_module(pldoc(doc_wiki)). 50:- use_module(pldoc(doc_process)). 51:- use_module(pldoc(doc_modes)). 52:- use_module(library(pairs), [pairs_values/2]). 53:- use_module(library(prolog_source), [file_name_on_path/2]). 54:- use_module(library(prolog_xref), [xref_hook/1]). 55:- use_module(pldoc(doc_html), 56 [ doc_file_objects/5, 57 unquote_filespec/2,
58 doc_tag_title/2,
59 existing_linked_file/2,
60 pred_anchor_name/3,
61 private/2,
62 (multifile)/2,
63 is_pi/1,
64 is_op_type/2
65 ]). 66
87
88:- predicate_options(doc_latex/3, 3,
89 [ stand_alone(boolean),
90 public_only(boolean),
91 section_level(oneof([section,subsection,subsubsection])),
92 summary(atom)
93 ]). 94:- predicate_options(latex_for_file/3, 3,
95 [ stand_alone(boolean),
96 public_only(boolean),
97 section_level(oneof([section,subsection,subsubsection]))
98 ]). 99:- predicate_options(latex_for_predicates/3, 3,
100 [ 101 ]). 102:- predicate_options(latex_for_wiki_file/3, 3,
103 [ stand_alone(boolean),
104 public_only(boolean),
105 section_level(oneof([section,subsection,subsubsection]))
106 ]). 107
108
109:- thread_local
110 options/1,
111 documented/1. 112
113current_options(Options) :-
114 options(Current),
115 !,
116 Options = Current.
117current_options([]).
118
154
155doc_latex(Spec, OutFile, Options) :-
156 load_urldefs,
157 merge_options(Options,
158 [ include_reexported(true)
159 ],
160 Options1),
161 retractall(documented(_)),
162 setup_call_cleanup(
163 asserta(options(Options), Ref),
164 phrase(process_items(Spec, [body], Options1), Tokens),
165 erase(Ref)),
166 setup_call_cleanup(
167 open(OutFile, write, Out),
168 print_latex(Out, Tokens, Options1),
169 close(Out)),
170 latex_summary(Options).
171
172process_items([], Mode, _) -->
173 !,
174 pop_mode(body, Mode, _).
175process_items([H|T], Mode, Options) -->
176 process_items(H, Mode, Mode1, Options),
177 process_items(T, Mode1, Options).
178process_items(Spec, Mode, Options) -->
179 {Mode = [Mode0|_]},
180 process_items(Spec, Mode, Mode1, Options),
181 pop_mode(Mode0, Mode1, _).
182
183process_items(PI, Mode0, Mode, Options) -->
184 { is_pi(PI) },
185 !,
186 need_mode(description, Mode0, Mode),
187 latex_tokens_for_predicates(PI, Options).
188process_items(FileSpec, Mode0, Mode, Options) -->
189 { ( absolute_file_name(FileSpec,
190 [ file_type(source),
191 access(read),
192 file_errors(fail)
193 ],
194 File)
195 -> true
196 ; absolute_file_name(FileSpec,
197 [ access(read)
198 ],
199 File)
200 ),
201 file_name_extension(_Base, Ext, File)
202 },
203 need_mode(body, Mode0, Mode),
204 ( { user:prolog_file_type(Ext, prolog) }
205 -> latex_tokens_for_file(File, Options)
206 ; latex_tokens_for_wiki_file(File, Options)
207 ).
208
209
216
217latex_for_file(FileSpec, Out, Options) :-
218 load_urldefs,
219 phrase(latex_tokens_for_file(FileSpec, Options), Tokens),
220 print_latex(Out, Tokens, Options).
221
222
224
225latex_tokens_for_file(FileSpec, Options, Tokens, Tail) :-
226 absolute_file_name(FileSpec,
227 [ file_type(prolog),
228 access(read)
229 ],
230 File),
231 doc_file_objects(FileSpec, File, Objects, FileOptions, Options),
232 asserta(options(Options), Ref),
233 call_cleanup(phrase(latex([ \file_header(File, FileOptions)
234 | \objects(Objects, FileOptions)
235 ]),
236 Tokens, Tail),
237 erase(Ref)).
238
239
246
247latex_for_wiki_file(FileSpec, Out, Options) :-
248 load_urldefs,
249 phrase(latex_tokens_for_wiki_file(FileSpec, Options), Tokens),
250 print_latex(Out, Tokens, Options).
251
252latex_tokens_for_wiki_file(FileSpec, Options, Tokens, Tail) :-
253 absolute_file_name(FileSpec, File,
254 [ access(read)
255 ]),
256 read_file_to_codes(File, String, []),
257 b_setval(pldoc_file, File),
258 asserta(options(Options), Ref),
259 call_cleanup((wiki_codes_to_dom(String, [], DOM),
260 phrase(latex(DOM), Tokens, Tail)
261 ),
262 (nb_delete(pldoc_file),
263 erase(Ref))).
264
265
272
273latex_for_predicates(Spec, Out, Options) :-
274 load_urldefs,
275 phrase(latex_tokens_for_predicates(Spec, Options), Tokens),
276 print_latex(Out, [nl_exact(0)|Tokens], Options).
277
278latex_tokens_for_predicates([], _Options) --> !.
279latex_tokens_for_predicates([H|T], Options) -->
280 !,
281 latex_tokens_for_predicates(H, Options),
282 latex_tokens_for_predicates(T, Options).
283latex_tokens_for_predicates(PI, Options) -->
284 { generic_pi(PI),
285 !,
286 ( doc_comment(PI, Pos, _Summary, Comment)
287 -> true
288 ; Comment = ''
289 )
290 },
291 object(PI, Pos, Comment, [description], _, Options).
292latex_tokens_for_predicates(Spec, Options) -->
293 { findall(PI, documented_pi(Spec, PI, Options), List),
294 ( List == []
295 -> print_message(warning, pldoc(no_predicates_from(Spec)))
296 ; true
297 )
298 },
299 latex_tokens_for_predicates(List, Options).
300
301documented_pi(Spec, PI, Options) :-
302 option(modules(List), Options),
303 member(M, List),
304 generalise_spec(Spec, PI, M),
305 doc_comment(PI, _Pos, _Summary, _Comment),
306 !.
307documented_pi(Spec, PI, Options) :-
308 option(module(M), Options),
309 generalise_spec(Spec, PI, M),
310 doc_comment(PI, _Pos, _Summary, _Comment),
311 !.
312documented_pi(Spec, PI, _Options) :-
313 generalise_spec(Spec, PI, _),
314 doc_comment(PI, _Pos, _Summary, _Comment).
315
316generic_pi(Module:Name/Arity) :-
317 atom(Module), atom(Name), integer(Arity),
318 !.
319generic_pi(Module:Name//Arity) :-
320 atom(Module), atom(Name), integer(Arity).
321
322generalise_spec(Name/Arity, M:Name/Arity, M).
323generalise_spec(Name//Arity, M:Name//Arity, M).
324
325
326 329
330:- thread_local
331 fragile/0. 332
333latex([]) -->
334 !,
335 [].
336latex(Atomic) -->
337 { string(Atomic),
338 atom_string(Atom, Atomic),
339 sub_atom(Atom, 0, _, 0, 'LaTeX')
340 },
341 !,
342 [ latex('\\LaTeX{}') ].
343latex(Atomic) --> 344 { atomic(Atomic),
345 !,
346 atom_string(Atom, Atomic),
347 findall(x, sub_atom(Atom, _, _, _, '\n'), Xs),
348 length(Xs, Lines)
349 },
350 ( {Lines == 0}
351 -> [ Atomic ]
352 ; [ nl(Lines) ]
353 ).
354latex(List) -->
355 latex_special(List, Rest),
356 !,
357 latex(Rest).
358latex(w(Word)) -->
359 [ Word ].
360latex([H|T]) -->
361 !,
362 ( latex(H)
363 -> latex(T)
364 ; { print_message(error, latex(failed(H))) },
365 latex(T)
366 ).
367
369latex(h1(Attrs, Content)) -->
370 latex_section(0, Attrs, Content).
371latex(h2(Attrs, Content)) -->
372 latex_section(1, Attrs, Content).
373latex(h3(Attrs, Content)) -->
374 latex_section(2, Attrs, Content).
375latex(h4(Attrs, Content)) -->
376 latex_section(3, Attrs, Content).
377latex(p(Content)) -->
378 [ nl_exact(2) ],
379 latex(Content).
380latex(blockquote(Content)) -->
381 latex(cmd(begin(quote))),
382 latex(Content),
383 latex(cmd(end(quote))).
384latex(center(Content)) -->
385 latex(cmd(begin(center))),
386 latex(Content),
387 latex(cmd(end(center))).
388latex(a(Attrs, Content)) -->
389 { attribute(href(HREF), Attrs) },
390 ( {HREF == Content}
391 -> latex(cmd(url(url_escape(HREF))))
392 ; { atom_concat(#,Sec,HREF) }
393 -> latex([Content, ' (', cmd(secref(Sec)), ')'])
394 ; latex(cmd(href(url_escape(HREF), Content)))
395 ).
396latex(br(_)) -->
397 latex(latex(\\)).
398latex(hr(_)) -->
399 latex(cmd(hrule)).
400latex(code(CodeList)) -->
401 { is_list(CodeList),
402 !,
403 atomic_list_concat(CodeList, Atom)
404 },
405 ( {fragile}
406 -> latex(cmd(const(Atom)))
407 ; [ verb(Atom) ]
408 ).
409latex(code(Code)) -->
410 { identifier(Code) },
411 !,
412 latex(cmd(const(Code))).
413latex(code(Code)) -->
414 ( {fragile}
415 -> latex(cmd(const(Code)))
416 ; [ verb(Code) ]
417 ).
418latex(b(Code)) -->
419 latex(cmd(textbf(Code))).
420latex(strong(Code)) -->
421 latex(cmd(textbf(Code))).
422latex(i(Code)) -->
423 latex(cmd(textit(Code))).
424latex(var(Var)) -->
425 latex(cmd(arg(Var))).
426latex(pre(_Class, Code)) -->
427 [ nl_exact(2), code(Code), nl_exact(2) ].
428latex(ul(Content)) -->
429 { if_short_list(Content, shortlist, itemize, Env) },
430 latex(cmd(begin(Env))),
431 latex(Content),
432 latex(cmd(end(Env))).
433latex(ol(Content)) -->
434 latex(cmd(begin(enumerate))),
435 latex(Content),
436 latex(cmd(end(enumerate))).
437latex(li(Content)) -->
438 latex(cmd(item)),
439 latex(Content).
440latex(dl(_, Content)) -->
441 latex(cmd(begin(description))),
442 latex(Content),
443 latex(cmd(end(description))).
444latex(dd(_, Content)) -->
445 latex(Content).
446latex(dd(Content)) -->
447 latex(Content).
448latex(dt(class=term, \term(Text, Term, Bindings))) -->
449 termitem(Text, Term, Bindings).
450latex(dt(Content)) -->
451 latex(cmd(item(opt(Content)))).
452latex(table(Attrs, Content)) -->
453 latex_table(Attrs, Content).
454latex(\Cmd, List, Tail) :-
455 call(Cmd, List, Tail).
456
458latex(latex(Text)) -->
459 [ latex(Text) ].
460latex(cmd(Term)) -->
461 { Term =.. [Cmd|Args] },
462 indent(Cmd),
463 [ cmd(Cmd) ],
464 latex_arguments(Args),
465 outdent(Cmd).
466
467indent(begin) --> !, [ nl(2) ].
468indent(end) --> !, [ nl_exact(1) ].
469indent(section) --> !, [ nl(2) ].
470indent(subsection) --> !, [ nl(2) ].
471indent(subsubsection) --> !, [ nl(2) ].
472indent(item) --> !, [ nl(1), indent(4) ].
473indent(definition) --> !, [ nl(1), indent(4) ].
474indent(tag) --> !, [ nl(1), indent(4) ].
475indent(termitem) --> !, [ nl(1), indent(4) ].
476indent(prefixtermitem) --> !, [ nl(1), indent(4) ].
477indent(infixtermitem) --> !, [ nl(1), indent(4) ].
478indent(postfixtermitem) --> !, [ nl(1), indent(4) ].
479indent(predicate) --> !, [ nl(1), indent(4) ].
480indent(dcg) --> !, [ nl(1), indent(4) ].
481indent(infixop) --> !, [ nl(1), indent(4) ].
482indent(prefixop) --> !, [ nl(1), indent(4) ].
483indent(postfixop) --> !, [ nl(1), indent(4) ].
484indent(predicatesummary) --> !,[ nl(1) ].
485indent(dcgsummary) --> !, [ nl(1) ].
486indent(oppredsummary) --> !, [ nl(1) ].
487indent(hline) --> !, [ nl(1) ].
488indent(_) --> [].
489
490outdent(begin) --> !, [ nl_exact(1) ].
491outdent(end) --> !, [ nl(2) ].
492outdent(item) --> !, [ ' ' ].
493outdent(tag) --> !, [ nl(1) ].
494outdent(termitem) --> !, [ nl(1) ].
495outdent(prefixtermitem) --> !, [ nl(1) ].
496outdent(infixtermitem) --> !, [ nl(1) ].
497outdent(postfixtermitem) --> !, [ nl(1) ].
498outdent(definition) --> !, [ nl(1) ].
499outdent(section) --> !, [ nl(2) ].
500outdent(subsection) --> !, [ nl(2) ].
501outdent(subsubsection) --> !, [ nl(2) ].
502outdent(predicate) --> !, [ nl(1) ].
503outdent(dcg) --> !, [ nl(1) ].
504outdent(infixop) --> !, [ nl(1) ].
505outdent(prefixop) --> !, [ nl(1) ].
506outdent(postfixop) --> !, [ nl(1) ].
507outdent(predicatesummary) --> !,[ nl(1) ].
508outdent(dcgsummary) --> !, [ nl(1) ].
509outdent(oppredsummary) --> !, [ nl(1) ].
510outdent(hline) --> !, [ nl(1) ].
511outdent(_) --> [].
512
516
517latex_special(In, Rest) -->
518 { url_chars(In, Chars, Rest),
519 special(Chars),
520 atom_chars(Atom, Chars),
521 urldef_name(Atom, Name)
522 },
523 !,
524 latex([cmd(Name), latex('{}')]).
525
526special(Chars) :-
527 memberchk(\, Chars),
528 !.
529special(Chars) :-
530 length(Chars, Len),
531 Len > 1.
532
533url_chars([H|T0], [H|T], Rest) :-
534 urlchar(H),
535 !,
536 url_chars(T0, T, Rest).
537url_chars(L, [], L).
538
539
550
551latex_arguments(List, Out, Tail) :-
552 asserta(fragile, Ref),
553 call_cleanup(fragile_list(List, Out, Tail),
554 erase(Ref)).
555
556fragile_list([]) --> [].
557fragile_list([opt([])|T]) -->
558 !,
559 fragile_list(T).
560fragile_list([opt(H)|T]) -->
561 !,
562 [ '[' ],
563 latex_arg(H),
564 [ ']' ],
565 fragile_list(T).
566fragile_list([H|T]) -->
567 [ curl(open) ],
568 latex_arg(H),
569 [ curl(close) ],
570 fragile_list(T).
571
576
577latex_arg(H) -->
578 { atomic(H),
579 atom_string(Atom, H),
580 urldef_name(Atom, Name)
581 },
582 !,
583 latex(cmd(Name)).
584latex_arg(H) -->
585 { maplist(atom, H),
586 atomic_list_concat(H, Atom),
587 urldef_name(Atom, Name)
588 },
589 !,
590 latex(cmd(Name)).
591latex_arg(no_escape(Text)) -->
592 !,
593 [no_escape(Text)].
594latex_arg(url_escape(Text)) -->
595 !,
596 [url_escape(Text)].
597latex_arg(H) -->
598 latex(H).
599
600attribute(Att, Attrs) :-
601 is_list(Attrs),
602 !,
603 option(Att, Attrs).
604attribute(Att, One) :-
605 option(Att, [One]).
606
607if_short_list(Content, If, Else, Env) :-
608 ( short_list(Content)
609 -> Env = If
610 ; Env = Else
611 ).
612
617
618short_list([]).
619short_list([_,dd(Content)|T]) :-
620 !,
621 short_content(Content),
622 short_list(T).
623short_list([_,dd(_, Content)|T]) :-
624 !,
625 short_content(Content),
626 short_list(T).
627short_list([li(Content)|T]) :-
628 short_content(Content),
629 short_list(T).
630
631short_content(Content) :-
632 phrase(latex(Content), Tokens),
633 summed_string_len(Tokens, 0, Len),
634 Len < 50.
635
636summed_string_len([], Len, Len).
637summed_string_len([H|T], L0, L) :-
638 atomic(H),
639 !,
640 atom_length(H, AL),
641 L1 is L0 + AL,
642 summed_string_len(T, L1, L).
643summed_string_len([_|T], L0, L) :-
644 summed_string_len(T, L0, L).
645
646
654
655latex_section(Level, Attrs, Content) -->
656 { current_options(Options),
657 option(section_level(LaTexSection), Options, section),
658 latex_section_level(LaTexSection, BaseLevel),
659 FinalLevel is BaseLevel+Level,
660 ( latex_section_level(SectionCommand, FinalLevel)
661 -> Term =.. [SectionCommand, Content]
662 ; domain_error(latex_section_level, FinalLevel)
663 )
664 },
665 latex(cmd(Term)),
666 section_label(Attrs).
667
668section_label(Attrs) -->
669 { is_list(Attrs),
670 memberchk(id(Name), Attrs),
671 !,
672 delete_unsafe_label_chars(Name, SafeName),
673 atom_concat('sec:', SafeName, Label)
674 },
675 latex(cmd(label(Label))).
676section_label(_) -->
677 [].
678
679latex_section_level(chapter, 0).
680latex_section_level(section, 1).
681latex_section_level(subsection, 2).
682latex_section_level(subsubsection, 3).
683latex_section_level(paragraph, 4).
684
685deepen_section_level(Level0, Level1) :-
686 latex_section_level(Level0, N),
687 N1 is N + 1,
688 latex_section_level(Level1, N1).
689
695
696delete_unsafe_label_chars(LabelIn, LabelOut) :-
697 atom_chars(LabelIn, Chars),
698 delete(Chars, '_', CharsOut),
699 atom_chars(LabelOut, CharsOut).
700
701
702 705
709
710include(PI, predicate, _) -->
711 !,
712 ( { options(Options)
713 -> true
714 ; Options = []
715 },
716 latex_tokens_for_predicates(PI, Options)
717 -> []
718 ; latex(cmd(item(['[[', \predref(PI), ']]'])))
719 ).
720include(File, Type, Options) -->
721 { existing_linked_file(File, Path) },
722 !,
723 include_file(Path, Type, Options).
724include(File, _, _) -->
725 latex(code(['[[', File, ']]'])).
726
727include_file(Path, image, Options) -->
728 { option(caption(Caption), Options) },
729 !,
730 latex(cmd(begin(figure, [no_escape(htbp)]))),
731 latex(cmd(begin(center))),
732 latex(cmd(includegraphics(Path))),
733 latex(cmd(end(center))),
734 latex(cmd(caption(Caption))),
735 latex(cmd(end(figure))).
736include_file(Path, image, _) -->
737 !,
738 latex(cmd(includegraphics(Path))).
739include_file(Path, Type, _) -->
740 { assertion(memberchk(Type, [prolog,wiki])),
741 current_options(Options0),
742 select_option(stand_alone(_), Options0, Options1, _),
743 select_option(section_level(Level0), Options1, Options2, section),
744 deepen_section_level(Level0, Level),
745 Options = [stand_alone(false), section_level(Level)|Options2]
746 },
747 ( {Type == prolog}
748 -> latex_tokens_for_file(Path, Options)
749 ; latex_tokens_for_wiki_file(Path, Options)
750 ).
751
756
757file(File, _Options) -->
758 { fragile },
759 !,
760 latex(cmd(texttt(File))).
761file(File, _Options) -->
762 latex(cmd(file(File))).
763
768
769predref(Module:Name/Arity) -->
770 !,
771 latex(cmd(qpredref(Module, Name, Arity))).
772predref(Module:Name//Arity) -->
773 latex(cmd(qdcgref(Module, Name, Arity))).
774predref(Name/Arity) -->
775 latex(cmd(predref(Name, Arity))).
776predref(Name//Arity) -->
777 latex(cmd(dcgref(Name, Arity))).
778
782
783nopredref(Name/Arity) -->
784 latex(cmd(nopredref(Name, Arity))).
785
789
790flagref(Flag) -->
791 latex(cmd(prologflag(Flag))).
792
796
797cite(Citations) -->
798 { atomic_list_concat(Citations, ',', Atom) },
799 latex(cmd(cite(Atom))).
800
805
806tags([\args(Params)|Rest]) -->
807 !,
808 args(Params),
809 tags_list(Rest).
810tags(List) -->
811 tags_list(List).
812
813tags_list([]) -->
814 [].
815tags_list(List) -->
816 [ nl(2) ],
817 latex(cmd(begin(tags))),
818 latex(List),
819 latex(cmd(end(tags))),
820 [ nl(2) ].
821
825
826tag(Tag, [One]) -->
827 !,
828 { doc_tag_title(Tag, Title) },
829 latex([ cmd(tag(Title))
830 | One
831 ]).
832tag(Tag, More) -->
833 { doc_tag_title(Tag, Title) },
834 latex([ cmd(mtag(Title)),
835 \tag_value_list(More)
836 ]).
837
838tag_value_list([H|T]) -->
839 latex(['- '|H]),
840 ( { T \== [] }
841 -> [latex(' \\\\')],
842 tag_value_list(T)
843 ; []
844 ).
845
850
851args(Params) -->
852 latex([ cmd(begin(arguments)),
853 \arg_list(Params),
854 cmd(end(arguments))
855 ]).
856
857arg_list([]) -->
858 [].
859arg_list([H|T]) -->
860 argument(H),
861 arg_list(T).
862
863argument(arg(Name,Descr)) -->
864 [ nl(1) ],
865 latex(cmd(arg(Name))), [ latex(' & ') ],
866 latex(Descr), [latex(' \\\\')].
867
871
(File, Options) -->
873 { memberchk(file(Title, Comment), Options),
874 !,
875 file_synopsis(File, Synopsis, Options)
876 },
877 file_title([Synopsis, ': ', Title], File, Options),
878 { is_structured_comment(Comment, Prefixes),
879 string_codes(Comment, Codes),
880 indented_lines(Codes, Prefixes, Lines),
881 section_comment_header(Lines, _Header, Lines1),
882 wiki_lines_to_dom(Lines1, [], DOM0),
883 tags_to_front(DOM0, DOM)
884 },
885 latex(DOM),
886 latex(cmd(vspace('0.7cm'))).
887file_header(File, Options) -->
888 { file_synopsis(File, Synopsis, Options)
889 },
890 file_title([Synopsis], File, Options).
891
892tags_to_front(DOM0, DOM) :-
893 append(Content, [\tags(Tags)], DOM0),
894 !,
895 DOM = [\tags(Tags)|Content].
896tags_to_front(DOM, DOM).
897
898file_synopsis(_File, Synopsis, Options) :-
899 option(file_synopsis(Synopsis), Options),
900 !.
901file_synopsis(File, Synopsis, _) :-
902 file_name_on_path(File, Term),
903 unquote_filespec(Term, Unquoted),
904 format(atom(Synopsis), '~w', [Unquoted]).
905
906
910
911file_title(Title, File, Options) -->
912 { option(section_level(Level), Options, section),
913 Section =.. [Level,Title],
914 file_base_name(File, BaseExt),
915 file_name_extension(Base, _, BaseExt),
916 ( option(label(Seclabel), Options)
917 -> true
918 ; delete_unsafe_label_chars(Base, Seclabel)
919 ),
920 atom_concat('sec:', Seclabel, Label)
921 },
922 latex(cmd(Section)),
923 latex(cmd(label(Label))).
924
925
929
930objects(Objects, Options) -->
931 objects(Objects, [body], Options).
932
933objects([], Mode, _) -->
934 pop_mode(body, Mode, _).
935objects([Obj|T], Mode, Options) -->
936 object(Obj, Mode, Mode1, Options),
937 objects(T, Mode1, Options).
938
939object(doc(Obj,Pos,Comment), Mode0, Mode, Options) -->
940 !,
941 object(Obj, Pos, Comment, Mode0, Mode, Options).
942object(Obj, Mode0, Mode, Options) -->
943 { doc_comment(Obj, Pos, _Summary, Comment)
944 },
945 !,
946 object(Obj, Pos, Comment, Mode0, Mode, Options).
947
948object(Obj, Pos, Comment, Mode0, Mode, Options) -->
949 { is_pi(Obj),
950 !,
951 is_structured_comment(Comment, Prefixes),
952 string_codes(Comment, Codes),
953 indented_lines(Codes, Prefixes, Lines),
954 strip_module(user:Obj, Module, _),
955 process_modes(Lines, Module, Pos, Modes, Args, Lines1),
956 ( private(Obj, Options)
957 -> Class = privdef 958 ; multifile(Obj, Options)
959 -> Class = multidef
960 ; Class = pubdef 961 ),
962 ( Obj = Module:_
963 -> POptions = [module(Module)|Options]
964 ; POptions = Options
965 ),
966 DOM = [\pred_dt(Modes, Class, POptions), dd(class=defbody, DOM1)],
967 wiki_lines_to_dom(Lines1, Args, DOM0),
968 strip_leading_par(DOM0, DOM1),
969 assert_documented(Obj)
970 },
971 need_mode(description, Mode0, Mode),
972 latex(DOM).
973object([Obj|Same], Pos, Comment, Mode0, Mode, Options) -->
974 !,
975 object(Obj, Pos, Comment, Mode0, Mode, Options),
976 { maplist(assert_documented, Same) }.
977object(Obj, _Pos, _Comment, Mode, Mode, _Options) -->
978 { debug(pldoc, 'Skipped ~p', [Obj]) },
979 [].
980
981assert_documented(Obj) :-
982 assert(documented(Obj)).
983
984
991
992need_mode(Mode, Stack, Stack) -->
993 { Stack = [Mode|_] },
994 !,
995 [].
996need_mode(Mode, Stack, Rest) -->
997 { memberchk(Mode, Stack)
998 },
999 !,
1000 pop_mode(Mode, Stack, Rest).
1001need_mode(Mode, Stack, [Mode|Stack]) -->
1002 !,
1003 latex(cmd(begin(Mode))).
1004
1005pop_mode(Mode, Stack, Stack) -->
1006 { Stack = [Mode|_] },
1007 !,
1008 [].
1009pop_mode(Mode, [H|Rest0], Rest) -->
1010 latex(cmd(end(H))),
1011 pop_mode(Mode, Rest0, Rest).
1012
1013
1022
1023pred_dt(Modes, Class, Options) -->
1024 [nl(2)],
1025 pred_dt(Modes, [], _Done, [class(Class)|Options]).
1026
1027pred_dt([], Done, Done, _) -->
1028 [].
1029pred_dt([H|T], Done0, Done, Options) -->
1030 pred_mode(H, Done0, Done1, Options),
1031 ( {T == []}
1032 -> []
1033 ; latex(cmd(nodescription)),
1034 pred_dt(T, Done1, Done, Options)
1035 ).
1036
1037pred_mode(mode(Head,Vars), Done0, Done, Options) -->
1038 !,
1039 { bind_vars(Head, Vars) },
1040 pred_mode(Head, Done0, Done, Options).
1041pred_mode(Head is Det, Done0, Done, Options) -->
1042 !,
1043 anchored_pred_head(Head, Done0, Done, [det(Det)|Options]).
1044pred_mode(Head, Done0, Done, Options) -->
1045 anchored_pred_head(Head, Done0, Done, Options).
1046
1047bind_vars(Term, Bindings) :-
1048 bind_vars(Bindings),
1049 anon_vars(Term).
1050
1051bind_vars([]).
1052bind_vars([Name=Var|T]) :-
1053 Var = '$VAR'(Name),
1054 bind_vars(T).
1055
1060
1061anon_vars(Var) :-
1062 var(Var),
1063 !,
1064 Var = '$VAR'('_').
1065anon_vars(Term) :-
1066 compound(Term),
1067 !,
1068 Term =.. [_|Args],
1069 maplist(anon_vars, Args).
1070anon_vars(_).
1071
1072
1073anchored_pred_head(Head, Done0, Done, Options) -->
1074 { pred_anchor_name(Head, PI, _Name) },
1075 ( { memberchk(PI, Done0) }
1076 -> { Done = Done0 }
1077 ; { Done = [PI|Done0] }
1078 ),
1079 pred_head(Head, Options).
1080
1081
1088
1089pred_head(//(Head), Options) -->
1090 !,
1091 { pred_attributes(Options, Atts),
1092 Head =.. [Functor|Args],
1093 length(Args, Arity)
1094 },
1095 latex(cmd(dcg(opt(Atts), Functor, Arity, \pred_args(Args, 1)))).
1096pred_head(Head, _Options) --> 1097 { Head =.. [Functor,Left,Right],
1098 Functor \== (:),
1099 is_op_type(Functor, infix), !
1100 },
1101 latex(cmd(infixop(Functor, \pred_arg(Left, 1), \pred_arg(Right, 2)))).
1102pred_head(Head, _Options) --> 1103 { Head =.. [Functor,Arg],
1104 is_op_type(Functor, prefix), !
1105 },
1106 latex(cmd(prefixop(Functor, \pred_arg(Arg, 1)))).
1107pred_head(Head, _Options) --> 1108 { Head =.. [Functor,Arg],
1109 is_op_type(Functor, postfix), !
1110 },
1111 latex(cmd(postfixop(Functor, \pred_arg(Arg, 1)))).
1112pred_head(M:Head, Options) --> 1113 !,
1114 { pred_attributes(Options, Atts),
1115 Head =.. [Functor|Args],
1116 length(Args, Arity)
1117 },
1118 latex(cmd(qpredicate(opt(Atts),
1119 M,
1120 Functor, Arity, \pred_args(Args, 1)))).
1121pred_head(Head, Options) --> 1122 { pred_attributes(Options, Atts),
1123 Head =.. [Functor|Args],
1124 length(Args, Arity)
1125 },
1126 latex(cmd(predicate(opt(Atts),
1127 Functor, Arity, \pred_args(Args, 1)))).
1128
1133
1134pred_attributes(Options, Attrs) :-
1135 findall(A, pred_att(Options, A), As),
1136 insert_comma(As, Attrs).
1137
1138pred_att(Options, Det) :-
1139 option(det(Det), Options).
1140pred_att(Options, private) :-
1141 option(class(privdef), Options).
1142pred_att(Options, multifile) :-
1143 option(class(multidef), Options).
1144
1145insert_comma([H1,H2|T0], [H1, ','|T]) :-
1146 !,
1147 insert_comma([H2|T0], T).
1148insert_comma(L, L).
1149
1150
1151:- if(current_predicate(is_dict/1)). 1152dict_kv_pairs([]) --> [].
1153dict_kv_pairs([H|T]) -->
1154 dict_kv(H),
1155 ( { T == [] }
1156 -> []
1157 ; latex(', '),
1158 dict_kv_pairs(T)
1159 ).
1160
1161dict_kv(Key-Value) -->
1162 latex(cmd(key(Key))),
1163 latex(':'),
1164 term(Value).
1165:- endif. 1166
1167pred_args([], _) -->
1168 [].
1169pred_args([H|T], I) -->
1170 pred_arg(H, I),
1171 ( {T==[]}
1172 -> []
1173 ; latex(', '),
1174 { I2 is I + 1 },
1175 pred_args(T, I2)
1176 ).
1177
1178pred_arg(Var, I) -->
1179 { var(Var) },
1180 !,
1181 latex(['Arg', I]).
1182pred_arg(...(Term), I) -->
1183 !,
1184 pred_arg(Term, I),
1185 latex(cmd(ldots)).
1186pred_arg(Term, I) -->
1187 { Term =.. [Ind,Arg],
1188 mode_indicator(Ind)
1189 },
1190 !,
1191 latex([Ind, \pred_arg(Arg, I)]).
1192pred_arg(Arg:Type, _) -->
1193 !,
1194 latex([\argname(Arg), :, \argtype(Type)]).
1195pred_arg(Arg, _) -->
1196 { atom(Arg) },
1197 !,
1198 argname(Arg).
1199pred_arg(Arg, _) -->
1200 argtype(Arg). 1201
1202argname('$VAR'(Name)) -->
1203 !,
1204 latex(Name).
1205argname(Name) -->
1206 !,
1207 latex(Name).
1208
1209argtype(Term) -->
1210 { format(string(S), '~W',
1211 [ Term,
1212 [ quoted(true),
1213 numbervars(true)
1214 ]
1215 ]) },
1216 latex(S).
1217
1223
1224term(_, Term, Bindings) -->
1225 { bind_vars(Bindings) },
1226 term(Term).
1227
1228term('$VAR'(Name)) -->
1229 !,
1230 latex(cmd(arg(Name))).
1231term(Compound) -->
1232 { callable(Compound),
1233 !,
1234 Compound =.. [Functor|Args]
1235 },
1236 !,
1237 term_with_args(Functor, Args).
1238term(Rest) -->
1239 latex(Rest).
1240
1241term_with_args(Functor, [Left, Right]) -->
1242 { is_op_type(Functor, infix) },
1243 !,
1244 latex(cmd(infixterm(Functor, \term(Left), \term(Right)))).
1245term_with_args(Functor, [Arg]) -->
1246 { is_op_type(Functor, prefix) },
1247 !,
1248 latex(cmd(prefixterm(Functor, \term(Arg)))).
1249term_with_args(Functor, [Arg]) -->
1250 { is_op_type(Functor, postfix) },
1251 !,
1252 latex(cmd(postfixterm(Functor, \term(Arg)))).
1253term_with_args(Functor, Args) -->
1254 latex(cmd(term(Functor, \pred_args(Args, 1)))).
1255
1256
1260
1261termitem(_Text, Term, Bindings) -->
1262 { bind_vars(Bindings) },
1263 termitem(Term).
1264
1265termitem('$VAR'(Name)) -->
1266 !,
1267 latex(cmd(termitem(var(Name), ''))).
1268:- if(current_predicate(is_dict/1)). 1269termitem(Dict) -->
1270 { is_dict(Dict),
1271 !,
1272 dict_pairs(Dict, Tag, Pairs)
1273 },
1274 latex(cmd(dictitem(Tag, \dict_kv_pairs(Pairs)))).
1275:- endif. 1276termitem(Compound) -->
1277 { callable(Compound),
1278 !,
1279 Compound =.. [Functor|Args]
1280 },
1281 !,
1282 termitem_with_args(Functor, Args).
1283termitem(Rest) -->
1284 latex(cmd(termitem(Rest, ''))).
1285
1286termitem_with_args(Functor, [Left, Right]) -->
1287 { is_op_type(Functor, infix) },
1288 !,
1289 latex(cmd(infixtermitem(Functor, \term(Left), \term(Right)))).
1290termitem_with_args(Functor, [Arg]) -->
1291 { is_op_type(Functor, prefix) },
1292 !,
1293 latex(cmd(prefixtermitem(Functor, \term(Arg)))).
1294termitem_with_args(Functor, [Arg]) -->
1295 { is_op_type(Functor, postfix) },
1296 !,
1297 latex(cmd(postfixtermitem(Functor, \term(Arg)))).
1298termitem_with_args({}, [Arg]) -->
1299 !,
1300 latex(cmd(curltermitem(\argtype(Arg)))).
1301termitem_with_args(Functor, Args) -->
1302 latex(cmd(termitem(Functor, \pred_args(Args, 1)))).
1303
1304
1308
1309latex_table(_Attrs, Content) -->
1310 { max_columns(Content, 0, _, -, Wittness),
1311 col_align(Wittness, 1, Content, Align),
1312 atomics_to_string(Align, '|', S0),
1313 atomic_list_concat(['|',S0,'|'], Format)
1314 },
1316 latex(cmd(begin(quote))),
1317 latex(cmd(begin(tabulary,
1318 no_escape('0.9\\textwidth'),
1319 no_escape(Format)))),
1320 latex(cmd(hline)),
1321 rows(Content),
1322 latex(cmd(hline)),
1323 latex(cmd(end(tabulary))),
1324 latex(cmd(end(quote))).
1326
1327max_columns([], C, C, W, W).
1328max_columns([tr(List)|T], C0, C, _, W) :-
1329 length(List, C1),
1330 C1 >= C0, 1331 !,
1332 max_columns(T, C1, C, List, W).
1333max_columns([_|T], C0, C, W0, W) :-
1334 max_columns(T, C0, C, W0, W).
1335
1336col_align([], _, _, []).
1337col_align([CH|CT], Col, Rows, [AH|AT]) :-
1338 ( member(tr(Cells), Rows),
1339 nth1(Col, Cells, Cell),
1340 auto_par(Cell)
1341 -> Wrap = auto
1342 ; Wrap = false
1343 ),
1344 col_align(CH, Wrap, AH),
1345 Col1 is Col+1,
1346 col_align(CT, Col1, Rows, AT).
1347
1348col_align(td(class=Class,_), Wrap, Align) :-
1349 align_class(Class, Wrap, Align),
1350 !.
1351col_align(_, auto, 'L') :- !.
1352col_align(_, false, 'l').
1353
1354align_class(left, auto, 'L').
1355align_class(center, auto, 'C').
1356align_class(right, auto, 'R').
1357align_class(left, false, 'l').
1358align_class(center, false, 'c').
1359align_class(right, false, 'r').
1360
1361rows([]) -->
1362 [].
1363rows([tr(Content)|T]) -->
1364 row(Content),
1365 rows(T).
1366
1367row([]) -->
1368 [ latex(' \\\\'), nl(1) ].
1369row([td(_Attrs, Content)|T]) -->
1370 !,
1371 row([td(Content)|T]).
1372row([td(Content)|T]) -->
1373 latex(Content),
1374 ( {T == []}
1375 -> []
1376 ; [ latex(' & ') ]
1377 ),
1378 row(T).
1379row([th(Content)|T]) -->
1380 latex(cmd(textbf(Content))),
1381 ( {T == []}
1382 -> []
1383 ; [ latex(' & ') ]
1384 ),
1385 row(T).
1386
1390
1391auto_par(Content) :-
1392 phrase(html_text(Content), Words),
1393 length(Words, WC),
1394 WC > 1,
1395 atomics_to_string(Words, Text),
1396 string_length(Text, Width),
1397 Width > 15.
1398
1399html_text([]) -->
1400 !.
1401html_text([H|T]) -->
1402 !,
1403 html_text(H),
1404 html_text(T).
1405html_text(\predref(Name/Arity)) -->
1406 !,
1407 { format(string(S), '~q/~q', [Name, Arity]) },
1408 [S].
1409html_text(Compound) -->
1410 { compound(Compound),
1411 !,
1412 functor(Compound, _Name, Arity),
1413 arg(Arity, Compound, Content)
1414 },
1415 html_text(Content).
1416html_text(Word) -->
1417 [Word].
1418
1419
1420
1421
1422 1425
1430
1431latex_summary(Options) :-
1432 option(summary(File), Options),
1433 !,
1434 findall(Obj, summary_obj(Obj), Objs),
1435 maplist(pi_sort_key, Objs, Keyed),
1436 keysort(Keyed, KSorted),
1437 pairs_values(KSorted, SortedObj),
1438 phrase(summarylist(SortedObj, Options), Tokens),
1439 open(File, write, Out),
1440 call_cleanup(print_latex(Out, Tokens, Options),
1441 close(Out)).
1442latex_summary(_) :-
1443 retractall(documented(_)).
1444
1445summary_obj(Obj) :-
1446 documented(Obj),
1447 pi_head(Obj, Head),
1448 \+ xref_hook(Head).
1449
1450pi_head(M:PI, M:Head) :-
1451 !,
1452 pi_head(PI, Head).
1453pi_head(Name/Arity, Head) :-
1454 functor(Head, Name, Arity).
1455pi_head(Name//DCGArity, Head) :-
1456 Arity is DCGArity+2,
1457 functor(Head, Name, Arity).
1458
1459
1460pi_sort_key(M:PI, PI-(M:PI)) :- !.
1461pi_sort_key(PI, PI-PI).
1462
1463object_name_arity(_:Term, Type, Name, Arity) :-
1464 nonvar(Term),
1465 !,
1466 object_name_arity(Term, Type, Name, Arity).
1467object_name_arity(Name/Arity, pred, Name, Arity).
1468object_name_arity(Name//Arity, dcg, Name, Arity).
1469
1470summarylist(Objs, Options) -->
1471 latex(cmd(begin(summarylist, ll))),
1472 summary(Objs, Options),
1473 latex(cmd(end(summarylist))).
1474
1475summary([], _) -->
1476 [].
1477summary([H|T], Options) -->
1478 summary_line(H, Options),
1479 summary(T, Options).
1480
1481summary_line(Obj, _Options) -->
1482 { doc_comment(Obj, _Pos, Summary, _Comment),
1483 !,
1484 atom_codes(Summary, Codes),
1485 phrase(pldoc_wiki:line_tokens(Tokens), Codes), 1486 object_name_arity(Obj, Type, Name, Arity)
1487 },
1488 ( {Type == dcg}
1489 -> latex(cmd(dcgsummary(Name, Arity, Tokens)))
1490 ; { strip_module(Obj, M, _),
1491 current_op(Pri, Ass, M:Name)
1492 }
1493 -> latex(cmd(oppredsummary(Name, Arity, Ass, Pri, Tokens)))
1494 ; latex(cmd(predicatesummary(Name, Arity, Tokens)))
1495 ).
1496summary_line(Obj, _Options) -->
1497 { print_message(warning, pldoc(no_summary_for(Obj)))
1498 }.
1499
1500 1503
1504print_latex(Out, Tokens, Options) :-
1505 latex_header(Out, Options),
1506 print_latex_tokens(Tokens, Out),
1507 latex_footer(Out, Options).
1508
1509
1513
1514print_latex_tokens([], _).
1515print_latex_tokens([nl(N)|T0], Out) :-
1516 !,
1517 max_nl(T0, T, N, NL),
1518 nl(Out, NL),
1519 print_latex_tokens(T, Out).
1520print_latex_tokens([nl_exact(N)|T0], Out) :-
1521 !,
1522 nl_exact(T0, T,N, NL),
1523 nl(Out, NL),
1524 print_latex_tokens(T, Out).
1525print_latex_tokens([H|T], Out) :-
1526 print_latex_token(H, Out),
1527 print_latex_tokens(T, Out).
1528
1529print_latex_token(cmd(Cmd), Out) :-
1530 !,
1531 format(Out, '\\~w', [Cmd]).
1532print_latex_token(curl(open), Out) :-
1533 !,
1534 format(Out, '{', []).
1535print_latex_token(curl(close), Out) :-
1536 !,
1537 format(Out, '}', []).
1538print_latex_token(indent(N), Out) :-
1539 !,
1540 format(Out, '~t~*|', [N]).
1541print_latex_token(nl(N), Out) :-
1542 !,
1543 format(Out, '~N', []),
1544 forall(between(2,N,_), nl(Out)).
1545print_latex_token(verb(Verb), Out) :-
1546 is_list(Verb), Verb \== [],
1547 !,
1548 atomic_list_concat(Verb, Atom),
1549 print_latex_token(verb(Atom), Out).
1550print_latex_token(verb(Verb), Out) :-
1551 !,
1552 ( member(C, [$,'|',@,=,'"',^,!]),
1553 \+ sub_atom(Verb, _, _, _, C)
1554 -> atom_replace_char(Verb, '\n', ' ', Verb2),
1555 format(Out, '\\verb~w~w~w', [C,Verb2,C])
1556 ; assertion(fail)
1557 ).
1558print_latex_token(code(Code), Out) :-
1559 !,
1560 format(Out, '~N\\begin{code}~n', []),
1561 format(Out, '~w', [Code]),
1562 format(Out, '~N\\end{code}', []).
1563print_latex_token(latex(Code), Out) :-
1564 !,
1565 write(Out, Code).
1566print_latex_token(w(Word), Out) :-
1567 !,
1568 print_latex(Out, Word).
1569print_latex_token(no_escape(Text), Out) :-
1570 !,
1571 write(Out, Text).
1572print_latex_token(url_escape(Text), Out) :-
1573 !,
1574 print_url(Out, Text).
1575print_latex_token(Rest, Out) :-
1576 ( atomic(Rest)
1577 -> print_latex(Out, Rest)
1578 ; 1579 write(Out, Rest)
1580 ).
1581
1582atom_replace_char(In, From, To, Out) :-
1583 sub_atom(In, _, _, _, From),
1584 !,
1585 atom_chars(In, CharsIn),
1586 replace(CharsIn, From, To, CharsOut),
1587 atom_chars(Out, CharsOut).
1588atom_replace_char(In, _, _, In).
1589
1590replace([], _, _, []).
1591replace([H|T0], H, N, [N|T]) :-
1592 !,
1593 replace(T0, H, N, T).
1594replace([H|T0], F, N, [H|T]) :-
1595 replace(T0, F, N, T).
1596
1597
1601
1602print_latex(Out, String) :-
1603 atom_string(Atom, String),
1604 atom_chars(Atom, Chars),
1605 print_chars(Chars, Out).
1606
1607print_chars([], _).
1608print_chars([H|T], Out) :-
1609 print_char(H, Out),
1610 print_chars(T, Out).
1611
1612
1613print_url(Out, String) :-
1614 string_chars(String, Chars),
1615 print_url_chars(Chars, Out).
1616
1617print_url_chars([], _).
1618print_url_chars([H|T], Out) :-
1619 print_url_char(H, Out),
1620 print_url_chars(T, Out).
1621
1622print_url_char('#', Out) :- !, write(Out, '\\#').
1623print_url_char(C, Out) :- put_char(Out, C).
1624
1625
1629
1630max_nl([nl(M1)|T0], T, M0, M) :-
1631 !,
1632 M2 is max(M1, M0),
1633 max_nl(T0, T, M2, M).
1634max_nl([nl_exact(M1)|T0], T, _, M) :-
1635 !,
1636 nl_exact(T0, T, M1, M).
1637max_nl(T, T, M, M).
1638
1639nl_exact([nl(_)|T0], T, M0, M) :-
1640 !,
1641 max_nl(T0, T, M0, M).
1642nl_exact([nl_exact(M1)|T0], T, M0, M) :-
1643 !,
1644 M2 is max(M1, M0),
1645 max_nl(T0, T, M2, M).
1646nl_exact(T, T, M, M).
1647
1648
1649nl(Out, N) :-
1650 forall(between(1, N, _), nl(Out)).
1651
1652
1657
1658print_char('<', Out) :- !, write(Out, '$<$').
1659print_char('>', Out) :- !, write(Out, '$>$').
1660print_char('{', Out) :- !, write(Out, '\\{').
1661print_char('}', Out) :- !, write(Out, '\\}').
1662print_char('$', Out) :- !, write(Out, '\\$').
1663print_char('&', Out) :- !, write(Out, '\\&').
1664print_char('#', Out) :- !, write(Out, '\\#').
1665print_char('%', Out) :- !, write(Out, '\\%').
1666print_char('~', Out) :- !, write(Out, '\\Stilde{}').
1667print_char('\\',Out) :- !, write(Out, '\\bsl{}').
1668print_char('^', Out) :- !, write(Out, '\\Shat{}').
1669print_char('|', Out) :- !, write(Out, '\\Sbar{}').
1670print_char(C, Out) :- decompose_char(C, Out), !.
1671print_char(C, Out) :- put_char(Out, C).
1672
1678
1679:- if(exists_source(library(unicode))). 1680:- use_module(library(unicode)). 1681decompose_char(Char, Out) :-
1682 char_code(Char, Code),
1683 Code > 128,
1684 unicode_map(Char, Decomposed, [decompose]),
1685 atom_codes(Decomposed, [C,D]),
1686 diacritic_cmd(D, Cmd),
1687 format(Out, '\\~w~c', [Cmd, C]).
1688:- else. 1689decompose_char(_,_) :-
1690 fail.
1691:- endif. 1692
1693diacritic_cmd(768, '`').
1694diacritic_cmd(769, '\'').
1695diacritic_cmd(770, '~').
1696diacritic_cmd(771, '=').
1697diacritic_cmd(774, 'v').
1698diacritic_cmd(775, '.').
1699diacritic_cmd(776, '"').
1700diacritic_cmd(785, 'u').
1701diacritic_cmd(807, 'c').
1702diacritic_cmd(808, 'k').
1703
1707
1708identifier(Atom) :-
1709 atom_chars(Atom, [C0|Chars]),
1710 char_type(C0, lower),
1711 all_chartype(Chars, alnum).
1712
1713all_chartype([], _).
1714all_chartype([H|T], Type) :-
1715 char_type(H, Type),
1716 all_chartype(T, Type).
1717
1718
1719 1722
1730
1731:- dynamic
1732 urldef_name/2,
1733 urlchar/1, 1734 urldefs_loaded/1. 1735
1741
1742load_urldefs :-
1743 urldefs_loaded(_),
1744 !.
1745load_urldefs :-
1746 absolute_file_name(library('pldoc/pldoc.sty'), File,
1747 [ access(read) ]),
1748 load_urldefs(File).
1749
1750load_urldefs(File) :-
1751 urldefs_loaded(File),
1752 !.
1753load_urldefs(File) :-
1754 open(File, read, In),
1755 call_cleanup(( read_line_to_codes(In, L0),
1756 process_urldefs(L0, In)),
1757 close(In)),
1758 assert(urldefs_loaded(File)).
1759
1760process_urldefs(end_of_file, _) :- !.
1761process_urldefs(Line, In) :-
1762 ( phrase(urldef(Name, String), Line)
1763 -> assert(urldef_name(String, Name)),
1764 assert_chars(String)
1765 ; true
1766 ),
1767 read_line_to_codes(In, L2),
1768 process_urldefs(L2, In).
1769
1770assert_chars(String) :-
1771 atom_chars(String, Chars),
1772 ( member(C, Chars),
1773 \+ urlchar(C),
1774 assert(urlchar(C)),
1775 fail
1776 ; true
1777 ).
1778
1779urldef(Name, String) -->
1780 "\\urldef{\\", string(NameS), "}\\satom{", string(StringS), "}",
1781 ws,
1782 ( "%"
1783 -> string(_)
1784 ; []
1785 ),
1786 eol,
1787 !,
1788 { atom_codes(Name, NameS),
1789 atom_codes(String, StringS)
1790 }.
1791
1792ws --> [C], { C =< 32 }, !, ws.
1793ws --> [].
1794
1795string([]) --> [].
1796string([H|T]) --> [H], string(T).
1797
1798eol([],[]).
1799
1800
1801 1804
(Out, Options) :-
1806 ( option(stand_alone(true), Options, true)
1807 -> forall(header(Line), format(Out, '~w~n', [Line]))
1808 ; true
1809 ),
1810 forall(generated(Line), format(Out, '~w~n', [Line])).
1811
(Out, Options) :-
1813 ( option(stand_alone(true), Options, true)
1814 -> forall(footer(Line), format(Out, '~w~n', [Line]))
1815 ; true
1816 ).
1817
('\\documentclass[11pt]{article}').
1819header('\\usepackage{times}').
1820header('\\usepackage{pldoc}').
1821header('\\sloppy').
1822header('\\makeindex').
1823header('').
1824header('\\begin{document}').
1825
('').
1827footer('\\printindex').
1828footer('\\end{document}').
1829
1830generated('% This LaTeX document was generated using the LaTeX backend of PlDoc,').
1831generated('% The SWI-Prolog documentation system').
1832generated('').
1833
1834
1835 1838
1839:- multifile
1840 prolog:message//1. 1841
1842prolog:message(pldoc(no_summary_for(Obj))) -->
1843 [ 'No summary documentation for ~p'-[Obj] ]