Tcl Library Source Code

proc use_bg {} {
    set c [bgcolor]
    #puts stderr "using $c"
    if {$c == {}} {return ""}
    return bgcolor=$c
}

proc MakeLink {l t} { link $l $t }

proc nbsp   {}         {return [markup " "]}
proc p      {}         {return [markup <p>]}
proc ptop   {}         {return [markup "<p valign=top>"]}
proc td     {}         {return [markup "<td [use_bg]>"]}
proc trtop  {}         {return [markup "<tr valign=top [use_bg]>"]}
proc tr     {}         {return [markup "<tr            [use_bg]>"]}

    TextTrimLeadingSpace
    CloseParagraph [Verbatim]
}

##
# # ## ### ##### ########
##

proc MakeLink {l t} { ALink $t $l } ;# - xref - todo: consolidate

proc ALink {dst label} { return "\[$label]($dst)" }

proc SetAnchor {text {name {}}} {
    if {$name == {}} { set name [Anchor $text] }
    return "<a name='$name'></a>$text"
}

# -*- tcl -*-
##
# Shared code for the management of cross-references between
# documents. Origin in HTML. Other user: Markdown.
#
# Copyright (c) 2001,2019 Andreas Kupries <[email protected]>

# Hook:
# - MakeLink {label target} - Format specific
# - GetXref                 - Engine parameter access

# # ## ### ##### ######## ############# #####################
## API

proc XrefInit {} {
    global xref
    foreach item [GetXref] {
	foreach {pattern fname fragment} $item break
	set fname_ref [dt_fmap $fname]
	if {$fragment != {}} {append fname_ref #$fragment}
	set xref($pattern) $fname_ref
    }
    proc XrefInit {} {}
    return
}

proc XrefMatch {word args} {
    global xref

    foreach ext $args {
	if {$ext != {}} {
	    if {[info exists xref($ext,$word)]} {
		return [XrefLink $xref($ext,$word) $word]
	    }
	}
    }
    if {[info exists xref($word)]} {
	return [XrefLink $xref($word) $word]
    }

    # Convert the word to all-lower case and then try again.

    set lword [string tolower $word]

    foreach ext $args {
	if {$ext != {}} {
	    if {[info exists xref($ext,$lword)]} {
		return [XrefLink $xref($ext,$lword) $word]
	    }
	}
    }
    if {[info exists xref($lword)]} {
	return [XrefLink $xref($lword) $word]
    }

    return $word
}

proc XrefList {list {ext {}}} {
    set res [list]
    foreach w $list {lappend res [XrefMatch $w $ext]}
    return $res
}

proc XrefLink {dest label} {
    # Ensure that the link is properly done relative to this file!

    set here [LinkHere]
    set dest [LinkTo $dest $here]

    if {[string equal $dest [lindex [file split $here] end]]} {
	# Suppress self-referential links, i.e. links made from the
	# current file to itself. Note that links to specific parts of
	# the current file are not suppressed, only exact links.
	return $label
    }
    return [MakeLink $label $dest]
}

# # ## ### ##### ######## ############# #####################
## Internals

proc LinkHere {} {
    return [dt_fmap [dt_mainfile]]
}

proc LinkTo {dest here} {
    # Ensure that the link is properly done relative to this file!

    set save $dest

    #puts_stderr "XrefLink $dest $label"

    set here [file split $here]
    set dest [file split $dest]

    #puts_stderr "XrefLink < $here"
    #puts_stderr "XrefLink > $dest"

    while {[string equal [lindex $dest 0] [lindex $here 0]]} {
	set dest [lrange $dest 1 end]
	set here [lrange $here 1 end]
	if {[llength $dest] == 0} {break}
    }
    set ul [llength $dest]
    set hl [llength $here]

    if {$ul == 0} {
	set dest [lindex [file split $save] end]
    } else {
	while {$hl > 1} {
	    set dest [linsert $dest 0 ..]
	    incr hl -1
	}
	set dest [eval file join $dest]
    }

    #puts_stderr "XrefLink --> $dest"
    return $dest
}

# # ## ### ##### ######## ############# #####################
## State

global xref ; array set xref {}

##
# # ## ### ##### ######## ############# #####################
return

# a manpage based upon HTML markup.
#
################################################################
################################################################

dt_source _common.tcl   ; # Shared code
dt_source _html.tcl     ; # HTML basic formatting
dt_source _xref.tcl     ; # xref management

proc c_copyrightsymbol {} {return "[markup "&"]copy;"}

proc bgcolor {} {return ""}
proc border  {} {return 0}
proc Year    {} {clock format [clock seconds] -format %Y}

    if {!$para_is_open} {return ""}
    set para_is_open 0
    return [tag/ p]
}

################################################################

proc GetXref {} { Get xref } ;# xref access to engine parameters

global    __var
array set __var {
    meta   {}
    header {}
    footer {}
    xref   {}

    UL.doctools_requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
}

################################################################

# -*- tcl -*-
# Convert a doctools document into markdown formatted text
#
# Copyright (c) 2019 Andreas Kupries <[email protected]>

# Note: While markdown is a text format its intended target is HTML,
# making its formatting nearer to that with the ability to set anchors
# and refer to them, linkage in general.








# # ## ### ##### ######## #############
## Load shared code and modify it to our needs.

