actions.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/

/*  This file holds the commands determining the files to install. They*/
/*  are used by the installer to actually perform the installation, and*/
/*  by 'sak' to get the per-module lists of relevant files. The*/
/*  different purposes are handled through the redefinition of the*/
/*  commands [xcopy] and [xcopyf] used by the commands here.*/

ret  _null (type args) {}

ret  _tcl (type module , type libdir) {
    global distribution
    xcopy \
        [file join $distribution modules $module] \
        [file join $libdir $module] \
        0 *.tcl
    return
}

ret  _tcr (type module , type libdir) {
    global distribution
    xcopy \
        [file join $distribution modules $module] \
        [file join $libdir $module] \
        1 *.tcl
    return
}

ret  _doc (type module , type libdir) {
    global distribution

    _tcl $module $libdir
    xcopy \
        [file join $distribution modules $module mpformats] \
        [file join $libdir $module mpformats] \
        1
    return
}

ret  _msg (type module , type libdir) {
    global distribution

    _tcl $module $libdir
    xcopy \
        [file join $distribution modules $module msgs] \
        [file join $libdir $module msgs] \
        1
    return
}

ret  _tex (type module , type libdir) {
    global distribution

    _tcl $module $libdir
    xcopy \
        [file join $distribution modules $module] \
        [file join $libdir $module] \
        0 *.tex
    return
}

ret  _tci (type module , type libdir) {
    global distribution

    _tcl $module $libdir
    xcopyfile [file join $distribution modules $module tclIndex] \
        [file join $libdir $module]
    return
}

ret  _manfile (type f , type format , type ext , type docdir) {
    global distribution argv argc argv0 config

    set out [file join $docdir [file rootname [file tail $f]]].$ext

    log "Generating $out"
    if {$config(dry)} return

    if {[catch {package present doctools}]} {
    uplevel #0 [list source [file join $distribution modules doctools doctools.tcl]]
    }

    ::doctools::new dt -format $format -file $f

    file mkdir [file dirname $out]

    set data [dt format [get_input $f]]
    switch -exact -- $format {
    nroff {
        set data [string map \
            [list \
            {.so man.macros} \
            $config(man.macros)] \
            $data]
    }
    html {}
    }
    write_out $out $data

    set warnings [dt warnings]
    if {[llength $warnings] > 0} {
    log [join $warnings \n]
    }

    dt destroy
    return
}

ret  _manfile (type f , type format , type ext , type docdir) {
    global distribution argv argc argv0 config

    set out [file join $docdir [file rootname [file tail $f]]].$ext

    log "Generating $out"
    if {$config(dry)} return

    if {[catch {package present doctools}]} {
    uplevel #0 [list source [file join $distribution modules doctools doctools.tcl]]
    }

    ::doctools::new dt -format $format -file $f

    file mkdir [file dirname $out]

    set data [dt format [get_input $f]]
    switch -exact -- $format {
    nroff {
        set data [string map \
            [list \
            {.so man.macros} \
            $config(man.macros)] \
            $data]
    }
    html {}
    }
    write_out $out $data

    set warnings [dt warnings]
    if {[llength $warnings] > 0} {
    log [join $warnings \n]
    }

    dt destroy
    return
}

ret  _manfile (type f , type format , type ext , type docdir) {
    global distribution argv argc argv0 config

    set out [file join $docdir [file rootname [file tail $f]]].$ext

    log "Generating $out"
    if {$config(dry)} return

    if {[catch {package present doctools}]} {
    uplevel #0 [list source [file join $distribution modules doctools doctools.tcl]]
    }

    ::doctools::new dt -format $format -file $f

    file mkdir [file dirname $out]

    set data [dt format [get_input $f]]
    switch -exact -- $format {
    nroff {
        set data [string map \
            [list \
            {.so man.macros} \
            $config(man.macros)] \
            $data]
    }
    html {}
    }
    write_out $out $data

    set warnings [dt warnings]
    if {[llength $warnings] > 0} {
    log [join $warnings \n]
    }

    dt destroy
    return
}

ret  _man (type module , type format , type ext , type docdir) {
    global distribution argv argc argv0 config

    # [SF Tcllib Bug 784519]
    # Directly access the bundled doctools package to ensure that
    # we have the truly latest code for that, and not the doctools
    # the executing tclsh would find on its own. The present query is
    # used to ensure that we load the package only once.

    #package require doctools
    if {[catch {package present doctools}]} {
    uplevel #0 [list source [file join $distribution modules doctools doctools.tcl]]
    }
    ::doctools::new dt -format $format -module $module

    foreach f [glob -nocomplain [file join $distribution modules $module *.man]] {

    set out [file join $docdir [file rootname [file tail $f]]].$ext

    log "Generating $out"
    if {$config(dry)} {continue}

    dt configure -file $f
    file mkdir [file dirname $out]

    set data [dt format [get_input $f]]
    switch -exact -- $format {
        nroff {
        set data [string map \
            [list \
            {.so man.macros} \
            $config(man.macros)] \
            $data]
        }
        html {}
    }
    write_out $out $data

    set warnings [dt warnings]
    if {[llength $warnings] > 0} {
        log [join $warnings \n]
    }
    }
    dt destroy
    return
}

ret  _exa (type module , type exadir) {
    global distribution
    xcopy \
        [file join $distribution examples $module] \
        [file join $exadir $module] \
        1
    return
}