Tcl script to print a Cloverleaf variant out to stdout.

print_variant.tcl

#!/usr/bin/env tclsh

#####################################################
# Usage: tclsh print_variant.tcl <variant_directory>
#    OR: hcitcl print_variant.tcl <variant_directory>
#####################################################

proc print_variant {variant_dir} {
	puts "################################################################################"
	puts " Variant: $variant_dir"
	puts "################################################################################"

	# print the fields
	print_fields $variant_dir

	# print the segments
	print_segments $variant_dir

	# print the messages
	print_messages $variant_dir
}

proc read_prologue {file} {
	set prologue {}
	set line [gets $file]
	while {![regexp {^end_prologue} $line]} {
		lappend prologue $line
		set line [gets $file]
	}
	return $prologue
}

proc read_lines {file} {
	set lines {}
	set line [gets $file]
	while {![eof $file]} {
		lappend lines $line
		set line [gets $file]
	}

	return $lines
}

proc get_id {item} {
	foreach kv $item {
		set key [lindex $kv 0]
		if { $key == "ID" } {
			return [lindex $kv 1]
		}
	}

}

proc print_fields {variant_dir} {
	set file [open [file join $variant_dir "fields"]]

	puts ""
	foreach line [read_prologue $file] {
		puts $line
	}
	puts ""

	puts "========================================"
	puts " Fields"
	puts "========================================"

	
	foreach item [lsort [read_lines $file]] {
		puts "\t$item"
	}

	puts ""

	close $file
}

proc print_segments {variant_dir} {
	puts "========================================"
	puts " Segments"
	puts "========================================"
	
	set segments_idx [file join $variant_dir "segments.idx"]

	if { [file exists $segments_idx] } {
		set file [open $segments_idx]
		read_prologue $file
		set items [read_lines $file]
		foreach item [lsort $items] {
			print_segment $variant_dir $item [get_id $item]
		}
		close $file
	} else {
		set segments_dir [file join $variant_dir "segments"]
		set items [glob -directory $segments_dir -nocomplain -tails -type f "*"]
		foreach item [lsort $items] {
			print_segment $variant_dir $item $item
		}
	}

	puts ""

}

proc print_segment {variant_dir header segment} {
	puts "\t$header"

	set file [open [file join $variant_dir "segments" $segment]]

	read_prologue $file
	foreach item [read_lines $file] {
		puts "\t\t$item"
	}
	
	close $file
}

proc print_messages {variant_dir} {

	puts "========================================"
	puts " Messages"
	puts "========================================"
	
	set messages_idx [file join $variant_dir "messages.idx"]

	if { [file exists $messages_idx] } {
		set file [open $messages_idx]

		read_prologue $file
		set items [read_lines $file]
		foreach item [lsort $items] {
			print_message $variant_dir $item [get_id $item]
		}

		close $file
	} else {
		set messages_dir [file join $variant_dir "messages"]
		set items [glob -directory $messages_dir -nocomplain -tails -type f "*"]
		foreach item [lsort $items] {
			print_message $variant_dir $item $item
		}
	}

	puts ""
}

proc print_message {variant_dir header message} {
	puts "\t$header"

	set file [open [file join $variant_dir "messages" $message]]

	read_prologue $file
	foreach item [read_lines $file] {
		puts "\t\t$item"
	}
	
	close $file
}

foreach dirname $argv {
	print_variant $dirname
}