"dotfiles" configuration deployment script

#! /usr/bin/env tclsh
#
# A configuration deployment script.
# Requires: Tcl 8.6 or later, rsync(1).
#
# Copyright (c) 2020 D. Bohdan.
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

proc main home {
    cd [file dirname [info script]]

    set vars [dict create \
        hostname [exec hostname] \
    ]

    foreach src {
        config/awesome/
        config/gxkb/
        config/icewm/
        config/mc/
        config/tclsh/
        config/udiskie/
    } {
        sync $src {} --delete
    }

    foreach src {
        config/fish/
        config/mpv/
        gitconfig
        gitignore
        jimrc
        tclshrc
        tmux.conf
        xinitrc
        xscreensaver.template
    } {
        sync $src
    }
}


proc with-path {path script} {
    set prev [pwd]

    try {
        cd $path
        uplevel 1 $script
    } finally {
        cd $prev
    }
}


proc sync {src {dst {}} args} {
    upvar 1 home home
    upvar 1 vars vars

    if {$dst eq {}} {
        set dst $home/.$src
    }

    exec rsync -av {*}$args $src $dst >@ stdout 2>@ stderr

    foreach template [find $dst -iname *.template] {
        puts stderr [list expanding template $template]
        expand-template $template {} $vars
    }
}


proc find args {
    set paths [split [exec find {*}$args -print0] \0]

    lrange $paths 0 end-1
}


proc expand-template {src {dst {}} {vars {}}} {
    if {$dst eq {}} {
        set dst [file rootname $src]
    }

    set ch [open $src r]
    set template [read $ch]
    set contents [safe-eval [template::parse $template] $vars]

    set ch2 [open $dst w]
    puts -nonewline $ch2 $contents

    file delete $src

    close $ch2
    close $ch
}


proc safe-eval {script vars} {
    ::safe::interpCreate templateInterp
    dict for {k v} $vars {
        templateInterp eval [list set $k $v]
    }
    set result [templateInterp eval $script]
    ::safe::interpDelete templateInterp

    return $result
}


namespace eval template {}

# Convert a template into Tcl code.
proc template::parse template {
    set result {}
    set regExpr {^(.*?)<%(.*?)%>(.*)$}
    set listing "set _output {}\n"
    while {[regexp $regExpr $template match preceding token template]} {
        append listing [list append _output $preceding]\n

        switch -exact -- [string index $token 0] {
            = {
                set code [list [string range $token 1 end]]
                append listing [format {append _output [expr %s]} $code]
            }
            ! {
                set code [string range $token 1 end]
                append listing [format {append _output [%s]} $code]
            }
            default {
                append listing $token
            }
        }
        append listing \n
    }

    append listing [list append _output $template]\n

    return $listing
}


main $env(HOME)