Tcl Library Source Code

[//000000001]: # (markdown \- Markdown to HTML Converter)
[//000000002]: # (Generated from file 'markdown\.man' by tcllib/doctools with format 'markdown')
[//000000003]: # (markdown\(n\) 1\.1\.1 tcllib "Markdown to HTML Converter")

<hr> [ <a href="../../../../toc.md">Main Table Of Contents</a> &#124; <a
href="../../../toc.md">Table Of Contents</a> &#124; <a
href="../../../../index.md">Keyword Index</a> &#124; <a
href="../../../../toc0.md">Categories</a> &#124; <a
href="../../../../toc1.md">Modules</a> &#124; <a
href="../../../../toc2.md">Applications</a> ] <hr>

  - [Bugs, Ideas, Feedback](#section2)

  - [Category](#category)

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

package require Tcl 8\.5  
package require Markdown 1\.1\.1  
package require textutil ?0\.8?  

[__::Markdown::convert__ *markdown*](#1)  
[__::Markdown::register__ *langspec* *converter*](#2)  
[__::Markdown::get\_lang\_counter__](#3)  
[__::Markdown::reset\_lang\_counter__](#4)  

'\"
'\" Generated from file 'markdown\&.man' by tcllib/doctools with format 'nroff'
'\"
.TH "markdown" n 1\&.1\&.1 tcllib "Markdown to HTML Converter"
.\" The -*- nroff -*- definitions below are for supplemental macros used
.\" in Tcl/Tk manual entries.
.\"
.\" .AP type name in/out ?indent?
.\"	Start paragraph describing an argument to a library procedure.
.\"	type is type of argument (int, etc.), in/out is either "in", "out",
.\"	or "in/out" to describe whether procedure reads or modifies arg,

..
.BS
.SH NAME
markdown \- Converts Markdown text to HTML
.SH SYNOPSIS
package require \fBTcl  8\&.5\fR
.sp
package require \fBMarkdown  1\&.1\&.1\fR
.sp
package require \fBtextutil  ?0\&.8?\fR
.sp
\fB::Markdown::convert\fR \fImarkdown\fR
.sp
\fB::Markdown::register\fR \fIlangspec\fR \fIconverter\fR
.sp

&#124; <a href="../../../toc.html">Table Of Contents</a>
&#124; <a href="../../../../index.html">Keyword Index</a>
&#124; <a href="../../../../toc0.html">Categories</a>
&#124; <a href="../../../../toc1.html">Modules</a>
&#124; <a href="../../../../toc2.html">Applications</a>
 ] <hr>
<div class="doctools">
<h1 class="doctools_title">markdown(n) 1.1.1 tcllib &quot;Markdown to HTML Converter&quot;</h1>
<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2>
<p>markdown - Converts Markdown text to HTML</p>
</div>
<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="doctools_toc">
<li class="doctools_section"><a href="#toc">Table Of Contents</a></li>
<li class="doctools_section"><a href="#synopsis">Synopsis</a></li>
<li class="doctools_section"><a href="#section1">Description</a></li>
<li class="doctools_section"><a href="#section2">Bugs, Ideas, Feedback</a></li>
<li class="doctools_section"><a href="#category">Category</a></li>
</ul>
</div>
<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="doctools_synopsis">
<ul class="doctools_requirements">
<li>package require <b class="pkgname">Tcl 8.5</b></li>
<li>package require <b class="pkgname">Markdown 1.1.1</b></li>
<li>package require <b class="pkgname">textutil <span class="opt">?0.8?</span></b></li>
</ul>
<ul class="doctools_syntax">
<li><a href="#1"><b class="cmd">::Markdown::convert</b> <i class="arg">markdown</i></a></li>
<li><a href="#2"><b class="cmd">::Markdown::register</b> <i class="arg">langspec</i> <i class="arg">converter</i></a></li>
<li><a href="#3"><b class="cmd">::Markdown::get_lang_counter</b></a></li>
<li><a href="#4"><b class="cmd">::Markdown::reset_lang_counter</b></a></li>

## Easy definition and initialization of test constraints.

proc InitializeTclTest {} {
    global tcltestinit
    if {[info exists tcltestinit] && $tcltestinit} return
    set tcltestinit 1

    proc ::tcltest::byConstraint {dict} {
	foreach {constraint value} $dict {
	    if {![testConstraint $constraint]} continue
	    return $value
	}
	return -code error "No result available. Failed to match any of the constraints ([join [lsort -dict [dict keys $dict]] ,])."
    }
    
    if {![package vsatisfies [package provide tcltest] 2.0]} {
	# Tcltest 2.0+ provides a documented public API to define and
	# initialize a test constraint. For earlier versions of the
	# package the user has to directly set a non-public undocumented
	# variable in the package's namespace. We create a command doing
	# this and emulating the public API.

    ::tcltest::testConstraint tcl8.5plus \
	[expr {[package vsatisfies [package provide Tcl] 8.5]}]

    ::tcltest::testConstraint tcl8.6plus \
	[expr {[package vsatisfies [package provide Tcl] 8.6]}]

    ::tcltest::testConstraint tcl8.6not10 \
	[expr { [package vsatisfies [package provide Tcl] 8.6] &&
	       ![package vsatisfies [package provide Tcl] 8.6.10]}]

    ::tcltest::testConstraint tcl8.6.10plus \
	[expr {[package vsatisfies [package provide Tcl] 8.6.10]}]

    ::tcltest::testConstraint tcl8.4minus \
	[expr {![package vsatisfies [package provide Tcl] 8.5]}]

    ::tcltest::testConstraint tcl8.5minus \
	[expr {![package vsatisfies [package provide Tcl] 8.6]}]

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

# hook.test -*- tcl -*-
#
#       This file contains the test suite for hook.tcl.
#
# Copyright (C) 2010 by Will Duquette
# Copyright (c) 2019 by Andreas Kupries
#
# See the file "license.terms" for information on usage and 
# redistribution of this file, and for a DISCLAIMER OF ALL 
# WARRANTIES.

#-----------------------------------------------------------------------

proc GetError {} {
    variable info

    return $info(errorList)
}







#-----------------------------------------------------------------------
# cget

test cget-1.1 {unknown option name} -body {
    hook cget -nonesuch
} -returnCodes {
    error

    hook configure -errorcommand ErrorCommand

    hook bind S1 <H1> O1 {error "simulated error"}
    hook call S1 <H1>
    GetError
} -cleanup {
    cleanup
} -result [tcltest::byConstraint {
    tcl8.6.10plus {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {::hook::call S1 <H1>}} -errorcode NONE}}}
    tcl8.6not10   {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {call S1 <H1>}} -errorcode NONE}}}
    tcl8.5minus   {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorcode NONE}}}
}]

test errorcommand-1.3 {handled errors don't break sequence of calls} -body {
    hook configure -errorcommand ErrorCommand

    TestBind  S1 <H1> O1
    hook bind S1 <H1> O2 {error "simulated error"}
    TestBind  S1 <H1> O3
    hook call S1 <H1>
    list [GetCalls] [GetError]
} -cleanup {
    cleanup
} -result [tcltest::byConstraint {
    tcl8.6.10plus {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {::hook::call S1 <H1>}} -errorcode NONE}}}}
    tcl8.6not10   {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {call S1 <H1>}} -errorcode NONE}}}}
    tcl8.5minus   {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorcode NONE}}}}
}]

