Index: library/lib/pkgIndex.tcl
===================================================================
diff -u -r61ee196901f6c7444523b78c91a98f9f501c8f8b -ra4d79288048b336b38063dc0208ea220d460832f
--- library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision 61ee196901f6c7444523b78c91a98f9f501c8f8b)
+++ library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision a4d79288048b336b38063dc0208ea220d460832f)
@@ -9,4 +9,5 @@
# full path name of this file's directory.
package ifneeded nx::doc 0.1 [list source [file join $dir doc-tools.tcl]]
+package ifneeded nx::pp 1.0 [list source [file join $dir pp.tcl]]
package ifneeded nx::test 1.0 [list source [file join $dir test.tcl]]
Index: library/lib/pp.tcl
===================================================================
diff -u
--- library/lib/pp.tcl (revision 0)
+++ library/lib/pp.tcl (revision a4d79288048b336b38063dc0208ea220d460832f)
@@ -0,0 +1,232 @@
+package require nx
+package provide nx::pp 1.0
+
+# @package nx::pp
+#
+# A simple pretty printer for Tcl/XOTcl/NX
+# that converts a script into HTML output.
+#
+# Usage:
+# package require nx::pp
+# set html [nx::pp render { your script }]
+#
+# Desinged to be usable from asciidoc like gnu source-highligt,
+# ignores options.
+#
+# Gustaf Neumann, Dez 2010
+
+namespace eval ::nx::pp {
+ #
+ # The pretty printer is implemented via several States objects that
+ # represent different context for input processing. Such states are
+ # for example "comment" or "quoted strings". Every state contains
+ # the parsed content, and a CSS class for HTML rendering.
+ #
+ nx::Class create State {
+ :attribute {text ""}
+ :attribute {cssClass "[namespace tail [nx::self]]"}
+ :attribute {prevState "[default]"}
+
+ :public method start {char} {
+ # Start output in a state by initializing the text buffer.
+ set :text $char
+ return [nx::self]
+ }
+
+ :public method cssWrap {html} {
+ if {${:cssClass} ne ""} {
+ return "$html"
+ } else {
+ return $html
+ }
+ }
+
+ :public method flush {} {
+ # Flush the current text in the buffer using the css class
+ set html [string map [list & {&} < {<} > {>}] ${:text}]
+ ::nx::pp puts -nonewline [:cssWrap $html]
+ set :text ""
+ }
+
+ :method new_state {new lastChar firstChar} {
+ # Switch from one state to another state
+ if {[$new eval {info exists :escape}]} {
+ $new prevState [nx::self]
+ append :text $lastChar
+ return [$new]
+ } else {
+ $new prevState [default]
+ append :text $lastChar
+ :flush
+ return [$new start $firstChar]
+ }
+ }
+
+ :public method process {char} {
+ # Process a single character in the current state
+ append :text $char
+ return [nx::self]
+ }
+ }
+
+ #
+ # Below, we define the state objects for processing the input
+ #
+ State create default -cssClass "" {
+ #
+ # The State "default" is processing bare Tcl words. In this state,
+ # we perform substitutions of keywords and placeholders.
+ #
+ :public method process {char} {
+ switch $char {
+ "\#" { return [:new_state comment "" $char]}
+ "\"" { return [:new_state quoted "" $char]}
+ "\$" { return [:new_state variable "" $char]}
+ default {return [nx::next]}
+ }
+ }
+
+ set :re(keyword) (\\m[join {
+ after append apply array binary break catch cd chan clock close concat continue
+ dict else encoding eof error eval exec exit expr fblocked fconfigure fcopy file
+ fileevent flush for foreach format gets glob global if incr info interp join
+ lappend lassign lindex linsert list llength load lrange lrepeat lreplace lreverse
+ lsearch lset lsort namespace open pid proc puts read regexp regsub rename return
+ scan seek set socket source split stdin stderr stdout string subst switch
+ tell trace unset uplevel update upvar variable vwait while
+ package
+ public protected class-object
+ method attribute forward
+ my next new self
+ create init new destroy alloc dealloc
+ class superclass mixin
+ ::nx::Class nx::Class ::xotcl::Class xotcl::Class Class
+ ::nx::Object nx::Object ::xotcl::Object xotcl::Object Object
+ ::nx::Attribute nx::Attribute Attribute
+ Object
+ } \\M|\\m]\\M)
+
+ set :re(placeholder) {([/?][-a-zA-Z0-9:]+[/?])}
+
+ :public method flush {} {
+ set html [string map [list & {&} < {<} > {>}] ${:text}]
+ regsub -all [set :re(keyword)] $html {\1} html
+ regsub -all [set :re(placeholder)] $html {\1} html
+ nx::pp puts -nonewline [:cssWrap $html]
+ set :text ""
+ }
+ }
+
+ State create quoted -cssClass "string" {
+ #
+ # The State "quoted" is for content between double quotes.
+ #
+ :public method process {char} {
+ switch $char {
+ "\"" {return [:new_state ${:prevState} $char ""]}
+ "\\" {return [:new_state escape $char ""]}
+ default {return [nx::next]}
+ }
+ }
+ }
+
+ State create comment {
+ #
+ # The State "comment" is for Tcl comments (currently, only up to
+ # end of line)
+ #
+ :public method process {char} {
+ switch $char {
+ "\n" {return [:new_state default $char ""]}
+ default {return [nx::next]}
+ }
+ }
+ }
+
+ State create variable {
+ #
+ # The State "variable" is for simple Tcl variables (without curley
+ # braces)
+ #
+ :public method process {char} {
+ switch -glob -- $char {
+ {\{} {return [:new_state quoted_variable $char ""] }
+ {[a-zA-Z0-9_:]} {return [nx::next]}
+ default {return [:new_state default "" $char]}
+ }
+
+ }
+ }
+
+ State create quoted_variable -cssClass "variable" {
+ #
+ # The State "quoted_variable" is for Tcl variables, where the
+ # names are quoted with curley braces.
+ #
+ :public method process {char} {
+ switch -glob -- $char {
+ {\}} {return [:new_state default $char ""] }
+ default {return [nx::next]}
+ }
+ }
+ }
+
+ State create escape -cssClass "" {
+ #
+ # The State "escape" is for simple backslash handling.
+ #
+ # Set an instance variable to ease identification of the state
+ set :escape 1
+
+ # When a character is processed in the escape state, it is suffed
+ # into the previous state and returns immediately to it.
+ #
+ :public method process {char} {
+ ${:prevState} eval [list append :text $char]
+ return ${:prevState}
+ }
+ }
+}
+
+#
+# Finally, we create a simple pretty-printer as an object. The
+# method render receives a Tcl script as input and writes the HTML
+# output to stdout
+#
+nx::Object create nx::pp {
+
+ :public method render {block} {
+ set :output ""
+ :puts ""
+ :puts ""
+ set state [self]::default
+
+ set l [string length $block]
+ for {set i 0} {$i < $l} {incr i} {
+ set state [$state process [string index $block $i]]
+ }
+ $state flush
+ :puts "\n"
+ return ${:output}
+ }
+
+ :public method puts {{-nonewline:switch} string} {
+ append :output $string
+ if {!$nonewline} {append :output \n}
+ }
+}
+
+# pp render {
+# set x "hello\ngoodbye"
+# # a comment line
+# set b $c($a).b
+# foo a ${:text} b "hello \"$x" world
+# }
+# exit