blob: 17526e035a722ef5a51edfce37cb583722137498 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
# makeHeader.tcl --
#
# This script generates embeddable C source (in a .h file) from a .tcl
# script.
#
# Copyright © 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.6-
namespace eval makeHeader {
####################################################################
#
# mapSpecial --
# Transform a single line so that it is able to be put in a C string.
#
proc mapSpecial {str} {
# All Tcl metacharacters and key C backslash sequences
set MAP {
\" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
\a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
}
set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}
subst [regsub -all {[^\x20-\x7E]} [string map $MAP $str] $XFORM]
}
####################################################################
#
# compactLeadingSpaces --
# Converts the leading whitespace on a line into a more compact form.
#
proc compactLeadingSpaces {line} {
set line [string map {\t { }} [string trimright $line]]
if {[regexp {^[ ]+} $line spaces]} {
regsub -all {[ ]{4}} $spaces \t replace
set len [expr {[string length $spaces] - 1}]
set line [string replace $line 0 $len $replace]
}
return $line
}
####################################################################
#
# processScript --
# Transform a whole sequence of lines with [mapSpecial].
#
proc processScript {scriptLines} {
lmap line $scriptLines {
# Skip blank and comment lines; they're there in the original
# sources so we don't need to copy them over.
if {[regexp {^\s*(?:#|$)} $line]} continue
format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
}
}
####################################################################
#
# updateTemplate --
# Rewrite a template to contain the content from the input script.
#
proc updateTemplate {dataVar scriptLines} {
set BEGIN "*!BEGIN!: Do not edit below this line.*"
set END "*!END!: Do not edit above this line.*"
upvar 1 $dataVar data
set from [lsearch -glob $data $BEGIN]
set to [lsearch -glob $data $END]
if {$from < 0 || $to < 0 || $from >= $to} {
throw BAD "not a template"
}
set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
}
####################################################################
#
# stripSurround --
# Removes the header and footer comments from a (line-split list of
# lines of) Tcl script code.
#
proc stripSurround {lines} {
set RE {^\s*$|^#}
set state 0
set lines [lmap line [lreverse $lines] {
if {!$state && [regexp $RE $line]} continue {
set state 1
set line
}
}]
return [lmap line [lreverse $lines] {
if {$state && [regexp $RE $line]} continue {
set state 0
set line
}
}]
}
####################################################################
#
# updateTemplateFile --
# Rewrites a template file with the lines of the given script.
#
proc updateTemplateFile {headerFile scriptLines} {
set f [open $headerFile "r+"]
try {
set content [split [chan read -nonewline $f] "\n"]
updateTemplate content [stripSurround $scriptLines]
chan seek $f 0
chan puts $f [join $content \n]
chan truncate $f
} trap BAD msg {
# Add the filename to the message
throw BAD "${headerFile}: $msg"
} finally {
chan close $f
}
}
####################################################################
#
# readScript --
# Read a script from a file and return its lines.
#
proc readScript {script} {
set f [open $script]
try {
chan configure $f -encoding utf-8
return [split [string trim [chan read $f]] "\n"]
} finally {
chan close $f
}
}
####################################################################
#
# run --
# The main program of this script.
#
proc run {args} {
try {
if {[llength $args] != 2} {
throw ARGS "inputTclScript templateFile"
}
lassign $args inputTclScript templateFile
puts "Inserting $inputTclScript into $templateFile"
set scriptLines [readScript $inputTclScript]
updateTemplateFile $templateFile $scriptLines
exit 0
} trap ARGS msg {
puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
exit 2
} trap BAD msg {
puts stderr $msg
exit 1
} trap POSIX msg {
puts stderr $msg
exit 1
} on error {- opts} {
puts stderr [dict get $opts -errorinfo]
exit 3
}
}
}
########################################################################
#
# Launch the main program
#
if {[info script] eq $::argv0} {
makeHeader::run {*}$::argv
}
# Local-Variables:
# mode: tcl
# fill-column: 78
# End:
|