dt_source _common.tcl
dt_source _text.tcl
dt_source fmt.text
dt_source _markdown.tcl
dt_source _xref.tcl

rename PostProcess PostProcessT
proc PostProcess {text} {
    string map [list [LB] "  \n"] [PostProcessT $text]
}

proc LB  {} { return "\1\n" }

    if {[c_sectionKnown $id]} {
    	return [ALink "#$id" $title]
    } else {
	return [Strong $title]
    }
}

c_pass 1 fmt_usage {cmd args} {
    set text [join [linsert $args 0 $cmd] " "]
    c_hold synopsis "$text[LB.]"
}

c_pass 1 fmt_call  {cmd args} {
    set text [join [linsert $args 0 $cmd] " "]
    set dest "#[c_cnext]"
    c_hold synopsis "[MakeLink $text $dest][LB.]"
}
c_pass 2 fmt_call {cmd args} {
    set text [join [linsert $args 0 $cmd] " "]
    return [fmt_lst_item [SetAnchor $text [c_cnext]]]
}

c_pass 1 fmt_require {pkg {version {}}} {
    set result "package require $pkg"
    if {$version != {}} {append result " $version"}
    c_hold require "$result  "
    return
}

c_pass 2 fmt_tkoption_def {name dbname dbclass} {
    set    text ""
    append text "Command-Line Switch:\t[fmt_option $name][LB]"
    append text "Database Name:\t[Strong $dbname][LB]"
    append text "Database Class:\t[Strong $dbclass]\n"
    fmt_lst_item $text
}

proc fmt_syscmd  {text} { Strong [XrefMatch $text sa] }
proc fmt_package {text} { Strong [XrefMatch $text sa kw] }
proc fmt_term    {text} { Em     [XrefMatch $text kw sa] }

proc fmt_arg     {text} { Em     $text }
proc fmt_cmd     {text} { Strong [XrefMatch $text sa] }
proc fmt_method  {text} { Strong $text }
proc fmt_option  {text} { Strong $text }

proc fmt_uri {text {label {}}} {
    if {$label == {}} { set label $text }
    ALink $text $label
}

	    CloseCurrent
	}
    }

    return $img
}

c_pass 1 fmt_manpage_begin {title section version} {c_cinit ; c_clrSections ; return}
c_pass 2 fmt_manpage_begin {title section version} {
    Off
    XrefInit
    c_cinit

    set module      [dt_module]
    set shortdesc   [c_get_module]
    set description [c_get_title]

    MDComment  "$title - $shortdesc"
    MDComment  [c_provenance]
    MDComment  "[string trimleft $title :]($section) $version $module \"$shortdesc\""

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]} { Special {SEE ALSO} see-also  [join [XrefList [lsort $sa] sa] ", "] }
    if {[llength $kw]} { Special KEYWORDS   keywords  [join [XrefList [lsort $kw] kw] ", "] }
    if {$ca ne ""}     { Special CATEGORY   category  $ca                     }
    if {$ct != {}}     { Special COPYRIGHT  copyright $ct [Verbatim]          }
    return
}

proc c_get_copyright {} {
    return [join [c_get_copyright_r] [LB]]

	# level in {1,2}, 1 = section, 2 = subsection
	Text [ALink "#$id" $name]
	CloseParagraph [lindex $toc $level]
    }

    return
}

# # ## ### ##### ########
## Engine Parameters

proc GetXref {} { Get xref } ;# xref access to engine parameters

global    __var
array set __var {
    xref   {}
}
proc Get               {varname}      {global __var ; return $__var($varname)}
proc fmt_listvariables {}             {global __var ; return [array names __var]}
proc fmt_varset        {varname text} {
    global __var
    if {![info exists __var($varname)]} {
	return -code error "Unknown engine variable \"$varname\""
    }
    set __var($varname) $text
    return
}

##
# # ## ### ##### ########
return

  -  [Description](#section1)

  -  [Copyright](#copyright)

# <a name='synopsis'></a>SYNOPSIS

[a-command](#1)  

# <a name='description'></a>DESCRIPTION

OK

  - integer *argument-1*

    elucidation

  - term

    definition

  - <a name='1'></a>a-command

    semantic

  1. A

  1. B

# <a name='synopsis'></a>SYNOPSIS

package require AAA  
package require BBB VVV  
package require CCC ?VVV?  

[CMDNAME ...](#1)  
[CMDNAME ...](#2)  
[CMDNAME ...](#3)  

# <a name='description'></a>DESCRIPTION

  - __NAME__

    DESCRIPTION ::__Command__::

        DESCRIPTION ::__Method__::

  - TERM

    DESCRIPTION

  - <a name='1'></a>CMDNAME ...

    DESCRIPTION ::__Namespace__::

      * TYPE *NAME*

        DESCRIPTION ::*Argument*::

      * TYPE *NAME*

        DESCRIPTION ::__Option__::

      * TYPE *NAME* (MODE)

        DESCRIPTION ::?Optional?::

            THE ARGUMENT IS USED IN THIS
            AND/OR THAT MANNER

  - <a name='2'></a>CMDNAME ...

    DESCRIPTION ::__Package__::

  - <a name='3'></a>CMDNAME ...

    DESCRIPTION ::__SystemCommand__::

      * __NAME__

        DESCRIPTION ::*Term*::