Version 3 of MINISS - Mini Spread Sheet

Updated 2015-03-30 14:23:50 by bsg

I often need a spreadsheet to perform some quick calculations that are just a bit more complicated than can be done in my head or with a calculator. Using excel can be heavy with startup time, it's tendency to want to take over the whole screen, and the insistence on saving the work to disk. Seeing the Tiny Excel-like app in plain Tcl/Tk, I decided to make it actually useful. Here is my progress so far:

#!/bin/sh
# \
exec /usr/local/bin/wish8.6 $0 $*

#
# Main program builds GUI
# optional arguments are ?#rows ?#columns??
#
proc main {args} {
    lassign {7 7} rows cols
    if {[llength $args] > 0} { set rows [lindex $args 0] }
    if {[llength $args] > 1} { set cols [lindex $args 1] }

    for {set row 0} {$row <= $rows} {incr row} {
        set columnName ""
        for {set column 0} {$column <= $cols} {incr column; inca columnName} {
            set cell $columnName$row
            set widget [if {$column == 0 || $row == 0} {
                ::ttk::label .label$cell -text [expr {$row ? $row : $columnName}]
            } else {
                set ::formula($columnName$row) [set ::$cell ""]
                trace add variable ::$cell read recalc
                ::ttk::entry .cell$cell -textvar ::$cell -width 10 -validate focus \
                    -validatecommand [list ::reveal-formula $cell %V %s]
            }]
            grid $widget -row $row -column $column
        }
    }
}

#
# Program the Arrow keys to move about the sheet
#
proc cell-arrow {dir w args} {
    set column [dict get [grid info $w] -column]
    set row    [dict get [grid info $w] -row]
    switch $dir {
        Left  { lassign [list [incr column -1] -row $row]       index axis axis-value }
        Right { lassign [list [incr column  1] -row $row]       index axis axis-value }
        Up    { lassign [list [incr row -1   ] -column $column] index axis axis-value }
        Down  { lassign [list [incr row  1   ] -column $column] index axis axis-value }
    }
    set x [lindex [lsort -dictionary [grid slaves . $axis ${axis-value}]] [expr {$index -1}]]
    if {[string match {*cell*} $x]} { focus $x }
}

bind TEntry <Key-Left>  {cell-arrow %K %W}
bind TEntry <Key-Right> {cell-arrow %K %W}
bind TEntry <Key-Up>    {cell-arrow %K %W}
bind TEntry <Key-Down>  {cell-arrow %K %W}

#
# inca - increment letter (column) sequence
#   A -> B -> C ... AA -> AB ... AZ -> BA -> BB 
#
set atab [split {ABCDEFGHIJKLMNOPQRSTUVWXYZ} {}]
proc inca {avar {by 1}} {
    upvar $avar a
    if {$a eq ""} {set a A; return}
    global atab
    set i $by
    foreach d [lreverse [split [string toupper $a] {}]] {
        set nxt [expr {([lsearch $atab $d] + $i) % 26}]
        set i [expr {($i>0 && !$nxt) ? 1 : 0}]
        lappend n [lindex $atab $nxt]
    }
    if {$i>0} { lappend n [lindex $atab 0] }
    set a [join [lreverse $n] ""]
}

proc set-cell {cell value} {
    .cell$cell delete 0 end
    .cell$cell insert 0 $value
}
proc recalc {cell args} {
    if {$::formula($cell) ne ""} {
        catch {set ::$cell [uplevel #0 [list \
               expr [regsub -all {([A-Z]+[1-9])} [expand-range $::formula($cell)] {$\1}]]]}
    }
}
proc reveal-formula {cell event value} {
    if {$event eq "focusin"} {
        if {$::formula($cell) ne ""} { set ::$cell =$::formula($cell) }
                .cell$cell selection range 0 end
                .cell$cell icursor end
    } else { ;# focusout
                if {![regexp {^=(.*)} $value -> ::formula($cell)]} { set ::formula($cell) "" }
        foreach otherCell [array names ::formula] { recalc $otherCell }
    }
    return 1
}

proc expand-range {arg} {
    while {[regexp {(([A-Z]+)([0-9]+)\.\.([A-Z]+)([0-9]+))} $arg -> pat leftcol leftrow rghtcol rghtrow]} {
        set l [list]
        for {set col $leftcol} {$col <= $rghtcol} {inca col} {
            for {set row $leftrow} {$row <= $rghtrow} {incr row} { lappend l ${leftcol}${row} }
        }
        set arg [regsub $pat $arg [join $l ,]]
    }
    return $arg
}

# Add excel like functions here:
proc ::tcl::mathfunc::sum {args} {
    return [expr [list [llength $args] ? [join $args +] : 0]]
}

proc ::tcl::mathfunc::avg {args} {
    return [expr [list [llength $args] ? (([join $args +]) / [llength $args]) : {"!ERR"}]]
}

main {*}$argv