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