# -*- tcl -*- # # -- Engine to convert a doctools document into plain text. # # Copyright (c) 2003-2019 Andreas Kupries # # ## ### ##### ######## ############# ## Load shared code and modify it to our needs. dt_source _common.tcl dt_source _text.tcl proc c_copyrightsymbol {} {return "(c)"} # # ## ### ##### ######## ## Special manpage contexts # example = if present, context is for an example # exenv = if present, reference to example variant of current context proc Example! {} { CAttrSet example . } proc Example? {} { CAttrHas example } proc NewExample {} { return [ContextNew Example { VerbatimOn ; Example! ; Prefix! "| " }] ; # {} } proc Example {} { if {![CAttrHas exenv]} { ContextPush set exenv [NewExample] ContextPop CAttrSet exenv $exenv ContextCommit } return [CAttrGet exenv] } proc NewList {what} { # List contexts # Per list type several contexts are required. #puts_stderr "LIST OUT [CAttrName] NewList $what" switch -exact -- $what { enumerated {NewOrderedList} itemized {NewUnorderedList} arguments - commands - options - tkoptions - definitions {NewDefinitionList} } #puts_stderr "LIST INN [CAttrName]" return } proc NewUnorderedList {} { # Itemized list - unordered list - bullet # 1. Base context provides indentation. # 2. First paragraph in a list item. # 3. All other paragraphs. ContextPush set base [ContextNew Itemized { LC MarginIn set bullet [IBullet] }] ; # {} set first [ContextNew First { List! bullet $bullet [BlankMargin] }] ; ContextSet $base ; # {} set next [ContextNew Next { MarginIn }] ; ContextSet $base ; # {} OUL $first $next ContextCommit ContextPop ContextSet $base return } proc NewOrderedList {} { # Ordered list - enumeration - enum # 1. Base context provides indentation. # 2. First paragraph in a list item. # 3. All other paragraphs. ContextPush set base [ContextNew Enumerated { LC MarginIn set bullet [EBullet] }] ; # {} set first [ContextNew First { List! enum $bullet [BlankMargin] }] ; ContextSet $base ; # {} set next [ContextNew Next { MarginIn }] ; ContextSet $base ; # {} OUL $first $next ContextCommit ContextPop ContextSet $base return } proc NewDefinitionList {} { # Definition list - terms & definitions # 1. Base context provides indentation. # 2. Term context # 3. Definition context ContextPush set base [ContextNew Definitions { LC MarginIn }] ; # {} set term [ContextNew Term { VerbatimOn }] ; ContextSet $base ; # {} set def [ContextNew Def { MarginIn }] ; ContextSet $base ; # {} TD $term $def ContextCommit ContextPop ContextSet $base return } # # ## ### ##### ######## ## proc LC {} { # Clear inherited list type information from the current context CAttrUnset _first CAttrUnset _next CAttrUnset _term CAttrUnset _definition } proc OUL {f n} { CAttrSet _first $f CAttrSet _next $n } proc TD {t d} { CAttrSet _term $t CAttrSet _definition $d } proc IsPara {} { CAttrHas _next } proc Paras {} { global __pcount ; set __pcount } proc PAdvance {} { global __pcount ; incr __pcount 1 #puts_stderr " ZZZ/ItemParas/Advance:$__pcount" } proc PReset {} { #puts_stderr " ZZZ/ItemParas/Reset" global __pcount ; set __pcount 0 } global __pcount ; set __pcount 0 global __pcstack ; set __pcstack {} proc PSave {} { global __pcount __pcstack lappend __pcstack $__pcount PReset } proc PRestore {} { global __pcount __pcstack set __pcount [lindex $__pcstack end] set __pcstack [lrange $__pcstack 0 end-1] #puts_stderr " ZZZ/ItemParas/Restore:$__pcount" return } proc First {} { CAttrGet _first } proc Other {} { CAttrGet _next } proc Term {} { CAttrGet _term } proc Def {} { CAttrGet _definition } proc IsDef {} { CAttrHas _definition } # # ## ### ##### ######## ## proc CloseCurrent {} { if {[IsDef]} { #puts_stderr " ZZZ/CloseCurrent/Definitions" # Currently in a definition list. CloseParagraph [Def] } elseif {[IsPara]} { #puts_stderr " ZZZ/CloseCurrent/UOL" # Currently in an (un)ordered list. #puts_stderr " ZZZ/ItemParas/[Paras]" if {![Paras]} { # No paragraphs yet, this is first in the item if {[CloseParagraph [First]]} PAdvance } else { # More paragraphs in the item if {[CloseParagraph [Other]]} PAdvance } } else { #puts_stderr " ZZZ/CloseCurrent/Plain" # Currently in a regular paragraph CloseParagraph } } proc GetCurrent {} { if {[IsDef]} { #puts_stderr " ZZZ/GetCurrent/Definitions" # Currently in a definition list. return [Def] } elseif {[IsPara]} { #puts_stderr " ZZZ/GetCurrent/UOL" # Currently in an (un)ordered list. #puts_stderr " ZZZ/ItemParas/[Paras]" if {![Paras]} { set res [First] } else { set res [Other] } PAdvance return $res } else { #puts_stderr " ZZZ/GetCurrent/Plain" # Currently in a regular paragraph return {} } } # # ## ### ##### ######## ## c_holdBuffers require rename fmt_initialize BaseInitialize proc fmt_initialize {} {BaseInitialize ; TextInitialize ; return} proc fmt_postprocess {text} { text_postprocess $text } # # ## ### ##### ######## ## Implementations of the formatting commands. c_pass 1 fmt_plain_text {text} NOP c_pass 2 fmt_plain_text {text} { text_plain_text $text } c_pass 1 fmt_manpage_begin {title section version} NOP c_pass 2 fmt_manpage_begin {title section version} { Off set module [dt_module] set shortdesc [c_get_module] set description [c_get_title] set hdr [list] lappend hdr "$title - $shortdesc" lappend hdr [c_provenance] lappend hdr "[string trimleft $title :]($section) $version $module \"$shortdesc\"" set hdr [join $hdr \n] Text $hdr CloseParagraph [Verbatim] Section NAME Text "$title - $description" CloseParagraph return } c_pass 1 fmt_moddesc {desc} {c_set_module $desc} c_pass 2 fmt_moddesc {desc} NOP c_pass 1 fmt_titledesc {desc} {c_set_title $desc} c_pass 2 fmt_titledesc {desc} NOP c_pass 1 fmt_copyright {desc} {c_set_copyright $desc} c_pass 2 fmt_copyright {desc} NOP c_pass 1 fmt_manpage_end {} NOP c_pass 2 fmt_manpage_end {} { set sa [c_xref_seealso] set kw [c_xref_keywords] set ca [c_xref_category] set ct [c_get_copyright] CloseParagraph if {[llength $sa] > 0} {Section {SEE ALSO} ; Text [join [lsort $sa] ", "] ; CloseParagraph} if {[llength $kw] > 0} {Section KEYWORDS ; Text [join [lsort $kw] ", "] ; CloseParagraph} if {$ca ne ""} {Section CATEGORY ; Text $ca ; CloseParagraph} if {$ct != {}} {Section COPYRIGHT ; Text $ct ; CloseParagraph [Verbatim]} return } c_pass 1 fmt_section {name {id {}}} NOP c_pass 2 fmt_section {name {id {}}} {CloseParagraph ; Section $name ; return} c_pass 1 fmt_subsection {name {id {}}} NOP c_pass 2 fmt_subsection {name {id {}}} {CloseParagraph ; Subsection $name ; return} c_pass 1 fmt_para {} NOP c_pass 2 fmt_para {} { CloseCurrent #puts_stderr "AAA/fmt_para/START" return } # NL is an alias of PARA # See also fmt_example_begin c_pass 1 fmt_nl {} NOP c_pass 2 fmt_nl {} {CloseCurrent ; return } c_pass 2 fmt_require {pkg {version {}}} NOP c_pass 1 fmt_require {pkg {version {}}} { set result "package require $pkg" if {$version != {}} {append result " $version"} c_hold require $result return } c_pass 1 fmt_usage {cmd args} {c_hold synopsis "$cmd [join $args " "]"} c_pass 2 fmt_usage {cmd args} NOP c_pass 1 fmt_call {cmd args} {c_hold synopsis "$cmd [join $args " "]"} c_pass 2 fmt_call {cmd args} {fmt_lst_item "$cmd [join $args " "]"} c_pass 1 fmt_description {id} NOP c_pass 2 fmt_description {id} { On set syn [c_held synopsis] set req [c_held require] if {$syn != {} || $req != {}} { Section SYNOPSIS if {($req != {}) && ($syn != {})} { Text $req\n\n$syn } else { if {$req != {}} {Text $req} if {$syn != {}} {Text $syn} } CloseParagraph [Verbatim] } Section DESCRIPTION return } # # ## ### ##### ######## ## c_pass 1 fmt_list_begin {what {hint {}}} NOP c_pass 2 fmt_list_begin {what {hint {}}} { CloseCurrent #puts_stderr "AAA/fmt_list_begin/Setup $what" ContextPush ;# push outer NewList $what ;# base/controller of current/new/inner Off PSave #puts_stderr "AAA/fmt_list_begin/Enter" return } c_pass 1 fmt_list_end {} NOP c_pass 2 fmt_list_end {} { CloseCurrent #puts_stderr "AAA/fmt_list_end/Exit" ContextPop ;# return to outer PRestore #puts_stderr "AAA/fmt_list_end/Done" return } c_pass 1 fmt_lst_item {text} NOP c_pass 2 fmt_lst_item {text} { if {[IsOff]} { On } else { CloseParagraph [Def] } #puts_stderr "AAA/fmt_lst_item/(($text))" Text $text CloseParagraph [Term] #puts_stderr "AAA/fmt_lst_item/Done" return } c_pass 1 fmt_bullet {} NOP c_pass 2 fmt_bullet {} { if {[IsOff]} { On } else { CloseCurrent } #puts_stderr "AAA/fmt_bullet/START" PReset return } c_pass 1 fmt_enum {} NOP c_pass 2 fmt_enum {} { if {[IsOff]} { On } else { CloseCurrent } #puts_stderr "AAA/fmt_enum/START" PReset return } c_pass 1 fmt_cmd_def {command} NOP c_pass 2 fmt_cmd_def {command} {fmt_lst_item [fmt_cmd $command]} c_pass 1 fmt_arg_def {type name {mode {}}} NOP c_pass 2 fmt_arg_def {type name {mode {}}} { set text "$type [fmt_arg $name]" if {$mode != {}} {append text " ($mode)"} fmt_lst_item $text return } c_pass 1 fmt_opt_def {name {arg {}}} NOP c_pass 2 fmt_opt_def {name {arg {}}} { set text [fmt_option $name] if {$arg != {}} {append text " $arg"} fmt_lst_item $text return } c_pass 1 fmt_tkoption_def {name dbname dbclass} NOP c_pass 2 fmt_tkoption_def {name dbname dbclass} { set text "" append text "Command-Line Switch:\t[fmt_option $name]\n" append text "Database Name:\t[Strong $dbname]\n" append text "Database Class:\t[Strong $dbclass]\n" fmt_lst_item $text } # # ## ### ##### ######## ## c_pass 1 fmt_example_begin {} NOP c_pass 2 fmt_example_begin {} { #puts_stderr "AAA/fmt_example_begin" CloseCurrent #puts_stderr "AAA/fmt_example_begin/Done" return } c_pass 1 fmt_example_end {} NOP c_pass 2 fmt_example_end {} { #puts_stderr "AAA/fmt_example_end" #puts_stderr AAA/EIN=[string map [list \1 \\1 \t \\t { } \\s] <<[join [split [Text?] \n] >>\n<<]>>] # Flush markup from preceding commands into the text buffer. TextPlain "" TextTrimLeadingSpace # Look for and convert continuation lines protected from Tcl # substitution into a regular continuation line. set t [string map [list \\\\\n \\\n] [Text?]] TextClear Text $t #puts_stderr AAA/EFT=[string map [list \1\\1 \t \\t { } \\s] <<[join [split [Text?] \n] >>\n<<]>>] set penv [GetCurrent] if {$penv != {}} { # In a list we save the current list context, activate the # proper paragraph context and create its example # variant. After closing the paragraph using the example we # restore and reactivate the list context. ContextPush ContextSet $penv #if {[CloseParagraph [Example]]} PAdvance CloseParagraph [Example] ContextPop } else { # In a regular paragraph we simple close the example #if {[CloseParagraph [Example]]} PAdvance CloseParagraph [Example] } #puts_stderr "AAA/fmt_example_end/Done" return } c_pass 1 fmt_example {code} NOP c_pass 2 fmt_example {code} { fmt_example_begin fmt_plain_text $code fmt_example_end return } # # ## ### ##### ######## ## Visual markup of words and phrases. proc fmt_arg {text} { return $text } proc fmt_cmd {text} { return $text } proc fmt_emph {text} { Em $text } proc fmt_opt {text} { return "?$text?" } proc fmt_comment {text} { return } proc fmt_sectref {text {label {}}} { if {![string length $label]} {set label $text} return "-> $text" } proc fmt_syscmd {text} { Strong $text } proc fmt_method {text} { return $text } proc fmt_option {text} { return $text } proc fmt_widget {text} { Strong $text } proc fmt_fun {text} { Strong $text } proc fmt_type {text} { Strong $text } proc fmt_package {text} { Strong $text } proc fmt_class {text} { Strong $text } proc fmt_var {text} { Strong $text } proc fmt_file {text} { return "\"$text\"" } proc fmt_namespace {text} { Strong $text } proc fmt_uri {text {label {}}} { if {$label == {}} { # Without label we use the link directly as part of the text. return "" } else { return "[Em $label] " } } proc fmt_image {text {label {}}} { # text = symbolic name of the image. set img [dt_imgdata $text {txt}] if {$img != {}} { if {$label == {}} { return "IMAGE: $text" } else { return "IMAGE: $text $label" } } return $img } proc fmt_term {text} { Em $text } proc fmt_const {text} { Strong $text } proc fmt_mdash {} { return " --- " } proc fmt_ndash {} { return " -- " } # # ## ### ##### ######## return