1# -*- tcl -*-
2#
3# fmt.html
4#
5# Copyright (c) 2001-2008 Andreas Kupries <andreas_kupries@sourceforge.net>
6#
7# Definitions to convert a tcl based manpage definition into
8# a manpage based upon HTML markup.
9#
10################################################################
11################################################################
12
13dt_source _common.tcl   ; # Shared code
14dt_source _html.tcl     ; # HTML basic formatting
15
16proc c_copyrightsymbol {} {return "[markup "&"]copy;"}
17
18proc bgcolor {} {return ""}
19proc border  {} {return 0}
20proc Year    {} {clock format [clock seconds] -format %Y}
21
22c_holdBuffers require synopsis
23
24################################################################
25## Backend for HTML markup
26
27# --------------------------------------------------------------
28# Handling of lists. Simplified, the global check of nesting and
29# legality of list commands allows us to throw away most of the
30# existing checks.
31
32global liststack ; # stack of list tags to use in list_end
33set    liststack {}
34
35proc lpush {t class} {
36    global  liststack 
37    lappend liststack [list [tag/ $t] [litc_getandclear]]
38    return [taga $t [list class $class]]
39}
40
41proc lpop {} {
42    global liststack
43    set t         [lindex   $liststack end]
44    set liststack [lreplace $liststack end end]
45    foreach {t l} $t break
46    litc_set $l
47    return $t
48}
49
50proc fmt_plain_text {text} {
51    return $text
52}
53
54################################################################
55# Formatting commands.
56
57c_pass 1 fmt_manpage_begin {title section version} {c_cinit ; c_clrSections ; return}
58c_pass 2 fmt_manpage_begin {title section version} {
59
60    global sec_is_open      ; set sec_is_open      0
61    global subsec_is_open   ; set subsec_is_open   0
62    global prev_litem_close ; set prev_litem_close {}
63    global para_is_open     ; set para_is_open     0
64    global liststack        ; set liststack        {}
65    global defaultstyle
66
67    XrefInit
68    c_cinit
69    set module      [dt_module]
70    set shortdesc   [c_get_module]
71    set description [c_get_title]
72    set copyright   [c_get_copyright]
73
74    set hdr ""
75
76    if {![Get raw]} {
77	append  hdr [tag html] [tag head] \n
78	append  hdr [tag_ title "$title - $shortdesc"] \n
79
80	if {![Extend hdr ByParameter meta]} {
81	    # Insert standard CSS definitions.
82	    append hdr [tag_ style \
83			    "[markup <]!--${defaultstyle}--[markup >]" \
84			    type text/css] \n
85	}
86
87	append  hdr [tag/ head] \n
88	append  hdr [ht_comment [c_provenance]]\n
89	if {$copyright != {}} {
90	    append  hdr [ht_comment $copyright]\n
91	}
92	append  hdr [ht_comment "CVS: \$Id\$ $title.$section"]
93	append  hdr \n\n
94	append  hdr [tag body]
95    }
96    append  hdr [tag* div class doctools] \n
97
98    Extend hdr ByParameter header
99
100    set thetitle "[string trimleft $title :]($section) $version $module \"$shortdesc\""
101    append  hdr [tag_ h1 $thetitle class title] \n
102    append  hdr [fmt_section Name name] \n
103    append  hdr "[para_open] $title - $description"
104    return $hdr
105}
106
107c_pass 1 fmt_moddesc   {desc} {c_set_module $desc}
108c_pass 2 fmt_moddesc   {desc} NOP
109
110c_pass 1 fmt_titledesc {desc} {c_set_title $desc}
111c_pass 2 fmt_titledesc {desc} NOP
112
113c_pass 1 fmt_copyright {desc} {c_set_copyright $desc}
114c_pass 2 fmt_copyright {desc} NOP
115
116c_pass 1 fmt_manpage_end {} {c_creset ; return}
117c_pass 2 fmt_manpage_end {} {
118    c_creset
119    set res ""
120
121    set sa [c_xref_seealso]
122    set kw [c_xref_keywords]
123    set ca [c_xref_category]
124    set ct [c_get_copyright]
125
126    if {[llength $sa] > 0} {
127	append res [fmt_section {See Also} see-also] \n
128	append res [join [XrefList [lsort $sa] sa] ", "] \n
129    }
130    if {[llength $kw] > 0} {
131	append res [fmt_section Keywords keywords] \n
132	append res [join [XrefList [lsort $kw] kw] ", "] \n
133    }
134    if {$ca ne ""} {
135	append res [fmt_section Category category] \n
136	append res $ca \n
137    }
138    if {$ct != {}} {
139	append res [fmt_section Copyright copyright] \n
140	append res [join [split $ct \n] [tag br]\n] [tag br]\n
141    }
142
143   # Close last paragraph, subsection, and section.
144    append res [para_close][subsec_close][sec_close]
145
146    Extend res ByParameter footer
147
148    append res [tag/ div]
149    if {![Get raw]} {
150	append res [tag/ body] [tag/ html]
151    }
152    return $res
153}
154
155c_pass 1 fmt_section {name id} {c_newSection $name 1 end $id}
156c_pass 2 fmt_section {name id} {
157    return "[sec_open $id][tag_ h2 [anchor $id $name]]\n[para_open]"
158}
159
160c_pass 1 fmt_subsection {name id} {c_newSection $name 2 end $id}
161c_pass 2 fmt_subsection {name id} {
162    return "[subsec_open $id][tag_ h3 [anchor $id $name]]\n[para_open]"
163}
164
165# Para breaks inside and outside of lists are identical
166proc fmt_nl   {} {para_open}
167proc fmt_para {} {para_open}
168
169c_pass 2 fmt_require {pkg {version {}}} NOP
170c_pass 1 fmt_require {pkg {version {}}} {
171    if {$version != {}} { append pkg " " $version }
172    c_hold require [tag_ li "package require [bold $pkg pkgname]"]
173    return
174}
175
176c_pass 2 fmt_usage {cmd args} NOP
177c_pass 1 fmt_usage {cmd args} {
178    if {[llength $args]} {
179	set text "$cmd [join $args " "]"
180    } else {
181	set text $cmd
182    }
183    c_hold synopsis [tag_ li $text]
184    return
185}
186
187c_pass 1 fmt_call {cmd args} {
188    if {[llength $args]} {
189	set text "$cmd [join $args " "]"
190    } else {
191	set text $cmd
192    }
193    c_hold synopsis [tag_ li [link $text "#[c_cnext]"]]
194    return
195}
196c_pass 2 fmt_call {cmd args} {
197    if {[llength $args]} {
198	set text "$cmd [join $args " "]"
199    } else {
200	set text $cmd
201    }
202    return [fmt_lst_item [anchor [c_cnext] $text]]
203}
204
205c_pass 1 fmt_description {did} NOP
206c_pass 2 fmt_description {did} {
207    set result ""
208    set syn [c_held synopsis]
209    set req [c_held require]
210
211    # Create the TOC.
212
213    # Pass 1: We have a number of special sections which were not
214    #         listed explicitly in the document sources. Add them
215    #         now. Note the inverse order for the sections added
216    #         at the beginning.
217
218    c_newSection Description 1 0 $did
219    if {$syn != {} || $req != {}} {c_newSection Synopsis 1 0 synopsis}
220    c_newSection {Table Of Contents} 1 0 toc
221
222    if {[llength [c_xref_seealso]]  > 0} {c_newSection {See Also} 1 end see-also}
223    if {[llength [c_xref_keywords]] > 0} {c_newSection Keywords   1 end keywords}
224    if {[c_xref_category]         ne ""} {c_newSection Category   1 end category}
225    if {[c_get_copyright]         != {}} {c_newSection Copyright  1 end copyright}
226
227    set sections $::SectionList
228
229    # Pass 2: Generate the markup for the TOC, indenting the
230    #         links according to the level of each section.
231
232    append result [fmt_section {Table Of Contents} toc] [para_close] \n
233    append result [taga ul {class toc}] \n
234    set lastlevel 1
235    set close 0
236    foreach {name id level} $sections {
237	# level in {1,2}, 1 = sectio n, 2 = subsection
238	if {$level == $lastlevel} {
239	    # Close previous item.
240	    if {$close} { append result [tag/ li] \n }
241	} elseif {$level > $lastlevel} {
242	    # Start list of subsections
243	    append result \n [tag ul] \n
244	} else { # level < lastlevel
245	    # End list of subsections, and of previous item (two
246	    # actually, the subsection, and the section item).
247	    append result [tag/ li] \n [tag/ ul] \n [tag/ li] \n
248	}
249	# Start entry
250	if {$level == 1} {
251	    append result [taga li {class section}] [link $name "#$id"]
252	} else {
253	    append result [taga li {class subsection}] [link $name "#$id"]
254	}
255	set close 1
256
257	set lastlevel $level
258    }
259    if {$lastlevel > 1 } { append result [tag/ ul] \n }
260    if {$close}          { append result [tag/ li] \n }
261
262    append result [tag/ ul] \n
263
264    # Implicit sections coming after the TOC (Synopsis, then the
265    # description which starts the actual document). The other
266    # implict sections are added at the end of the document and
267    # are generated by 'fmt_manpage_end' in the second pass.
268
269    if {$syn != {} || $req != {}} {
270	append result [fmt_section Synopsis synopsis] [para_close] [taga div {class synopsis}] \n
271	if {$req != {}} {
272	    append result [tag_ ul \n$req\n class requirements] \n
273	}
274	if {$syn != {}} {
275	    append result [tag_ ul \n$syn\n class syntax] \n
276	}
277	append result [tag/ div] \n
278    }
279    append result [fmt_section Description $did] \n
280    return $result
281}
282
283################################################################
284
285proc fmt_list_begin  {what {hint {}}} {
286    # NOTE: The hint is ignored. Use stylesheet definitions to modify
287    # item and general list spacing.
288    switch -exact -- $what {
289	enumerated  {set tag ol}
290	itemized    {set tag ul}
291	arguments -
292	commands  -
293	options   -
294	tkoptions -
295	definitions {set tag dl}
296    }
297    return [para_close][lpush $tag $what]
298}
299
300proc fmt_list_end {}        {
301    set res [para_close][litc_getandclear]\n[lpop][para_open]
302    return $res
303}
304proc fmt_lst_item {text}    {
305    set res [para_close][litc_getandclear]\n[tag_ dt $text]\n[tag dd][para_open]
306    litc_set [tag/ dd]
307    return $res
308}
309proc fmt_bullet {} {
310    set res [para_close][litc_getandclear]\n[tag li][para_open]
311    litc_set [tag/ li]
312    return $res
313}
314proc fmt_enum {} {
315    set res [para_close][litc_getandclear]\n[tag li][para_open]
316    litc_set [tag/ li]
317    return $res
318}
319
320proc fmt_cmd_def {command} {
321    fmt_lst_item [fmt_cmd $command]
322}
323proc fmt_arg_def {type name {mode {}}} {
324    set    text ""
325    append text $type " " [fmt_arg $name]
326    if {$mode != {}} {
327	append text " (" $mode ")"
328    }
329    fmt_lst_item $text
330}
331proc fmt_opt_def {name {arg {}}} {
332    set text [fmt_option $name]
333    if {$arg != {}} {append text " " $arg}
334    fmt_lst_item $text
335}
336proc fmt_tkoption_def {name dbname dbclass} {
337    set    text ""
338    append text "Command-Line Switch:\t[fmt_option $name][tag br]\n"
339    append text "Database Name:\t[bold $dbname optdbname][tag br]\n"
340    append text "Database Class:\t[bold $dbclass optdbclass][tag br]\n"
341    fmt_lst_item $text
342}
343
344################################################################
345
346proc fmt_example_begin {} {
347    return [para_close]\n[tag* pre class example]
348}
349proc fmt_example_end   {} {
350    return [tag/ pre]\n[para_open]
351}
352proc fmt_example {code} {
353    return "[fmt_example_begin][fmt_plain_text $code][fmt_example_end]"
354}
355
356################################################################
357
358proc fmt_arg  {text} { italic $text                arg }
359proc fmt_cmd  {text} { bold   [XrefMatch $text sa] cmd }
360proc fmt_emph {text} { em     $text }
361proc fmt_opt  {text} { span   "?$text?" opt }
362
363proc fmt_comment {text} {ht_comment $text}
364proc fmt_sectref {title {id {}}} {
365    global SectionNames
366    if {$id == {}} {
367	set id [c_sectionId $title]
368    }
369    if {[info exists SectionNames($id)]} {
370    	return [span [link $title "#$id"] sectref]
371    } else {
372	return [bold $title sectref]
373    }
374}
375
376proc fmt_syscmd  {text} {bold [XrefMatch $text sa] syscmd}
377proc fmt_method  {text} {bold $text method}
378proc fmt_option  {text} {bold $text option}
379proc fmt_widget  {text} {bold $text widget}
380proc fmt_fun     {text} {bold $text function}
381proc fmt_type    {text} {bold $text type}
382proc fmt_package {text} {bold [XrefMatch $text sa kw] package}
383proc fmt_class   {text} {bold $text class}
384proc fmt_var     {text} {bold $text variable}
385proc fmt_file    {text} {return "\"[bold $text file]\""}
386proc fmt_namespace     {text} {bold $text namespace}
387proc fmt_uri     {text {label {}}} {
388    if {$label == {}} {set label $text}
389    return [link $label $text]
390}
391
392proc fmt_image {text {label {}}} {
393    # text = symbolic name of the image.
394
395    set img [dt_imgdst $text {png gif jpg}]
396
397    if {$label eq {}} {
398	set label $text
399    }
400
401    if {$img ne {}} {
402	return [imagelink $label [LinkTo $img [LinkHere]]]
403    }
404
405    if {[regexp -- {^http://} $text] ||
406	[regexp -- {^ftp://}  $text]} {
407	return [imagelink $label $text]
408    }
409
410    #puts_stderr here:\t[LinkHere]
411    #puts_stderr dest:\t$img
412    #puts_stderr rela:\t[LinkTo $img [LinkHere]]
413    #puts_stderr
414
415    return [strong "Image: $label"]
416}
417
418proc fmt_term    {text} {italic [XrefMatch $text kw sa] term}
419proc fmt_const   {text} {bold $text const}
420
421proc fmt_mdash {} { return "[markup &]mdash;" }
422proc fmt_ndash {} { return "[markup &]ndash;" }
423
424################################################################
425
426global sec_is_open
427set    sec_is_open 0
428
429proc sec_open  {id} {
430    global sec_is_open
431    set res [para_close][subsec_close][sec_close][tag* div id $id class section]
432    set sec_is_open 1
433    return $res
434}
435
436proc sec_close {}   {
437    global sec_is_open
438    if {!$sec_is_open} {return ""}
439    set sec_is_open 0
440    return [tag/ div]\n
441}
442
443################################################################
444
445global subsec_is_open
446set    subsec_is_open 0
447
448proc subsec_open  {id} {
449    global subsec_is_open
450    set res [para_close][subsec_close][tag* div id $id class subsection]
451    set subsec_is_open 1
452    return $res
453}
454
455proc subsec_close {}   {
456    global subsec_is_open
457    if {!$subsec_is_open} {return ""}
458    set subsec_is_open 0
459    return [tag/ div]\n
460}
461
462################################################################
463
464# Piece of html to close the previous list element, if any.
465# Saved on the list stack
466
467global prev_litem_close
468set    prev_litem_close   {}
469
470proc litc_getandclear {} {
471    global prev_litem_close
472    set res $prev_litem_close
473    set prev_litem_close {}
474    return $res
475}
476
477proc litc_set {value} {
478    global prev_litem_close
479    set prev_litem_close $value
480    return
481}
482
483################################################################
484
485global para_is_open
486set    para_is_open 0
487
488proc para_open {} {
489    global para_is_open
490    set res [para_close][tag p]
491    set para_is_open 1
492    return $res
493}
494
495proc para_close {} {
496    global para_is_open
497    if {!$para_is_open} {return ""}
498    set para_is_open 0
499    return [tag/ p]
500}
501
502################################################################
503
504global xref ; array set xref {}
505
506global    __var
507array set __var {
508    meta   {}
509    header {}
510    footer {}
511    xref   {}
512    raw    0
513}
514proc Get               {varname}      {global __var ; return $__var($varname)}
515proc fmt_listvariables {}             {global __var ; return [array names __var]}
516proc fmt_varset        {varname text} {
517    global __var
518    if {![info exists __var($varname)]} {return -code error "Unknown engine variable \"$varname\""}
519    set __var($varname) $text
520    return
521}
522
523# Engine parameter handling
524proc Extend {v _ by} {
525    set html [Get $by]
526    if {$html == {}} { return 0 }
527    upvar 1 $v text
528    append text [markup $html] \n
529    return 1
530}
531
532global defaultstyle
533set    defaultstyle {
534    HTML {
535	background: 	#FFFFFF;
536	color: 		black;
537    }
538    BODY {
539	background: 	#FFFFFF;
540	color:	 	black;
541    }
542    DIV.doctools {
543	margin-left:	10%;
544	margin-right:	10%;
545    }
546    DIV.doctools H1,DIV.doctools H2 {
547	margin-left:	-5%;
548    }
549    H1, H2, H3, H4 {
550	margin-top: 	1em;
551	font-family:	sans-serif;
552	font-size:	large;
553	color:		#005A9C;
554	background: 	transparent;
555	text-align:		left;
556    }
557    H1.title {
558	text-align: center;
559    }
560    UL,OL {
561	margin-right: 0em;
562	margin-top: 3pt;
563	margin-bottom: 3pt;
564    }
565    UL LI {
566	list-style: disc;
567    }
568    OL LI {
569	list-style: decimal;
570    }
571    DT {
572	padding-top: 	1ex;
573    }
574    UL.toc,UL.toc UL, UL.toc UL UL {
575	font:		normal 12pt/14pt sans-serif;
576	list-style:	none;
577    }
578    LI.section, LI.subsection {
579	list-style: 	none;
580	margin-left: 	0em;
581	text-indent:	0em;
582	padding: 	0em;
583    }
584    PRE {
585	display: 	block;
586	font-family:	monospace;
587	white-space:	pre;
588	margin:		0%;
589	padding-top:	0.5ex;
590	padding-bottom:	0.5ex;
591	padding-left:	1ex;
592	padding-right:	1ex;
593	width:		100%;
594    }
595    PRE.example {
596	color: 		black;
597	background: 	#f5dcb3;
598	border:		1px solid black;
599    }
600    UL.requirements LI, UL.syntax LI {
601	list-style: 	none;
602	margin-left: 	0em;
603	text-indent:	0em;
604	padding:	0em;
605    }
606    DIV.synopsis {
607	color: 		black;
608	background: 	#80ffff;
609	border:		1px solid black;
610	font-family:	serif;
611	margin-top: 	1em;
612	margin-bottom: 	1em;
613    }
614    UL.syntax {
615	margin-top: 	1em;
616	border-top:	1px solid black;
617    }
618    UL.requirements {
619	margin-bottom: 	1em;
620	border-bottom:	1px solid black;
621    }
622}
623
624################################################################
625
626proc XrefInit {} {
627    global xref __var
628    foreach item $__var(xref) {
629	foreach {pattern fname fragment} $item break
630	set fname_ref [dt_fmap $fname]
631	if {$fragment != {}} {append fname_ref #$fragment}
632	set xref($pattern) $fname_ref
633    }
634    proc XrefInit {} {}
635    return
636}
637
638proc XrefMatch {word args} {
639    global xref
640
641    foreach ext $args {
642	if {$ext != {}} {
643	    if {[info exists xref($ext,$word)]} {
644		return [XrefLink $xref($ext,$word) $word]
645	    }
646	}
647    }
648    if {[info exists xref($word)]} {
649	return [XrefLink $xref($word) $word]
650    }
651
652    # Convert the word to all-lower case and then try again.
653
654    set lword [string tolower $word]
655
656    foreach ext $args {
657	if {$ext != {}} {
658	    if {[info exists xref($ext,$lword)]} {
659		return [XrefLink $xref($ext,$lword) $word]
660	    }
661	}
662    }
663    if {[info exists xref($lword)]} {
664	return [XrefLink $xref($lword) $word]
665    }
666
667    return $word
668}
669
670proc XrefList {list {ext {}}} {
671    set res [list]
672    foreach w $list {lappend res [XrefMatch $w $ext]}
673    return $res
674}
675
676proc LinkHere {} {
677    return [dt_fmap [dt_mainfile]]
678}
679
680proc LinkTo {dest here} {
681    # Ensure that the link is properly done relative to this file!
682
683    set save $dest
684
685    #puts_stderr "XrefLink $dest $label"
686
687    set here [file split $here]
688    set dest [file split $dest]
689
690    #puts_stderr "XrefLink < $here"
691    #puts_stderr "XrefLink > $dest"
692
693    while {[string equal [lindex $dest 0] [lindex $here 0]]} {
694	set dest [lrange $dest 1 end]
695	set here [lrange $here 1 end]
696	if {[llength $dest] == 0} {break}
697    }
698    set ul [llength $dest]
699    set hl [llength $here]
700
701    if {$ul == 0} {
702	set dest [lindex [file split $save] end]
703    } else {
704	while {$hl > 1} {
705	    set dest [linsert $dest 0 ..]
706	    incr hl -1
707	}
708	set dest [eval file join $dest]
709    }
710
711    #puts_stderr "XrefLink --> $dest"
712    return $dest
713}
714
715proc XrefLink {dest label} {
716    # Ensure that the link is properly done relative to this file!
717
718    set here [LinkHere]
719    set dest [LinkTo $dest $here]
720
721    if {[string equal $dest [lindex [file split $here] end]]} {
722	# Suppress self-referential links, i.e. links made from the
723	# current file to itself. Note that links to specific parts of
724	# the current file are not suppressed, only exact links.
725	return $label
726    }
727    return [link $label $dest]
728}
729