1# -*- tcl -*- 2# 3# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 4# Parser Generator / Backend - Dump (A)ST for inspection. 5 6# ### ### ### ######### ######### ######### 7## Requisites 8 9package require page::util::quote 10 11namespace eval ::page::gen::tree::text { 12 # Get the peg char de/encoder commands. 13 # (unquote, quote'tcl) 14 15 namespace import ::page::util::quote::* 16} 17 18# ### ### ### ######### ######### ######### 19## API 20 21proc ::page::gen::tree::text {t chan} { 22 set indent "" 23 set bystr " " 24 set bysiz [string length $bystr] 25 set byoff end-$bysiz 26 27 $t walk root -order both -type dfs {a n} { 28 if {$a eq "enter"} { 29 text::WriteNode $indent $chan $t $n 30 append indent $bystr 31 } else { 32 set indent [string range $indent 0 $byoff] 33 } 34 } 35 return 36} 37 38# ### ### ### ######### ######### ######### 39## Internal. Helpers 40 41proc ::page::gen::tree::text::WriteNode {indent chan t n} { 42 array set attr [$t getall $n] 43 44 if {[array size attr] == 0} { 45 puts $chan "$indent$n <>" 46 } else { 47 puts -nonewline $chan "$indent$n < " 48 49 set max -1 50 set d {} 51 foreach k [array names attr] { 52 set l [string length $k] 53 if {$l > $max} {set max $l} 54 lappend d [list $k [Quote $attr($k)] $l] 55 } 56 57 if {[llength $d] == 1} { 58 puts $chan "$k = $attr($k) >" 59 return 60 } 61 62 set first 1 63 set space $indent[string repeat " " [string length "$n < "]] 64 65 foreach e [lsort -dict -index 0 $d] { 66 foreach {k v l} $e break 67 set off [string repeat " " [expr {$max-$l}]] 68 69 if {$first} { 70 puts -nonewline $chan "$k$off = $v" 71 set first 0 72 } else { 73 puts -nonewline $chan "\n$space$k$off = $v" 74 } 75 } 76 77 puts $chan " >" 78 } 79} 80 81proc ::page::gen::tree::text::Quote {str} { 82 return $str 83 84 set res "" 85 foreach c [split $str {}] { 86 append res [quote'tcl $c] 87 } 88 return $res 89} 90 91# ### ### ### ######### ######### ######### 92## Ready 93 94package provide page::gen::tree::text 0.1 95