An Excel emulator written in Tcl, expanded from A bigger spreadsheet.
Requires the code in SYLK to be included as a separate tcl file (as in this code - you could import that code directly into this).
# TekSel A spreadsheet with options to set/change formulae.
# The basic data structure of a cell is an array:
# a Tk label with a formula, a value, a list of cells referred to by this cell.
# An entry area for editing formula.
# The list of traces causes referring cells to reevaluate.
package require BWidget ;# for scrilledwindow
proc changeformula {vn newv dbg} { ;# change cell variable vn to new formula
upvar #0 $vn vloc
set vloc(formula) [subst -nocommands $newv]
foreach trac $vloc(links) { # unset traces on cell.
eval trace remove $trac
}
set vloc(links) {} ;# clear record of cell links
foreach var [regsub -all {[-+/*(), \]\[]} $vloc(formula) { }] { ;# set watch on each variable
# if variable in formula changes then change this result (& so on)
if {[uplevel #0 info vars $var]!=""} {
set cmd "variable ::$var {write} \"evaluate $vn\""
eval trace add $cmd
lappend vloc(links) $cmd
}
}
subvariables $vn $dbg;# convert names of cells/vars to tcl form
evaluate $vn
}
proc txlchangeform {v {dbg 0}} { ;# testing for newer txlchangeformula
set bracks [matchbrackets $v] ;# get list of bracket/close pairs
if {[llength $bracks]>-1} { ;# may need to analyse the brackets if preceded by function
set in2 ""
set cpos 0
set comit -1
set prevtoken ""
set fn ""
set in2 {}
# puts "bracks in $v are $bracks"
foreach part [regsub -all {([\^+\-*/\(\) ,])} $v { \1 }] {
# each part is a token in the string - a cell name OR an operator
incr cpos [string length $part]
if {$cpos>$comit} {
global slkdata
if {$part!="*" && [array names slkdata "name,$part"]!=""} {
regsub -all {R(\d*)C(\d*)} $slkdata(name,$part) {\1 \2} f1
set cellref [eval getreference $f1]
set part $cellref
}
switch -- $part {
"(" {
set lpos [lsearch $bracks "$cpos *"]
if {$lpos>=0} {
set range [lindex $bracks $lpos]
set cs [txlchangeform [eval string range "$v" $range] $dbg]
set part "$part[join $cs " "])"
#puts "Lbracket $lpos >>$range<< $v becomes >>$part<<"
set comit [expr {[lindex $range 1]+2}]
if {[string match $fn "power"]} {
append in2 "pow($prevtoken,$part)"
set fn ""
set part ""
} elseif {[string match $fn "date"]} { ;# split arguments at unused comma
# allows complex dates
set ags [split [string range $part 1 end-1] {@}]
append in2 "$prevtoken\[$fn [join $ags]\]"
set fn ""
set part ""
} elseif {[string match $fn "atan2"]} { ;# swap arguments
set ags [split [string range $part 1 end-1] {@}]
# split at @ as these are unused args.
# eg function atan2(atan2(3,2),1) would
# split at the comma in the first arg if split at comma.
# this algorithm returns atan2(atan2(3,2)@1)
append in2 "${prevtoken}$fn\([lindex $ags 1],[lindex $ags 0]\)"
set fn ""
set part ""
} elseif {[string match $fn "pi"]} {
} elseif {![string match $fn ""]} {
append in2 "$prevtoken[eval $fn [split [string range $part 1 end-1] ":"]]"
set fn ""
set part ""
} else {
append in2 $prevtoken
}
} else {
append in2 $prevtoken
}
}
"," {# replace commas with character marking 'unchanged comma'
append in2 "$prevtoken"
set part "@" ;# make clear the commas at this level.
}
"^" { set fn "power" }
atan2 -
date -
degrees -
radians -
laplacian -
prod -
sum -
mean {
set fn "$part"
}
pi {
append in2 "$prevtoken[$part]"
set comit [expr {$cpos+2}]
set part ""
}
default {
if {[string match $fn "power"]} {
append in2 "pow($prevtoken,$part)"
set fn ""
set part ""
} elseif {[string match $fn "date"]} { ;# split arguments at comma
set ags [split [string range $part 1 end-1] ","]
append in2 "$prevtoken\[$fn [join $ags]\]"
} elseif {[string match $fn "atan2"]} { ;# swap arguments
set ags [split [string range $part 1 end-1] ","]
append in2 "${prevtoken}$fn\([lindex $ags 1],[lindex $ags 0]\)"
puts "Atan2 == $in2"
} elseif {[string match $fn "pi"]} {
} elseif {![string match $fn ""]} {
append in2 "$prevtoken[$fn $part]"
set fn ""
set part ""
} else {
append in2 $prevtoken
}
}
}
if {[string match $fn ""]} {set prevtoken $part} ;#else { puts "Not part $v at $part; $prevtoken"}
} ;# cpos<comit region to be omitted from parsing
}
append in2 $prevtoken
}
return [subst $in2]
}
proc txlchangeformula {cell v {dbg 0}} { ;# converts an excel-like formula to tcl-> spreadsheet
upvar #0 $cell vloc
set vloc(rawformula) $v
set in2 [txlchangeform $v $dbg] ;# append [expr {$cell=="e8"}] to set dbg flag for cell e8
changeformula $cell $in2 $dbg
return $in2
}
proc subvariables {vn {dbg 0}} { ;# change variables into Tcl variables, eg d12->$d12(value).
upvar #0 $vn vloc
upvar #0 vlist clist
set form [regsub -all {([+\-*/\(\) ,\[\]])} $vloc(formula) { {\1} }] ;# the formula
set i 0
foreach part $form {
if {[lsearch -exact $clist $part]>=0} {
set form [lreplace $form $i $i "\$${part}(value)"]
} ;#else { puts "No good $part"}
incr i
}
#this string map ensures division uses floating point arithmetic
set vloc(tclformula) [string map {/ *1.0/} [join $form {}]]
}
proc evaluate {vn args} { ;# reevaluate the formula - args are sent by trace callbacks
upvar #0 $vn vloc
# evaluate the formula in top level (as accesses other cell values)
# replace value for display
if {[catch {set vloc(value) [uplevel #0 expr $vloc(tclformula)]}]} {
set vloc(value) $vloc(rawformula)
}
return $vloc(value)
}
proc showformula {where tick cell} { ;# where is the input entry area. cell is where to copy formula from
# copy formula from cell to change formula area.
upvar #0 $cell vloc
global slkdata
$where delete 0 end; $where insert 0 $vloc(rawformula)
# Change effect of Update button to send "where" to cell
$tick config -command "txlchangeformula $cell \[$where get\]" -text "Update $cell"
}
proc matchbrackets {tsb {depth 0}} { ;# returns list of matching brace to Nth lh brace.
# Or any other pair of letters, eg ( ); [ ]
incr depth
set rddepth 0
set cind 0
set cclos -1
set res ""
set words [regsub -all {([\(\)\[\]])} $tsb { \1 }]
;# check each block for brackets
catch {
foreach block $words {
if {$cind>$cclos} {
if {$block== "\[" || $block== "\("} {
set substring [string range $tsb [expr {$cind+1}] end]
set match [matchbrackets $substring $depth]
foreach p $match {
set p [list [expr {[lindex $p 0]+$cind+1}] [expr {[lindex $p 1]+$cind+1}]]
lappend res $p
}
set cclos [lindex [lindex $res end] end] ;# last character in bracket - already tested
incr rddepth
} elseif {$block== "\]" || $block== "\)"} {
incr rddepth -1
if {$rddepth<0} {
lappend res [list 0 [expr $cind-1]]
return $res
}
}
}
if {$depth<=1 && $rddepth<0} {return $rddepth}
incr cind [string length $block]
}
}
if {$depth<=1 && $rddepth>0} {return $rddepth}
if {![info exists res]} { return ""}
return $res;#### try new method - below this works
}
#
# create the cells. Lets call them A1, A2... b1,b2 etc like many other spreadsheets
set vlist {} ;# list of cell names
pack [frame .enterform]
pack [button .enterform.tick -text "Update" -relief raised -width 8] -side left
pack [entry .enterform.input -width 72] -side left
pack [frame .rowtitle]
pack [label .rowtitle.about -text "TXl" -width 4] -side left
proc getcell {cell dc dr} { ;# cell relative to cell by dc, dr cols & rows
set col [string index $cell 0]
set newcol [format %c [expr [scan $col %c]+$dc]]
return $newcol[expr {[string range $cell 1 end]+$dr}]
}
proc laplacian {cell} { # laplacian - mean of 4 surrounding cells.
set row [string range $cell 1 end]
set col [string index $cell 0]
set sum "[getcell $cell -1 0]+[getcell $cell 1 0]"
append sum "+[getcell $cell 0 -1]+[getcell $cell 0 1]"
return "($sum)*.25"
}
proc debug {{cell b6}} {
upvar #0 $cell cl
puts "Cell $cell - $cl(rawformula)"
puts " l1 $cell - $cl(formula)"
puts " tcl $cell - $cl(tclformula)"
}
if 0 {
Tcl math functions can be used and new functions such as pi.
}
proc pi {} { return 3.1415926535897}
if 0 { Examples of extending the functions available:
range is used internally to produce a list of cells in a rectangular region
sum adds a range of cells
mean the mean value of the range
prod the product of all the values in the range.
Note how these are inserted into cells, eg:
txlchangeformula a7 "[mean e1 e4]"
OR using the conversion procs above:
txlchangeformula a7 "mean(e1:e4)"
}
proc range {cstart cend} { ;# return list of variables in range start to end
set col [string index $cstart 0]
while {$col <= [string index $cend 0]} {
set row [string range $cstart 1 end]
while {$row <=[string range $cend 1 end]} {
lappend range $col$row
incr row
}
set col [format %c [expr [scan $col %c]+1]]
}
return $range
}
proc sum {cstart cend} { # sum converts to sum of cell names.
foreach vn [range $cstart $cend] { append res "+$vn"}
return "(${res})"
}
proc mean {cstart cend} { # mean= sum of cell names divide by Ncells.
return "([sum $cstart $cend]/[expr double([llength [range $cstart $cend]])])"
}
proc prod {cstart cend} { # prod converts to multiplication of cell names.
set res "1"
foreach vn [range $cstart $cend] { append res "*$vn"}
return "(${res})"
}
proc radians {degs} { # converts cell or formula to radians.
return "(($degs)/57.295779513082320876798154814105)"
}
proc degrees {rads} { # converts to degrees.
return "(57.295779513082320876798154814105*($rads))"
}
proc date {year month day} { # converts to days since 1 Jan 1970.
return "round(\[clock scan $year-$month-$day\]/86400.)"
}
pack [ScrolledWindow .sw] -expand t -fill both
set grd [ScrollableFrame .sw.gridd]
.sw setwidget $grd
set grd [$grd getframe]
catch {
# auto_mkindex [pwd]
# pkg_mkIndex [pwd]
# package require Sylk 0.2
source rdslk.tcl
proc getreference {irow icol} { ;# convert int I,J to B12 format
return "[format %c [expr {96+$icol}]]$irow"
}
proc cellsub {form col row} { ;# sub RNNCMM to AB for SLK files only
set fou ""
foreach part [regsub -all {([\^+\-*/\(\) ,])} $form { \1 }] {
regsub -all {R(\d*)C(\d*)} $part {\1 \2} rowcol
if {$rowcol!=$part} { ;# format RnnCmm found
if {[llength $rowcol]<2} { lappend rowcol $col }
#puts "$part->$rowcol"
append fou [eval getreference $rowcol]
} else {append fou $part}
}
# set fou [regsub -all {R(\d*)C(\d*)} $form {[getreference \1 \2]}]
return [string tolower $fou]
}
set slkfile sample.slk
readSYLK $slkfile slkdata
for {set ir 1} {$ir<=$slkdata(yMax)} {incr ir} { ;# for all the rows of data defined
set rowlabel [label $grd.rlab$ir -text $ir -width 4]
grid $rowlabel -column 1 -row [expr {$ir+1}]
for {set jr 1} {$jr<=$slkdata(xMax)} {incr jr} { ;# for each cell that has been defined
if {$ir==1} { ;# label the columns
set colnam [format "%c" [expr [scan "a" %c]+$jr-1]]
grid [label $grd.$colnam -text $colnam] -column [expr $jr+1] -row 1
}
set column [format "%c" [expr [scan "a" %c]+$jr-1]]
set vname $column$ir
variable $vname
lappend vlist $vname
set ${vname}(rawformula) 0.0
set ${vname}(tclformula) 0.0
set ${vname}(formula) 0.0
set ${vname}(value) ""
set ${vname}(links) {}
set element [label $grd.$ir$column -textvar ${vname}(value) -relief raised -width 16]
grid $element -column [expr {$jr+1}] -row [expr {$ir+1}]
bind $element <ButtonRelease> "showformula .enterform.input \
.enterform.tick $vname"
}
}
for {set ir 1} {$ir<=$slkdata(yMax)} {incr ir} { ;# or <$slkdata(yMax)
foreach name [array names slkdata *,$ir,value] { ;# for each cell that has been defined
set formnam [string map {value formula} $name]
set cellparts [split $name ","]
set cellref [getreference [lindex $cellparts 1] [lindex $cellparts 0]]
if {[array names slkdata $formnam]!=""} { ;# use the formula
if {[catch {
txlchangeformula $cellref [cellsub $slkdata($formnam) [lindex $cellparts 1] [lindex $cellparts 0]]
} errmsg]} {puts "$cellref Error $errmsg in formula $slkdata($formnam)"
catch { txlchangeformula $cellref [cellsub $slkdata($formnam) [lindex $cellparts 1] [lindex $cellparts 0]] 1}
}
} else { ;# constant value- no formula puts "$cellref Row $ir constant $slkdata($name) "
txlchangeformula $cellref [cellsub $slkdata($name) [lindex $cellparts 1] [lindex $cellparts 0]]
}
set sep 0
foreach type {"format" "numformat" "pformindex"} {
if {[array names slkdata [string map "value $type" $name]]!=""} {
if {!$sep} { puts "=== cell $cellref"; set sep 1}
puts "Format $type $slkdata([string map "value $type" $name])"}
}
}
}
wm title . "TXl $slkfile"
}
if {[array size slkdata]<2} { ;# could not find/read the file. Load some test formulae
puts "File $slkfile was not loaded correctly."
}Here is a small file to save as sample.slk
ID;PWXL;N;E B;Y16;X3;D0 0 15 2 O;L;D;V0;K47;G100 0.001 C;Y1;X1;K"X" C;X2;K"Y" C;X3;K"atan(xy)" C;Y2;X1;K10 C;X2;K1 C;X3;K0.099668652491162;EATAN2(RC[-2],RC[-1]) C;Y3;X1;K9;ER[-1]C-1 C;X2;K2;ER[-1]C+1 C;X3;K0.218668945873942;EATAN2(RC[-2],RC[-1]) C;Y4;X1;K8;ER[-1]C-1 C;X2;K3;ER[-1]C+1 C;X3;K0.358770670270572;EATAN2(RC[-2],RC[-1]) C;Y5;X1;K7;ER[-1]C-1 C;X2;K4;ER[-1]C+1 C;X3;K0.519146114246523;EATAN2(RC[-2],RC[-1]) C;Y6;X1;K6;ER[-1]C-1 C;X2;K5;ER[-1]C+1 C;X3;K0.694738276196703;EATAN2(RC[-2],RC[-1]) C;Y7;X1;K5;ER[-1]C-1 C;X2;K6;ER[-1]C+1 C;X3;K0.876058050598193;EATAN2(RC[-2],RC[-1]) C;Y8;X1;K4;ER[-1]C-1 C;X2;K7;ER[-1]C+1 C;X3;K1.05165021254837;EATAN2(RC[-2],RC[-1]) C;Y9;X1;K3;ER[-1]C-1 C;X2;K8;ER[-1]C+1 C;X3;K1.21202565652432;EATAN2(RC[-2],RC[-1]) C;Y10;X1;K2;ER[-1]C-1 C;X2;K9;ER[-1]C+1 C;X3;K1.35212738092095;EATAN2(RC[-2],RC[-1]) C;Y11;X1;K1;ER[-1]C-1 C;X2;K10;ER[-1]C+1 C;X3;K1.47112767430373;EATAN2(RC[-2],RC[-1]) C;Y12;X1;K0;ER[-1]C-1 C;X2;K11;ER[-1]C+1 C;X3;K1.5707963267949;EATAN2(RC[-2],RC[-1]) C;Y13;X1;K-1;ER[-1]C-1 C;X2;K12;ER[-1]C+1 C;X3;K1.65393755868334;EATAN2(RC[-2],RC[-1]) C;Y14;X1;K-2;ER[-1]C-1 C;X2;K13;ER[-1]C+1 C;X3;K1.72344565519016;EATAN2(RC[-2],RC[-1]) C;Y15;X1;K-3;ER[-1]C-1 C;X2;K14;ER[-1]C+1 C;X3;K1.78188966001764;EATAN2(RC[-2],RC[-1]) C;Y16;X1;K-4;ER[-1]C-1 C;X2;K15;ER[-1]C+1 C;X3;K1.83139871854224;EATAN2(RC[-2],RC[-1]) E