[jdp] 2009-11-15 01:42:49 UTC
Here's some code for converting Textile [http://textism.com/tools/textile/]. At the moment it's reasonably reliable (I think there are a few cases which cause grief, but none come to mind), but table support is nonexistent. It doesn't generate a full document, just the part that would go between the tags. Enjoy.
======
proc parse {filename} {
set datain [open $filename]
set doctext [read $datain]
close $datain
regsub -all -- {\n{2,}} $doctext "\uFFFF" doctext
set text [split $doctext \uFFFF]
set out [list]
set premode 0
foreach line $text {
if {[regexp {.*
} $line]} {
if {[catch {lappend out [subst $line]} e i]} {
warn $e
log $i
log $line
}
continue
} elseif {[regexp {} $line]} {
if {[catch {lappend out [subst $line]} e i]} {
warn $e
log $i
log $line
}
set premode 1
continue
} elseif {[regexp {} $line]} {
if {[catch {lappend out [subst $line]} e i]} {
warn $e
log $i
log $line
}
set premode 0
continue
} elseif {$premode} {
if {[catch {lappend out [subst $line]} e i]} {
warn $e
log $i
log $line
}
continue
}
if {[regexp {^h([1-6])(.*?)\. (.*?)$} $line match level style text]} {
set line "$text"
} elseif {[regexp {^bq(.*?)\. (.*?)$} $line match style text]} {
set line "$text"
} elseif {[regexp {^fn(\d)(.*?)\. (.*?)$} $line match number style text]} {
set line "$number $text
"
} elseif {[regexp {^#.*? .*$} $line match style]} {
set line "\n$match\n
"
} elseif {[regexp {^\* .*$} $line match]} {
set line ""
#} elseif {[regexp {^(\|.*?)+\|} $line match]} {
# set line ""
} elseif {[regexp {^p(.*?)\. (.*?)$} $line match style text]} {
set line "$text"
} else {
set line "$line
"
}
regsub -all -line -- {^#(.*?) (.*?)(\n)} $line {\2\3} line
regsub -all -line -- {^\*(.*?) (.*?)(\n)} $line {\2\3} line
regsub -all -- {"([^\"]*?)(?:\((.*?)\))??":([[:graph:]]+)([[:space:];#%&\*\{\}\\<>\?\+]|$)} $line {\1\4} line
regsub -all -- {\!([[:graph:]]+)(?:\((.*?)\))?\!:([[:graph:]]+)([[:space:]]|$)} $line {
\4} line
regsub -all -- {\!([[:graph:]]+)(?:\((.*?)\))?\!} $line {} line
regsub -all -- {([^()])\m__([[({].*?[})\]])??(\S.*?)__\M([^()])} $line {\1\3\4} line
regsub -all -- {([^()])\m_([[({].*?[})\]])??(\S.*?)_\M([^()])} $line {\1\3\4} line
regsub -all -- {\*\*\m([[({].*?[})\]])??(\S.*?)\M\*\*} $line {\2} line
regsub -all -- {\*\m([[({].*?[})\]])??(\S.*?)\M\*} $line {\2} line
regsub -all -- {\?\?\m([[({].*?[})\]])??(\S.*?)\M\?\?} $line {\2} line
regsub -all -- {-\m([[({].*?[})\]])??(\S.*?)\M-} $line {\2} line
regsub -all -- {\+\m([[({].*?[})\]])??(\S.*?)\M\+} $line {\2} line
regsub -all -- {\^\m([[({].*?[})\]])??(\S.*?)\M\^} $line {\2} line
regsub -all -- {~\m([[({].*?[})\]])??(\S.*?)\M~} $line {\2} line
regsub -all -- {%\m([[({].*?[})\]])??(\S.*?)\M%} $line {\2} line
regsub -all -- {[[:graph:]]+?\((.+?)\)} $line {\1} line
regsub -all -- {([[:graph:]])\[(\d+?)\]} $line {\1\2} line
regsub -all -- {([[:alnum:]_])\n} $line {\1
\n} line
if {[catch {lappend out [subst $line]} e i]} {
warn $e
log $i
log $line
}
}
return [join $out \n\n]
}
proc style {attrs} {
set result [list]
set stylelist [list]
if {[regexp {\(#([[:alnum:]_]+?)\)} $attrs match id]} {
lappend result " id=\"$id\""
}
if {[regexp {\(([[:alnum:]_]+?)\)} $attrs match class]} {
lappend result " class=\"$class\""
}
if {[regexp {\(([[:alnum:]_]+?)#([[:alnum:]_]+?)\)} $attrs match class id]} {
lappend result "class=\"$class\""
lappend result " id=\"$id\""
}
if {[regexp {\{(.+?)\}} $attrs match style]} {
lappend stylelist $style
}
if {[regexp {\[([[:alpha:]]+?)\]} $attrs match lang]} {
lappend result " lang=\"$lang\""
}
if {[regexp {^<>} $attrs]} {
lappend stylelist "text-align:justify"
} elseif {[regexp {^>} $attrs]} {
lappend stylelist "text-align:right"
} elseif {[regexp {^<} $attrs]} {
lappend stylelist "text-align:left"
} elseif {[regexp {^=} $attrs]} {
lappend stylelist "text-align:center"
} elseif {[regexp {^(\(*?)(\)*?)(?![[:alnum:]_])} $attrs match left right]} {
if {[string length $left] > 0} {
lappend stylelist "padding-left:[string length $left]em"
}
if {[string length $right] > 0} {
lappend stylelist "padding-right:[string length $right]em"
}
}
if {[llength $stylelist] > 0} {
lappend result " style=\"[join $stylelist ;]\""
}
return [join $result ""]
}
======
<>Enter Category Here