136 lines
2.6 KiB
Tcl
Executable File
136 lines
2.6 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
#
|
|
# A simple noweave, based on noweb, that allows us to do simple literate
|
|
# programming.
|
|
#
|
|
# procedures
|
|
#
|
|
proc with-open-file {fname mode fp block} {
|
|
upvar 1 $fp fpvar
|
|
set binarymode 0
|
|
if {[string equal [string index $mode end] b]} {
|
|
set mode [string range $mode 0 end-1]
|
|
set binarymode 1
|
|
}
|
|
set fpvar [open $fname $mode]
|
|
if {$binarymode} {
|
|
fconfigure $fpvar -translation binary
|
|
}
|
|
uplevel 1 $block
|
|
close $fpvar
|
|
}
|
|
|
|
proc add-array-value { _arr key value } {
|
|
upvar 1 $_arr arr
|
|
if {[info exists arr($key)]} {
|
|
append arr($key) "\n$value"
|
|
} else {
|
|
array set arr [list $key $value]
|
|
}
|
|
}
|
|
|
|
proc expand-chunks {_arr chunk indent} {
|
|
upvar 1 $_arr arr
|
|
if {![info exists arr($chunk)]} {
|
|
puts stderr "Could not find chunk $chunk"
|
|
puts stderr "chunks found"
|
|
foreach key [array names arr] {
|
|
puts stderr $key
|
|
}
|
|
exit 1
|
|
}
|
|
foreach line [split $arr($chunk) "\n"] {
|
|
if {[regexp {^(\s*)(<<)(.*)(>>)\s*$} $line -> newIndent open newChunk close]} {
|
|
expand-chunks arr $newChunk $newIndent
|
|
} else {
|
|
puts -nonewline "$indent"
|
|
puts "$line"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc Usage {} {
|
|
global argv0
|
|
puts stderr "$argv0 -R <chunk_name> filename"
|
|
exit 1
|
|
}
|
|
|
|
#
|
|
# variables
|
|
#
|
|
array set chunks {}
|
|
unset -nocomplain requestedChunk
|
|
|
|
#
|
|
# get the chuck and the filename
|
|
#
|
|
|
|
while {[llength $argv]} {
|
|
set argv [lassign $argv[set argv {}] flag]
|
|
switch -glob $flag {
|
|
-R {
|
|
set argv [lassign $argv[set argv {}] requestedChunk]
|
|
}
|
|
-h - --help - -\? {
|
|
Usage
|
|
}
|
|
-- break
|
|
-* {
|
|
puts stderr "unknown option $flag"
|
|
Usage
|
|
}
|
|
default {
|
|
set argv [list $flag {*}$argv]
|
|
break
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# make sure we got a file name
|
|
#
|
|
if {[llength $argv] != 1} {
|
|
puts stderr "no file given, exiting"
|
|
Usage
|
|
}
|
|
#
|
|
# make sure we got a chunk
|
|
#
|
|
set filename $argv
|
|
if {![info exists requestedChunk]} {
|
|
## puts stderr "no chunk requested, default to the root chunk '*'"
|
|
set requestedChunk "*"
|
|
}
|
|
|
|
#
|
|
# read the file and get all chunks
|
|
#
|
|
with-open-file $filename r fp {
|
|
set in_chunk_p 0
|
|
unset -nocomplain chunk
|
|
while 1 {
|
|
gets $fp line
|
|
if [eof $fp] break
|
|
if {!$in_chunk_p && [regexp {(^<<)(.*)(>>=$)} $line -> open chunk close]} {
|
|
set in_chunk_p 1
|
|
continue
|
|
}
|
|
if {$in_chunk_p && [regexp {^(@).*(% def)?$} $line -> endchunk rest]} {
|
|
set in_chunk_p 0
|
|
unset -nocomplain chunk
|
|
continue
|
|
}
|
|
if {$in_chunk_p} {
|
|
add-array-value chunks $chunk $line
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Print out the requested chunk
|
|
#
|
|
expand-chunks chunks $requestedChunk ""
|
|
|
|
exit 0
|
|
|