test errorcommand-1.4 {-errorcommand handles other exceptions} -body {
    hook configure -errorcommand ErrorCommand

    hook bind S1 <H1> O1 {return -code break "simulated break"}
    hook call S1 <H1>
    GetError
} -cleanup {
    cleanup
} -result {{{S1 <H1> {} O1} {simulated break} {-code 3 -level 1}}}


#-----------------------------------------------------------------------
# -tracecommand

test tracecommand-1.1 {-tracecommand is called} -body {
    TestBind S1 <H1> O1
    TestBind S1 <H1> O2

    cleanup
} -result {{S1 <H1> {} {O1 O2}} {S2 <H2> {} O2} {S3 <H3> {} {}}}

#-----------------------------------------------------------------------
# Clean up and finish

::tcltest::cleanupTests
return

[vset VERSION 1.1.1]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin markdown n [vset VERSION]]
[moddesc   {Markdown to HTML Converter}]
[titledesc {Converts Markdown text to HTML}]
[category  {Text processing}]
[require Tcl 8.5]
[require Markdown [vset VERSION]]

                        if {$eoc} { break }

                        set line [lindex $lines $index]
                    }
                    set code_result [join $code_result \n]

                    append result <pre><code> $code_result </code></pre>
                }
                {^(?:(?:`{3,})|(?:~{3,}))\{?(\S+)?\}?\s*$} {
                    # FENCED CODE BLOCKS
                    set code_result {}
                    if {[string index $line 0] eq {`}} {
                        set end_match {^`{3,}\s*$}
                    } else {

    ## \private
    proc html_escape {text} {
        return [string map {& &amp; < &lt; > &gt; \" &quot;} $text]
    }
}

package provide Markdown 1.1.1
return

# -*- tcl -*-
# tool.test - Copyright (c) 2016 Sean Woods, Will DuQuette, Caius Project
# -------------------------------------------------------------------------
#-------------------------------------------------------------------------
# TITLE:
#    markdown.test
#
# PROJECT:

}

#-------------------------------------------------------------------------
# Setup

tcltest::testConstraint knownbug 0


# outdent text
#
# text   - A multi-line text string
#
# This command outdents a multi-line text string to the left margin.

proc outdent {text} {
    # FIRST, remove any leading blank lines
    regsub {\A(\s*\n)} $text "" text

    # NEXT, remove any trailing whitespace
    set text [string trimright $text]

    # NEXT, get the length of the leader on the first line.
    if {[regexp {\A(\s*)\S} $text dummy leader]} {

        # Remove the leader from the beginning of each indented
        # line, and update the string.
        regsub -all -line "^$leader" $text "" text
    }

    <h3>Heading 3</h3>

    <p>This is what he said. This is what she said. This is what
    he said. This is what she said.</p>

    <pre><code>import os
    os.path.listdir()</code></pre>


    <p>This is what he said. This is what she said. This is what
    he said. This is what she said.</p>
    </blockquote>

    <h2>Heading 2</h2>

    <p>This is what he said. This is what she said. This is what
    he said. This is what she said.</p>
    </blockquote>

    <p>This is a test.</p>
}



test convert-2.2 {refs} -body {
    convert {
        Find it [here][foo]!

        [foo]: http://example.com/  "Optional Title Here"
    }
} -result {
    <p>Find it <a href="http://example.com/" title="Optional Title Here">here</a>!</p>
}

test code-block-1.0 {basic code block render} -body {
    convert {
	pre code

	    in code

	post code
    }
} -result {
    <p>pre code</p>

    <pre><code>in code</code></pre>

    <p>post code</p>
}

#=========================================================================
# Tests related to other processors or test suites

#-------------------------------------------------------------------------
# Caius Markdown Tests
#

test caius-1.7 {indent test} -body {
    set md   [::tcltest::viewFile test/indent.md]
    set html [::tcltest::viewFile test/indent.html]
    cmp $html [Markdown::convert $md]
} -result {1}
}

#-------------------------------------------------------------------------
# mdtest: Bugs found while running michelf/mdtest


test mdtest-1.1 {AL: Auto links: & not escaped in URL} -body {
    convert {
        Auto-link with ampersand: <http://example.com/?foo=1&bar=2>
    }
} -result {
    <p>Auto-link with ampersand: <a href="http://example.com/?foo=1&amp;bar=2">http://example.com/?foo=1&amp;bar=2</a></p>

package ifneeded Markdown 1.1.1 [list source [file join $dir markdown.tcl]]

# -*- tcl -*-
# Testsuite string::token::shell
#
# Copyright (c) 2013,2019 by Andreas Kupries <[email protected]>
# All rights reserved.

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0

support {
    use      fileutil/fileutil.tcl  fileutil
    useLocal token.tcl              string::token
}
testing {
    useLocal token_shell.tcl string::token::shell
}







# -------------------------------------------------------------------------

test string-token-shell-1.0 "string token shell, wrong#args, not enough" -body {
    string token shell
} -returnCodes error -result [tcltest::byConstraint {
    tcl8.6.10plus {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
    tcl8.6not10   {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}
    tcl8.5minus   {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
}]

test string-token-shell-1.1 "string token shell, wrong#args, too many" -body {
    string token shell T X
} -returnCodes error -result [tcltest::byConstraint {
    tcl8.6.10plus {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
    tcl8.6not10   {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}
    tcl8.5minus   {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
}]

test string-token-shell-1.2 "string token shell, bad option" -body {
    string token shell -foo T
} -returnCodes error -result {Bad option -foo, expected one of -indices, or -partial}

test string-token-shell-1.3 "string token shell, wrong#args, too many" -body {
    string token shell -- T X
} -returnCodes error -result [tcltest::byConstraint {
    tcl8.6.10plus {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
    tcl8.6not10   {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}
    tcl8.5minus   {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}
}]

# -------------------------------------------------------------------------

foreach {n label line tokens} {
    0  empty               {}          {}
    1  leading-whitespace  {  }        {}
    2  plain-words         {a}         {a}

    }
    if {$err} {
	puts $logext "#Errors [mag][format %6d $err][rst]"
    } else {
	puts $logext "#Errors [format %6d $err]"
    }

    flush $logext

    =| "... Done"
    
    if {$alog} {
	# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	# Timings per testsuite
	=| "... Postprocessing per-testsuite timings ..."
	
	variable xtimes



	struct::matrix M
	M add columns 6

	M add row {Shell Module Testsuite Tests Seconds uSec/Test}
	M add row {===== ====== ========= ===== ======= =========}

	foreach item [lsort -decreasing -int -index 3 [lsort -dict -index 0 $xtimes]] {
	    foreach {k testnum delta score} $item break
	    M add row [linsert $k end $testnum $delta $score]
	}



	M add row {===== ====== ========= ===== ======= =========}


	puts $logtmt "\nTiming Table..."
	puts $logtmt [M format 2string]

	# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	# Timings per testcase.
	=| "... Postprocessing per-test timings ..."
	
	variable xttimes



	struct::matrix MX
	MX add columns 5

	MX add row {Shell Module Testsuite Test uSec}
	MX add row {===== ====== ========= ==== ====}

	foreach item [lsort -index 1 -integer -decreasing [lsort -index 0 -dict $xttimes]] {
	    foreach {k usec} $item break
	    MX add row [linsert $k end $usec]
	}



	MX add row {===== ====== ========= ==== ====}


	puts $logtmi "\nTiming Table..."
	puts $logtmi [MX format 2string]

	# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	=| "... Postprocessing Done"
    }

    exit [expr {($err || $fail) ? 1 : 0}]
    return
}

# ###

proc ::sak::test::run::EndFile {} {
    upvar 1 line line
    if {![regexp "^@@ EndFile (.*)$" $line -> end]} return
    variable xfile
    variable xstartfile
    variable xtimes
    variable xtestnum
    variable xduration

    set k [lreplace $xfile 0 3]
    set k [lreplace $k 2 2 [file tail [lindex $k 2]]]
    set delta [expr {$end - $xstartfile}]
    incr xduration $delta

    if {$xtestnum == 0} {
	set score $delta
    } else {
	# average number of microseconds per test.
	set score [expr {int(($delta/double($xtestnum))*1000000)}]
	#set score [expr {$delta/double($xtestnum)}]
    }

    lappend xtimes [list $k $xtestnum $delta $score]

    variable alog
    if {$alog} {
	variable logtim
	puts $logtim [linsert [linsert $k end $xtestnum $delta $score] 0 TIME]
    }

    #sak::registry::local set $xshell End $end
    return -code continue
}

proc ::sak::test::run::Module {} {
    upvar 1 line line ; variable xmodule
    if {![regexp "^@@ Module (.*)$" $line -> xmodule]} return
    variable xshell
    variable xstatus ok
    variable maxml
    variable xduration 0
    += ${xmodule}[blank [expr {$maxml - [string length $xmodule]}]]
    set xmodule [linsert $xshell end $xmodule]
    #sak::registry::local set $xmodule
    return -code continue
}

proc ::sak::test::run::Testsuite {} {

proc ::sak::test::run::Summary {} {
    upvar 1 line line
    if {![regexp "^all\\.tcl:(.*)$" $line -> line]} return
    variable xmodule
    variable xstatus
    variable xvstatus
    
    foreach {_ t _ p _ s _ f} [split [string trim $line]] break
    #sak::registry::local set $xmodule Total   $t ; set t [format %5d $t]
    #sak::registry::local set $xmodule Passed  $p ; set p [format %5d $p]
    #sak::registry::local set $xmodule Skipped $s ; set s [format %5d $s]
    #sak::registry::local set $xmodule Failed  $f ; set f [format %5d $f]

    upvar 2 total _total ; incr _total $t
    upvar 2 pass  _pass  ; incr _pass  $p
    upvar 2 skip  _skip  ; incr _skip  $s
    upvar 2 fail  _fail  ; incr _fail  $f
    upvar 2 err   _err

    set t [format %5d $t]
    set p [format %5d $p]
    set s [format %5d $s]
    set f [format %5d $f]

    if {$xstatus == "ok" && $t == 0} {
	set xstatus none
	set spent ""
    } else {
	# Time spent on all the files in the module.
	variable xduration
	#set sec $xduration
	#set min [expr {$sec / 60}]
	#set sec [expr {$sec % 60}]
	#set hor [expr {$min / 60}]
	#set min [expr {$min % 60}]
	#set spent " :[format %02d $hor]h[format %02d $min]m[format %02d $sec]s"
	set spent " @${xduration}s"
    }

    set st $xvstatus($xstatus)

    if {$xstatus == "ok"} {
	# Quick return for ok suite.
	=| "~~ $st T $t P $p S $s F $f$spent"
	return -code continue
    }

    # Clean out progress display using a non-highlighted
    # string. Prevents the char count from being off. This is
    # followed by construction and display of the highlighted version.

    = "   $st T $t P $p S $s F $f$spent"
    switch -exact -- $xstatus {
	none    {=| "~~ [yel]$st T $t[rst] P $p S $s F $f"}
	aborted {=| "~~ [whi]$st[rst] T $t P $p S $s F $f$spent"}

	error   {=| "~~ [mag]$st[rst] T $t P $p S $s F $f$spent" ; incr _err }


	fail    {=| "~~ [red]$st[rst] T $t P $p S $s [red]F $f[rst]$spent"}
    }
    return -code continue
}

proc ::sak::test::run::TestStart {} {
    upvar 1 line line
    if {![string match {---- * start} $line]} return
    set testname [string range $line 5 end-6]
    = "---- $testname"
    variable xfile
    variable xtesttime -1
    variable xtest [linsert $xfile end $testname]
    variable xtestnum
    incr     xtestnum
    return -code continue
}

proc ::sak::test::run::TestTook {} {
    upvar 1 line line
    if {![string match {++++ * took *} $line]} return
    # Dynamic search for the marker because the name of the test may
    # contain spaces, causing the field position to vary.
    set  pos [lsearch -exact $line took]
    incr pos
    set usec [lindex $line $pos]
    variable xtesttime $usec
    return -code continue
}

proc ::sak::test::run::TestSkipped {} {
    upvar 1 line line
    if {![string match {++++ * SKIPPED:*} $line]} return

    = [string trimright "PASS $testname $xtesttime"]
    if {$xtest == {}} {
	variable xfile
	set xtest [linsert $xfile end $testname]
    }
    #sak::registry::local set $xtest Status Pass
    variable alog
    if {$alog && ($xtesttime ne {})} {
	variable xttimes
	variable logtti
	set k [lreplace $xtest 0 3]
	set k [lreplace $k 2 2 [file tail [lindex $k 2]]]
	# k = shell module testfile testname
	puts $logtti [linsert [linsert $k 0 TIME] end $xtesttime]

	lappend xttimes [list $k $xtesttime]
    }
    set xtest {}
    return -code continue
}

proc ::sak::test::run::TestFailed {} {
    upvar 1 line line