diff options
Diffstat (limited to 'tools/makeHeader.tcl')
| -rw-r--r-- | tools/makeHeader.tcl | 182 |
1 files changed, 0 insertions, 182 deletions
diff --git a/tools/makeHeader.tcl b/tools/makeHeader.tcl deleted file mode 100644 index 17526e0..0000000 --- a/tools/makeHeader.tcl +++ /dev/null @@ -1,182 +0,0 @@ -# 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: |