Lines of
xvfs-create
from check-in 2b7fa3a8fa
that are changed by the sequence of edits moving toward
check-in d36db7c01b:
1: #! /usr/bin/env tclsh
2:
3: set sourceDirectory [file dirname [file normalize [info script]]]
4:
5: lappend auto_path [file join $sourceDirectory lib]
6:
7: set template [file join $sourceDirectory lib xvfs xvfs.c.rvt]
8:
9: package require minirivet
10:
11: set mode "run"
12: if {[lindex $argv 0] == "--dump-tcl"} {
13: set mode "dump-tcl"
14: }
15:
16: foreach {arg val} $argv {
17: switch -exact -- $arg {
18: "--output" {
19: set outputFile $val
20: }
21: }
22: }
23:
24: proc remove_debug {input} {
25: set output [list]
26:
27: set lastLine -
28: foreach line [split $input "\n"] {
29: if {[string match -nocase "*XVFS_DEBUG*" $line]} {
30: continue
31: }
32:
33: if {$lastLine eq "" && $line eq ""} {
34: continue
35: }
36:
37: set lastLine $line
38: lappend output $line
39: }
40:
41: return [join $output "\n"]
42: }
43:
44: switch -- $mode {
45: "run" {
46: if {[info exists outputFile]} {
47: set fd [open $outputFile w]
2b7fa3a8fa 2019-09-20 48: ::minirivet::setOutputChannel $fd
49: }
50:
2b7fa3a8fa 2019-09-20 51: package require xvfs
52: set ::xvfs::argv $argv
53: ::xvfs::run
54:
55: if {[info exists fd]} {
56: close $fd
57: }
58: }
59: "dump-tcl" {
60: set xvfs_tcl [file join $sourceDirectory lib xvfs xvfs.tcl]
61: set xvfs_core_h [file join $sourceDirectory xvfs-core.h]
62: set xvfs_core_c [file join $sourceDirectory xvfs-core.c]
63:
64: set cleanup {
65: "#include <xvfs-core.h>" ""
66: "#include <xvfs-core.c>" ""
67: }
68:
69: set core_header_data ""
70: append core_header_data [string map $cleanup [read [open $xvfs_core_h]]] "\n"
71: append core_header_data [string map $cleanup [read [open $xvfs_core_c]]] "\n"
72:
73: if {[lsearch -exact $argv "--remove-debug"] != -1} {
74: set core_header_data [remove_debug $core_header_data]
75: }
76:
77: puts "#! /usr/bin/env tclsh"
78: puts ""
79: puts [list namespace eval ::minirivet {}]
80: puts [list set ::minirivet::_outputChannel stdout]
81: puts [list proc ::minirivet::_emitOutput [info args ::minirivet::_emitOutput] [info body ::minirivet::_emitOutput]]
82: puts ""
83: puts [read [open $xvfs_tcl]]
84: puts ""
85: puts {set ::xvfs::argv $::argv}
86: puts {
87: foreach {arg val} $argv {
88: switch -exact -- $arg {
89: "--output" {
90: set ::minirivet::_outputChannel [open $val w]
91: }
92: }
93: }
94: }
95: puts ""
96: puts [list ::minirivet::_emitOutput $core_header_data]
97: puts ""
98:
99: puts ""
100: puts [string map $cleanup [::minirivet::parseStringToCode [read [open $template]]]]
101: }
102: default {
103: puts stderr "error: Invalid mode: $mode"
104: exit 1
105: }
106: }