Summary edit

Tom Turkey

sf.net

Code edit

 # tk#.tcl --
 #
 #      A simple spreadsheet especially designed to show off the
 #      properties of tcl/tk.
 #
 # Copyright (c) 1997 GPL / Martin Vermeer & The tk# Team
 # [email protected]
 #
 # Click "About" for info on copying and lack of guarantees :-)
 #
 #Versions: 
 #    MV 06-Sep-97 Base version
 #    MV 08-Sep-97 Changes mainly in ReDisplay to improve performance
 #    MV 10-Sep-97 Changes due to remarks by Bruce Gingery:
 #                 Quit panel added "cancel"
 #                 Colour choice cancel error fixed
 #                 Current cell uses textbg as fg for clarity
 #                 Clear added to Format menu
 #                 Selected link paint in on-line manual
 #                 Manual language improvement + Quickstart addition
 #    MV 11-Sep-97 Fixed watch cursor bug in rename row/col
 #                 Fixed multi-word left align format bug
 #                 Corrected manual explanation of [Sum ...] etc. functions
 #                 Added tagging of selected rows/columns
 #    MV 12-Sep-97 Added select match string construction for aggregates
 #                 Fixed watch cursor bug Select Box
 #                 Fixed current cell hilite bug Recalc-Sel
 #    MV 14-Sep-97 Added functions AboveCell...RightCell; Today, USAtoday.
 #                 Removed set "Modified" flag if cell content unchanged.
 #                 Template variable $i packed in parentheses to prevent
 #                 match between, e.g., "Row1" and "Row10".
 #                 Added REPOSITORIES for function and other definitions,
 #                 as suggested by Bruce Gingery to support extensibility.
 #    MV 15-Sep-97 Called clock control buttons Start and Stop.
 #                 Multiple cmd line load filenames implemented
 #                 Export comma separated table added; removal of separator
 #                 from field values.
 #                 Create directory tl# in user root for repository files.
 #    MV 16-Sep-97 Fixed bug in NewNameError: used "string first" function.
 #                 Bug in FormattedCell: test existence v-element
 #    MV 17-Sep-97 Final bug fixes. Redefine $initdir as [pwd] if dir
 #                 nonexistent (other machine/user). 
 #                 Default ext .tl# for load repository.
 #
 
 proc wm args { }
 
 # init --
 #
 # proc to initialize a number of things needed to be able to display
 # an empty worksheet, and continue working.
 #
 proc init {argc argv} {
 global thisformula r c rows cols headrows sidecols f v cw rowsel colsel
 global autocalc modified filename exportname inspoint colours initdir
 global reload tr tc defmov winsize env tcl_precisiona reps
     set tcl_precision 17
 
     set autocalc 1
     # to detect multiple (overlaying) loads:
     set reload   0 
 
     TemplateDefault
     set rows {}
     set cols {}
     set sidecols {title}
     set headrows {title}
     set r title
     set c title
     foreach x {title} {set cw($x) 12; set cs($x) 0} 
     foreach x {title} {set rs($x) 0} 
     set thisformula ""
     set f(title,title) ""
     set rowsel {}; set colsel {}
     set inspoint {^$}
     # Create a dedicated data directory. 
     if ![file exists "$env(HOME)/tk#"] {
         if [catch {exec mkdir "$env(HOME)/tk#"} result] {
             puts $result
         }
     } 
     # Create a directory for user function repositories.
     if ![file exists "$env(HOME)/tl#"] {
         if [catch {exec mkdir "$env(HOME)/tl#"} result] {
             puts $result
         }
     }
     ColourDefault
     set filename "datafile.tk#"
     set exportname "datafile.dat"
     set initdir [pwd]
     set defmov "-"
     set winsize "550x355+0+200"
     set reps {}
    
     Getrc
     return
 }
 
 # ColourDefault --
 #
 #      Set the colours to acceptable default values. 
 #      Will be overridden by any loaded files.
 #
 proc ColourDefault {} {
 global colours
     # set up colours:
     # textfg textbg      for text in panels
     # textcur            current cell bg
     # selcolour          selected rows/cols
     # inscolour          insert col/row position
     # timecolor          timer (clock) cell     
     # iconcolour         tk# icon colour
     # mancolour          used for titles in manual
     set colourlist {textfg black textbg   white                \
                     textcur      blue     selcolour     yellow \
                     inscolour    red      timecolour    green  \
                     iconcolour   blue     mancolour     blue }
     foreach {x y} $colourlist {
 #        if ![info exists colours($x)] {set colours($x) $y}
         set colours($x) $y
     }
     return
 }
 
 # TemplateDefault --
 #
 #      Reset "template" to empty string and "spawn" to 1.
 #
 proc TemplateDefault {} {
 global template spawn
     set spawn 1
     set template ""
 }
 
 # InitIndexRow --
 #
 # Initialize table rs of row starting indices. Return no. of rows.
 #
 # Arguments:
 #      prows   Row name list to be processed in this call.
 #              Either $rows or $headrows.
 #
 proc InitIndexRow {prows} {
 global rs
     set bgn 0
     foreach r $prows {
         array set rs "$r $bgn"
         incr bgn
     }
     return $bgn
 } 
 
 # InitIndexCol --
 #
 #      Initialize tables cs of col starting indices and cw of col widths.
 #      Return total no. of character positions in a row. 
 #
 # Arguments:
 #      pcols   Col name list to be processed in this call.
 #              Either $cols or $sidecols.
 #
 proc InitIndexCol {pcols} {
 global cs cw
     set bgn 0
     foreach c $pcols {
         set cs($c) $bgn
         incr bgn $cw($c)
         }
     return $bgn
 }
 
 # InitIndex --
 #
 #      Init the row and col start and width tables for all panels.
 #
 proc InitIndex {} {
 global rows cols headrows sidecols
 global cw cs rs rowsel colsel f
     InitIndexRow $headrows
     InitIndexRow $rows
     InitIndexCol $sidecols
     InitIndexCol $cols
 }
 
 # PanelsState --
 #
 #      Set state to "normal" or "disabled" 
 #      to make spreadsheet panels uneditable.
 #
 proc PanelsState {state} {
 global frq
     foreach panel {corner side head main} {
         $frq.$panel config -state $state
     }
 }
 
 # PutIcon --
 #
 #      Place an icon on the corner panel for About and Manual
 #
 # Arguments:
 #      w     Intended width of panels "corner" and "side"
 #
 proc PutIcon {w} {
 global colours frq
 
     $frq.corner config -width $w -height 3 
     $frq.head     config -height 3
     $frq.side     config -width $w
     $frq.corner delete 1.0 end
 
     # Construct the "tk#" icon from textual elements:
     
     $frq.corner tag configure tktag   -font "*-times-bold-i-normal-*-24*" \
                              -foreground $colours(mancolour) \
                              -background $colours(textbg) -justify center
     $frq.corner tag configure hashtag -font "*-bold-o-normal-*-34*" \
                              -offset -15 -foreground $colours(iconcolour) \
                              -background $colours(textbg) -just center
     $frq.corner insert end "tk" tktag
     $frq.corner insert end "#\n" hashtag
 
     $frq.head delete 1.0 end
     $frq.head tag configure centered -justify center
     $frq.head insert end {####    (tk-number)    ####} {mancolour centered}
     $frq.head insert end {
 A spreadsheet with a difference!
 Copyright (c) 1997 GPL / Martin Vermeer & The tk# Team.} centered
     return
 }
 
 # About --
 #
 #      Put the "About..." information into the spreadsheet.
 #     
 proc About {} {
 global frq
     PanelsState normal
 
     PutIcon 11
     $frq.side delete 1.0 end
     $frq.main delete 1.0 end
     $frq.main tag configure centered -justify center
     $frq.main insert end {
 No promises, no lies; may be freely copied and 
 improved in agreement with the spirit of the 
 Gnu Public License, the text of which is 
 fro forma included by this reference.
 } centered
     PanelsState disabled
 }
 
 # HandleButton1 --
 #
 #      Show the chapter heading for this link;
 #      highlight chosen link in index panel
 #
 proc HandleButton1 {tagname} {
 global frq colours
     # Only way to get rid of old highlights: Redraw it all :-(
     Manual
     $frq.main see $tagname.first
     $frq.side tag configure $tagname -background $colours(mancolour) \
               -foreground $colours(textbg)
     return
 }
 
 # PutManChapter --
 #
 #      Put a single manual chapter, with title, properly tagged, into
 #      both the side panel (titles only) and the main panel (titles + text).
 #
 # Arguments:
 #      tagno     Tag label, only used internally to connect panels "side" and
 #                "main".
 #      text      The name of the chapter = link title appearing in "side".
 #      chapter   The plain text of the chapter (or part of it).
 #
 proc PutManChapter {tagno text chapter} {
 global frq colours
     # creates a button in the "side" panel, carrying a keyword
     # which is searched for (command!) in the "main" panel if pressed.
 
     $frq.side tag configure t$tagno -foreground $colours(mancolour) \
               -background $colours(textbg) -underline true
     $frq.main tag configure t$tagno -background $colours(mancolour) \
          -foreground $colours(textbg) -justify center
 
     # intelligent TOC: clicking mouse scrolls text to visibility.
     $frq.side tag bind t$tagno <Button-1> [list HandleButton1 t$tagno]
     
     $frq.side insert end $text\n t$tagno
     $frq.main insert end $text t$tagno 
 
     $frq.main insert end $chapter\n
 
     return
 }
 
 # PutTaggedText --
 #
 #      Put an amount of text with a tag connected to it into main panel.
 #
 # Arguments:
 #      t      Tag to be used.
 #      text   Text in "main" panel to apply it to.
 #
 proc PutTaggedText {t text} {
     .w.fr.frq.main insert end $text $t
     return
 }
 
 # PutText --
 #
 #      Put an amount of text as such to the main panel.
 #
 # Argument:
 #      text   The text to put into "main" panel.
 #
 proc PutText {text} {.w.fr.frq.main insert end $text}
 
 # Manual --
 #
 #      Put the on-line manual text to the main panel screen.
 #
 proc Manual {} {
 global frq
     PanelsState normal
     PutIcon 20
 
     $frq.side delete 1.0 end
 
     $frq.main delete 1.0 end
     $frq.main configure -wrap word
 
     # Define the formatting tags we may want to use:
     $frq.main tag config tabindent -lmargin2 150
     $frq.main tag configure centered -justify center
 
     $frq.main insert end {
 
 TK# ON-LINE MANUAL
 ==================
 
 } centered
     PutManChapter 1 Introduction {
 tk# is a simple but intelligent spreadsheet written in tcl/tk.
 
 The graphic abilities of tk are used to provide a grid of four\
 interconnected, scrolling panels containing cells with formulas\
 and data values associated with them: 
 
                        <-------------> 
          +-------------+-------------+
          !   corner    !     head    !
       ^  +-------------+-------------+
       !  !    side     !     main    !
       v  +-------------+-------------+
 
 The top and left panels ("head" and "side"), which are narrow\
 and scroll only in one\
 direction, contain the names of the rows/columns. 
 
 Additionally, they may contain user defined things such as row and column\
 sums, so-called "aggregates", which then also remain always visible even\
 when navigating through the (large) main panel.
 
 The scrollable main panel, on the other hand, contains the bulk\
 of the data. Its scrolling behaviour helps when entering large\
 amounts of data. 
 
 Because of performance reasons, you should not make the main panel larger\
 than, say, 100 x 100 cells; you do wiser to split your application into\
 smaller parts handled separately, save selections from them, and load these\
 together. Be aware that tk# allows saving of the selection (with row/column\
 titles) as well as multiple loading of data files with overlaying, cf. below.
 
 One thing that makes tk# special is that IT DO NOT USE NUMBERS but names\
 to refer to rows and columns. Also selection of ranges is based\
 on names and regular expression matching, as is the evaluation of\
 formulas over cell ranges (summation etc.) which is an important\
 part of real life spreadsheet usage (think of bookkeeping!).
 
 QUICKSTART:
 
 Start up tk# without a filename, and give the following commands in\
 succession:
 
     Edit/Row Spawn
     Spawn Factor:   10
     Template:       R$i
 
     Edit/Col Spawn
     Spawn Factor:   10
     Template:       C$i
 
 This will set up a 10 x 10 spreadsheet blank to get you started.\
 Just enter values, strings and expressions (see below) into the\
 Formula: -box, when it has the focus (ESC toggles). Pressing\
 ENTER will put them into the sheet.
 }
     PutManChapter 2 Functions {
 Within expressions, you can use the full math facility,\
 including the function library, provided with tcl; see the\
 tcl manual. Also all the common operators are provided.
 
 Formulas should be tcl expressions: one round of variable and command\
 substitution is done. Please note that numerical expressions must be\
 enclosed in
 
      [expr ... ]
 
 in order to be evaluated. The ellipsis represents your expression, e.g.
 
      [expr sqrt(2)]
 
 to get the square root of 2. This enclosing is achieved by pressing\
 control-E in the Formula: entry box. Alternatively, use the Format menu\
 item.
 
 Strings, bot numeric and non-numeric, are copied straight over to\
 the corresponding cell value. This is useful for text and\
 direct data entries.
 
 There is a set of SPECIAL or AGGREGATE FUNCTIONS implemented in tk# for\
 summation and the like.
 
 NOTE. In these summation functions, always summation over the CURRENT\
 column (c) or row (r) is implied. The second argument is a MATCH STRING,\
 which is matched against either row or column NAMES. This is a non-trivial
 thing, quite different from traditional spreadsheets, and should be well\
 understood. }
     PutTaggedText {tabindent} {
      [Sum c June]        sums elements in THIS column and in ALL rows\
 containing the string "June" in their names.
 
      [Sum r Sales]       row sum over all cols with "Sales" in name
 
      [Av  c June]        average
 
      [Cnt r Rent]        no of cols named Rent-something
 
      [wSum c June wtscol]  column sum of June rows weighted\
 by entries in the column "wtscol".
                          This one can be generalized by defining,\
 in the column "wtscol" (e.g. the neighbouring column), the variable\
 $wtscol by the statement "set wtscol $r". 
                          After that, writing
      [wSum c June $wtscol]  will give the same sum as above. However,\
 now RENAMING the weights column to something else will not break the sum!
 
      [wAv c June $wtsrow]  weighted average.
 
      [Ssq  r Gas]        sum of squares
      [wSsq r Gas $wtscol] same, weighted
 
      [RMS  c June]       root-mean-square
      [wRMS c June $wtscol] weighted
 
      [Sd  r Rent]        standard deviation
      [wSd r Rent]        weighted 
 }
     PutText {
 These last functions are not very well tested yet.
 
 NOTE the use of square brackets forcing, what is called\
 "command substitution" i.e. execution of the procedure enclosed.
 
 Example of use:
 
   title     csums     ! -spalte1    -spalte2    -spalte3
   rsums               ! [Sum c sei] [Sum c sei] [Sum c sei]
   --------------------+------------------------------------
   seile1- [Sum r spa] !          12          18         222
   seile2- [Sum r spa] !          15           3          17
   seile3- [Sum r spa] !           7           8          10
 
 Upon recalc you should see the sums appear. The argument "sei" inside\
 the [ ] causes a match with the row names containing this substring, in this\
 case all three of them.
 
 NOTE NOTE NOTE (you MUST UNDERSTAND this!):
 As you see from the example, when summing through a ROW (i.e. [Sum r ...]\
 you should give a match string for COLUMN headers ("spa").\
 And vice versa!
 
 NOTE also that it pays off to choose row and column names judiciously,\
       so you can use them easily in this way!
 
 NOTE a facility that makes selecting rows/columns for summation easier,\
 is the TAGGING/UNTAGGING FACILITY. These are found in the Row/Col Rename\
 subwindows. Use them by using the match string argument "#$" in your\
 summation command, e.g.
    [Sum c #$]
 }
     PutManChapter 3 "Selecting Cells" {
 First you select the cells to edit by putting an "anchor" using\
 mouse button 1 (the left one). This selects this one\
 cell, making it the CURRENT CELL). The anchor will be top left of\
 the selected range.
 
 Mouse-3 (the right one) then marks the end (bottom right) of a selected range,\
 both in columns and in rows. The range is painted on the screen,\
 but ONLY in the row and column headers (this is for efficiency reasons\
 with large spreadsheets).
 
 Alternatively, you can use the Select Match -item from the Select\
 menu, to give two "match strings" to select row and column names\
 with. NOTE that a select range defined in this way may be non-contiguous.
 
 The matching procedure used is regular expression matching (REGEXP,\
 see tcp manual).
 
 A third alternative is to directly enter a non-contiguous set of\
 row or column names in listboxes, accessible through the\
 Select/Row Select Box or Select/Col Select Box menu items.\
 Also a thus selected range may be non-contiguous (but will of course\
 always be an intersection of a row and a column selection, cf. below).
 
 NOTE (technical remark) that a selected range is ALWAYS the intersection\
 of a row selection and a column selection. Inside the software, they\
 are represented by the lists $rowsel and $colsel.
 }
     PutManChapter 4 "Editing Cells" {
 Once you have made your selection, you can just start editing it\
 in the Formula: -box. (this will contain the formula of the\
 current cell as a starting point). 
 
 NOTE that pressing the left mouse button above, already moved focus\
 to the Formula: -box. This is the quickest way for editing only\
 one cell.
 
 You can also select ONE CELL by using the keyboard only: use the\
 arrow keys to go to the cell, then press ENTER to get it into the\
 "Formula:" -box. 
 
 If you press ESC, you will be given an empty box. In fact, you can toggle\
 between NAV and EDIT modes by just prssing enter. The focus will change\
 correspondingly between the spreadsheet panels and the "Formula:" edit\
 window.
 
 EXPERIMENT!
 } 
     PutManChapter 5 "Formula Entry" {
 When you are finished editing, ENTER moves your formula (expression)\
 into the spreadsheet; ESC cancels your expression.
 
 If a select RANGE is active (not just one cell) your entry will\
 be moved into every cell in the range. You can include counters\
 $i, $j (row, column within select area starting from 0) or row,\
 column names ($r, $c) to make the entries different. You can\
 use this to fill in a large number of cells at once and\
 corresponds a little bit with "relative cell numbering" in\
 other spreadsheets.
 }
     PutManChapter 6 "Formula Formatting" {
 When focus is on the Formula: -box, you can give commands to format\
 or unformat the entry in the box. The commands are all given in the\
 Format menu, and have control key shortcuts.
 }
     PutTaggedText tabindent {
 Fixed real      ^F       requires a Format entry in the entrybox right,
 Floating real   ^G       e.g. 12.6
 Integer         ^N       requires format e.g. 8
 Left align      ^L
 Currency        ^C       two digits fixed point.
 
 Make expression ^E       enclose in [expr ...]
 Remove expr              the reverse
 Remove format            removes the [format ...] strings added by the\
 above formatting commands.
 
 Replace by value         IRREVERSIBLE!
 }
     PutText {
 What these menu commands do, as do the equivalent control sequences, is\
 placing a 
 
     [format "%{fmt}f" ...] 
 
 thing around the expression to be formatted.\
 This operation is reversible, as the menu shows. The value "fmt" is taken\
 from the "Format:" box and is of form
 
     12.6
 
 for real values, and 
 
     12
 
 for integers. Just like in FORTRAN (a stone age programming language that\
 some of you might remember) or in tcl!
 
 Furthermore, you can change the display column width by directly\
 editing the "Colwidth:" entry box top right, and pressing ENTER.
 
 }
     PutManChapter 7 "The Insert Mark" {
 The insert mark is set on either the row or column header (the\
 first row or column containing their names) by clicking the\
 middle mouse button (Mouse-2) on it.
 
 Alternatively, Select/Insert Point gives you a listbox to choose from.
 
 Conventionally, if the insert point is lacking, it is assumed\
 AFTER the LAST row/column. Otherwise all insertions take place\
 before the marked row or column, moving the ones beyond aside to\
 make room.
 }
     PutManChapter 8 "Moving Things" {
 The Edit menu provides for a number of things to do with rows,\
 columns, groups of these and selected areas.} 
     PutTaggedText tabindent {
 Spawn:                   Take a group of rows/cols (the selection)\
 and copy it to the place indicated by the\
 insert marker.\
 This command asks for a TEMPLATE to\
 generate the new row/col names. This\
 template may contain the counter $i starting from 0. 
 }
  PutText {
 Example:     
 
           Spawn counter  3
           Template       Row[expr $i + 1]
 
 will insert three new rows under the names Row1, Row2, Row3.
 }
     PutTaggedText tabindent {
 Kill:                    Delete one or more rows/columns.\
 The selection (row or col) is deleted.
 
 Move:                    Move selection or rows/cols into the\
 insert point location.
 
 Rename:                  As the name indicates. Takes a row/col\
 template which may contain the counter $i.
 }
 PutText {
 A special case of rename is TAGGING: this\
 adds the suffix "#" (hash), which can be subsequently used in operations\
 involving row or column name string matching. Such operations are\
 especially the row/col summation ("aggregate") operations discussed earlier.
 
 In spawning and renaming, a new name is not accepted and the operation\
 cancelled if the name is a substring of an already existing name,\
 or an already existing name is a substring of the new name.\
 This would namely interfere with the use of the "insert select match"\
 feature in aggregate operations.
 
 }
     PutManChapter 9 "Special user functions" {
 You can put a CLOCK ticking in a cell. Mainly for keeping\
 hour sheets at the job. Moving to another cell and actuating\
 will stop and "value-ize" the current cell, and start the\
 new one ticking.
 
 The format of the clock value, which becomes visible if you do\
 a ReCalc or StopClock operation, is taken (1) from the Format:\
 -box, and this being empty, taken to be ColWidth.2.
 
 If you try to quit with the clock still running, it will be stopped\
 and the file marked modified. Quit will refuse until you have\
 saved the file.
 }
     PutTaggedText tabindent {
 CellAbove, CellBelow, CellLeft and CellRight:   \
 produce as function values (i.e. [CellAbove] etc...) the data values in these\
 neighbour cells. Useful for e.g. displaying a cumulative sum.
 
 Now, Today, USAtoday:   \ 
 produces the current date and time, or current date only, or date in USA\
 style format.
 }
     PutManChapter 10 Extensibility {
 tk# is EXTENSIBLE: You can enter procedure definitions as\
 formulas into cells by just writing them into the formula box,\
 and after recalculation they will be available for use.
 
 This is the extensibility intended for OLEO, here implemented\
 by the code bootstrap property (similar to LISP) of tcl.
 
 Another product attempting at similar extensibility is SIAG\
 (Scheme In A Grid) based on another LISP dialect.
 
 Contrary to those attempts, tk# is not only extensible, it also\
 borrows its special character from the programming & extension\
 language used, tcl/tk. This may take a little getting used to; but\
 once you have, you will discover for yourself that you can do things\
 with tk# that you wouldn't even have thought of with a traditional\
 spreadsheet!
 }
     PutManChapter 11 "Loading and Saving" {
 tk# saves the data file "intelligently" as a tcl/tk file to be sourced.\
 This applies for a complete as well as a partial (select range) save.
 
 Multiple loads on top of each other are supported;\
 then an intelligent merge takes place, keeping the union of\
 row/column names in memory. }
     PutTaggedText tabindent {
 Save:                    to same file
 Save As:                 to another file. Prompts for filename.
 Save Select              same, but only select range (plus row, col titles)\
 is saved.
 
 Import:                  Still insufficiently tested. Works only with\
 sheets exported WITH headers, using tab as separators.
 
 Export:                  Supports output of ASCII tables with\
 various field (cell) separators:\
 tab, blank, newline, LaTeX-style. 
                          Supports output of full sheet,\
 selection, selection plus row and column headers.
 
 Quit:                    Terminate tk#, but save/query if modified.
 }
   PutText {
 The tk# icon doubles as an indicator for "Modified" (i.e. red if modified,\
 green if not) and as a button for saving.
 
 A special word should be said about the REPOSITORY of function, binding\
 and widget definitions. It is possible to write a file containing such\
 definitions, which is then automatically loaded whenever an application\
 data file is loaded. These function etc. definitions then exist for the user,\
 but are NOT bound to any cell and also are NOT re-installed every time\
 the sheet is re-calculated.
 
 The way to associate a function repository with a data file is the following:\
 }
     PutTaggedText tabindent {
                   1.     Load the data file (default extension .tk#) using\
 the "File/Load" menu command;
                   2.     Load the repository file using the\
 "File/Load Repository" menu command;
                   3.     Save the data file.
 }
   PutText {
 Now, when re-loading this file, you can use the menu command\
 "File/Show Repositories" to display the associated repository file(s) in\
 the window title row. 
 
 The actual WRITING of repository files presupposes fluency in tcl/tk and a\
 sound understanding of the internal workings of tk#. It is not for beginners.
 
 }
     PutManChapter 12 Variables {
 The following variables are available for inclusion in formulas:}
     PutTaggedText tabindent {
     $r $c                row, col number
     $i,$j                numerical row/col counter used in\
 Spawn statements and in multiple\
 cell editing. Counts from 0 upward.
     $v($r,c$)            cell values.
 
 NOTE:                    You should NOT refer to cell values using\
 literal row/column names directly. If you\
 rename a row or column, any reference to\
 it will break.
 
                          Rather, put a statement
                               [set usecol $c]
                          in the column you intend to use,\
 and refer to $usecol after that.
 
 }
     PutManChapter 13 "File Names" {
 Internally, the program tk# uses three filenames:}
     PutTaggedText tabindent {
     $filename            The current filename used when saving;\
 this should always be displayed in the window header.
     $lfl                 The Last File Loaded.
     $lfs                 The Last File Saved.
     }
     PutText {
 The filenames $lfl and $lfs are displayed in the File menu and can be\
 loaded by clicking upon. Note that these two filenames are always\
 different.
 
 The file names $filename, $lfl and $lfs are NOT saved to the data file.\
 It is however possible to put them MANUALLY there. This is a trick,\
 which may be used e.g. to load a template file and then save the data\
 to a file, the name of which is generated according to some rule\
 specified by you. E.g. if you put in the data (template) file the\
 command 
 
     set filename "$env(HOME)/tk#/[Now].tk#"
 
 the template file will be loaded, but $filename set to a date and time\
 string, which will become the name of the next saved data file!\
 The procedures "Now", "Today" and "USAtoday"are defined in tk#.\
 You can define your own, either in tk# or in your source-able data file\
 (repository file).
 
 An advanced trick, to be used with considerable care...
 
 }
     PutManChapter 14 "Limitations" {
 Many. Not optimized for performance (would the 8.0 compiler help?)
 
 The code and its comments should be improved and extended and made to\
 conform to Ray Johnson's Tcl Style Guide, so also others can participate\
 in development (MV :-)).
 }
 
     PutManChapter 15 "Finally..." {
 tk# is distributed under the name tknum, to cater for the needs of\
 Netscape and (possibly) other mail/ftp agents. You should rename it on\
 your disk to "tk#", if your OS will allow it :-), which is its proper\
 name.
 
 Happy tcl/tk-ing!                    Martin Vermeer [email protected]
     }
     PanelsState disabled
     focus $frq.side
 }
 
 #################################
 ##
 ## High level procedures operating on rows or columns:
 ##
 
 # Iter --
 #
 #      General service routine for iterative user functions (sum, average, etc.)
 #      globalize anything that might be used in $start, $step and $final:
 #
 # Arguments:
 #
 # startScript   script to be executed once when starting
 # stepScript    script to be executed iteratively
 # finalScript   script to be executed once when finishing
 # match   match string for row/cols to be included in iteration
 # rr1     first row/col list
 # rr2     second row/col list
 # rr      r for row-wise, c for col-wise
 #
 # Returns:
 #        error messages in return values.
 #
 proc Iter {startScript stepScript finalScript match rr1 rr2 rr} {
 global r c v 
     # ALWAYS output something after a trapped error, NEVER leave catch dangling!
     if [catch {eval $startScript} result] {return "?ERR 1 $result"}
     if {$rr == "r"} {
         set oldr $r ; # save...
         foreach r [concat $rr1 $rr2] {
             if {[regexp $match $r]} {
                 if [catch {eval $stepScript} result] {return "?ERR 8 $result"}
             }
         }
         set r $oldr ; # ...restore
     } else {
         set oldc $c
         foreach c [concat $rr1 $rr2] {
             if {[regexp $match $c]} {
                 if [catch {eval $stepScript} result] {return "?ERR 9 $result"}
             }
         set c $oldc
         }
     }
     if [catch {eval $finalScript} result] {return "?ERR 2 $result"}
     return $s ; # This is the $s defined in SumAv!
 }
 
 # Citer --
 #
 #      Wrapper proc for iteration through a column (i.e. over rows).
 #
 # Arguments:
 #      startScript stepScript finalScript  See header of proc Iter.
 #      match                               Matching string for selecting
 #                                          rownames of cells to include.
 #
 proc Citer {startScript stepScript finalScript match} {
 global headrows rows
     return [Iter $startScript $stepScript $finalScript $match $headrows $rows r] 
 }
 
 # Riter --
 #
 #      Wrapper proc for iteration through a row (i.e. over columns).
 #
 #      startScript stepScript finalScript  See header of proc Iter.
 #      match                               Matching string for selecting
 #                                          colnames of cells to include.
 #
 proc Riter {startScript stepScript finalScript  match} {
 global sidecols cols
     return [Iter $startScript $stepScript $finalScript $match $sidecols $cols c] 
 }
 
 # -MakeIterCmd --
 #
 #      Switching routine to direct general specific iteration routines
 #      to either Citer or Riter, dpending on $rc flag.
 #
 # Argument:
 #      rc     r means: call Riter, c means: call Citer. 
 #
 proc MakeIterCmd {rc} {
     if {$rc == "c"} {
         return "Citer"
     } elseif {$rc == "r"} {
         return "Riter"
     } else {error "bad row/col flag: $rc"}
 }
 
 # SumAv --
 #
 #      Generalized routine used by all the others for aggregate operations.
 #      
 # Arguments:
 #      rc      r (row) or c (col)
 #      match   match string with row or col names to select elements to be
 #              aggregated
 #      sa      s (sum) or a (average). Flag for post-division by sum of
 #              weights
 #      wn      w (use weights) or n (do not)
 #      wt      name of row/col providing weights
 #      pwr     "power" parameter: 1 for ordinary sum/average, 2 for sum of
 #              squares 
 #
 # Results:
 #      Function value.
 #      Error messages go to spreadsheet cell or are "puts" in background
 #      window (warnings).
 #
 proc SumAv {rc match sa wn {wt 0} {pwr 1}} {
     # Process the Sum/Average flag:
     if {$sa == "a"} {
         set final {
             if [catch {set s [expr $s / $w]} result] {set s "?ERR 3 $result"}
             }
     } elseif {$sa == "s"} {set final {}} else {error "bad sum/av flag: $sa"}
 
     # Process the Weighted/Nonweighted flag:
     if {$wn == "w"} {
         if {$rc == "r"} {        
             set stepwt {
                 if [set ww 0; catch {scan $v($wt,$c) "%f" ww} result] {
                     puts "?ERR 6 $result"
                 } 
                 set w [expr $w + $ww]
             } 
         } else { 
             set stepwt {
                 if [set ww 0; catch {scan $v($r,$wt) "%f" ww} result] {
                     puts "?ERR 7 $result"
                 } 
                 set w [expr $w + $ww]
             }
         }
     } elseif {$wn == "n"} {
         set stepwt {set ww 1; incr w}
     } else {error "bad weighting flag: $wn"}
 
     # Initialize the (possible) weights column:
     set initwt "set wt $wt"
     # Initialize the "step" code:
     switch -- $pwr {
     1 {set stepdo { ; set s [expr $s + $ww * $vv] }}
     2 {set stepdo { ; set s [expr $s + $ww * $vv * $vv] }}
     }
     # Next, either Citer or Riter is executed:
     set s [[MakeIterCmd $rc] [concat {
             # start
             set s 0
             set w 0
             set ww 1 ;
         } $initwt] [concat {
             # step
             # if you can't find a float, put zero:
             if [catch {set vv 0; scan $v($r,$c) "%f" vv} result] {
                 # puts "?WRN 1 $result"
             } ;
         } $stepwt $stepdo] $final $match]
 
     # Return as function value of SumAv:
     return $s
 }
 
 proc Sum {rc match} {
     return [SumAv $rc $match s n]
 }
 
 proc Av {rc match} {
     return [SumAv $rc $match a n]
 }
 
 proc Cnt {rc match} {
     return [[MakeIterCmd $rc] {set s 0} {incr s} {return $s} $match]
 }
 
 # Weighted sum
 proc wSum {rc match wt} {
     return [SumAv $rc $match s w $wt] 
 }
 
 # Weighted average
 proc wAv {rc match wt} {
     return [SumAv $rc $match a w $wt]
 }
 
 # Sum of squares
 proc Ssq {rc match} {
     return [SumAv $rc $match s n 0 2]
 }
 
 # Weighted sum of squares
 proc wSsq {rc match wt} {
     return [SumAv $rc $match s w $wt 2] 
 }
 
 # Average of squares
 proc MS {rc match} {
     return [SumAv $rc $match a n 0 2]
 }
 
 # Root Mean Square
 proc RMS {rc match} {
     return [expr sqrt([MS $rc $match])]
 }
 
 # Weighted average of squares:
 proc wMS {rc match wt} {
     return [SumAv $rc $match a w $wt 2] 
 }
 
 # Root of Weighted average of squares:
 proc wRMS {rc match wt} {
     return [expr sqrt([wMS $rc $match $wt])] 
 }
 
 # Standard deviation:
 proc Sd {rc match} {
     set av [Av $rc $match]
     return [expr sqrt([MS $rc $match] - $av * $av)]
 }
 
 proc wSd {rc match wt} {
     set wav [wAv $rc $match $wt]
     return [expr sqrt([wMS $rc $match $wt] - $wav * $wav)]
 }
 
 # Colour --
 #
 #      Colour choice interaction wrapper routine.
 #      Typically the arg and function value are elements
 #      of the "Colours" array.
 #
 # Argument:
 #      colour       present value of colour.
 #      colourname   name of this colour
 #
 # Result:
 #      New colour value in function value.
 proc Colour {colour colourname} {
     set colour2 [tk_chooseColor -initialcolor $colour \
         -title "tk# colour choice: $colourname"]
     if {$colour2 != ""} {
         return $colour2
     } else {
         return $colour
     }
 }
 
 # Load --
 #
 #      Loads by "sourcing" a tk# data file, generated by "Save".
 #      All vars that one wants to make available to the program should be
 #      included in the "globals" list.
 #
 # Arguments:
 #      sw      Flag indicating if 1 that filename should be entered manually.
 #              If 0, last filename is used. 
 #
 proc Load {sw} {
 # These are all variables that, if loaded, will be globally available:
 global rows cols headrows sidecols f cw r c tr tc
 global colours initdir reload lfl lfs
 global rowsel colsel inspoint filename winsize
 global recalc defmov exp env reps
 
 # for use in tl# files:
 global b tools e ew ef
 
     .w config -cursor watch
     if {$sw == 2} {
         set typelist {
             {"tl# files" {".tl#"}}
             {"All files" {*}} 
         }
     } else {
         set typelist {
             {"tk# files" {".tk#"}} 
             {"All files" {*}} 
         }
     }
     if {$sw > 0} {
     # Perhaps we changed machine/userid :-)
     if ![file isdirectory $initdir] {set initdir [pwd]}
         set fn [tk_getOpenFile -defaultextension ".tk#" -initialdir $initdir \
             -filetypes $typelist -initialfile $filename -title "tk# file load"]
     } else {set fn $filename}
 
     if {$fn != ""} {
         if {$sw < 2} {set filename $fn}
         wm title .w "Load: $fn"
         # Last file loaded:
         if {$filename != $lfs} {set lfl $filename}
 
         # copy row/col lists over:
         foreach x {rows cols headrows sidecols} {set ${x}2 [subst \$$x]}
 
         source $fn
 
         # merge row/col lists, merging common names (overwrite!):
         foreach x {rows cols headrows sidecols} {
             foreach y [subst \$$x] {
                 if {([lsearch [subst \$${x}2] $y] == -1)} {
                     lappend ${x}2 $y
                 }
             }
             set $x [subst \$${x}2]
         }
         # Last colour merged in has it!
         ColoursSet
         ReCalc
         if $reload Modified else {set reload 1}
 
         if {$sw == 2} {
             # Add to lib stack if called with $sw == 2:
             lappend reps $fn
         } else {
             # Source the library stack:
             if [info exists reps] {
                 foreach x $reps {source $x}
             }
             wm geometry .w $winsize 
         }
         wm title .w "File: $filename"
 
     }
     .w config -cursor {} 
 }
 
 # ClipRC --
 #
 #      Return only those rows/cols in $rr which are in the selection $rs.
 #
 # Arguments:
 #      rr     row/col name list, e.g. $rows or $sidecols.
 #      rs     row/col selection list, i.e. $rowsel or $colsel
 #
 # Result:
 #      Function value containing list of elements of $rr also in $rs.
 #
 proc ClipRC {rr rs} {
     set cc {}
     foreach x $rr {
         if {!([lsearch $rs $x] == -1)} {lappend cc $x}
     }
     return $cc 
 }
 
 # Save --
 #
 #      Saves the spreadsheet and its state vars to a data file in "sourceable"
 #      format. The globals list should contain everything that one wants
 #      saved.
 #
 # Arguments:
 #      sw2      Switch flagging manual entry of filename (> 0) or not ( = 0).
 #               If =2, then save only selection.
 #
 proc Save {sw2} {
 # These are all variables that will be saved:
 global rows cols headrows sidecols r c tr tc
 global colours initdir lfs lfl winsize
 global rowsel colsel inspoint f cw filename 
 global recalc defmov exp reps
 
     set winsize [wm geometry .w]
     # Condition necessary so Save does not break in destroyed window:
     if [winfo exists .w] {.w config -cursor watch}
     set typelist {
         {"tk# files" {".tk#"}} 
         {"All files" {*}} 
     }
     if {$sw2 > 0} {
     if ![file isdirectory $initdir] {set initdir [pwd]}
         set fnx [tk_getSaveFile -defaultextension ".tk#" -initialdir $initdir \
                  -initialfile $filename -filetypes $typelist \
                  -title "tk# file save"]
     } else {set fnx $filename} 
 
     if {$fnx != ""} {
         set filename $fnx
         if {$filename != $lfl} {set lfs $filename ;# last file saved}
 
         if {$sw2 == 2} {
             # save the selection only, i.e. restrict the $row and $col lists
             # only to include the selection (+title):
             set sidecols [concat title [ClipRC $sidecols $colsel]]
             set cols [ClipRC $cols $colsel]
             set headrows [concat title [ClipRC $headrows $rowsel]]
             set rows [ClipRC $rows $rowsel]
         } 
         # not saved:
         unset typelist sw2 
         if [winfo exists .w] {wm title .w "Save: $filename"}
         set FileId [open $filename w]
 
         # Put aside into local vars, prevent saving of originals:
         foreach {lfs2 lfl2 fnx} [list $lfs $lfl $filename] {break}
         # Prevent from being saved, as their unintended loading is wrong:
         unset filename lfl lfs    ; # prevent saving
 
         # First simple variables...
         foreach x [info vars *]    {
             if ![array exists $x] {
                 # A variable may be unset, but still exist:
                 if [info exists $x] {
                     puts $FileId [list set $x [subst \$$x] ]
                 }
             }
         }
         # ...then arrays cw and f:
         foreach y [concat $sidecols $cols] {
             puts $FileId [list array set cw [array get cw $y]]
         }
         foreach x [concat $headrows $rows] {
             foreach y [concat $sidecols $cols] {
                 puts $FileId [list array set f [array get f $x,$y]]
             }
         }
         # ... and colours:
         foreach x [array names colours] {
             puts $FileId [list array set colours [array get colours $x]]
         }
         close $FileId
 
         # Restore:
         foreach {lfs lfl filename} [list $lfs2 $lfl2 $fnx] {break}
 
         UnModified
         if [winfo exists .w] {wm title .w "File: $filename"}
     }
     if [winfo exists .w] {.w config -cursor {}} 
 }
 
 # Get the "rc" file from user home
 proc Getrc {} {
 global lfl lfs env
     set fn "$env(HOME)/.tk#rc"
     if [file exists $fn] {
         set FileId [open $fn r]
         # lfl: Last File Loaded
         gets $FileId lfl
         # lfs: Last File Saved
         gets $FileId lfs 
         close $FileId
     } else {
         set lfl "" 
         set lfs ""
     }
 }
 
 # Write back rc file to user home:
 proc Exit {} {
 global lfl lfs env 
     set FileId [open "$env(HOME)/.tk#rc" w]
     puts $FileId $lfl
     puts $FileId $lfs 
     close $FileId
     exit
 }
 
 # QuitWarn --
 #
 #      Quit with warning to save file
 #
 # Result:
 #      Yes:     Save if modified, stop clock(s) and exit
 #      No:      Do not save; exit
 #      Cancel:  Do not even exit. Return to spreadsheet
 #
 proc QuitWarn {} {
 global modified filename tr
     # Has file been modified?
     if $modified {set choice \
             [tk_messageBox -type yesnocancel -icon question \
                 -message "Save File $filename" -default yes]
         if {$choice == "yes"} {
             # If clock running, stop it
             if [info exists tr] StopClock 
             Save 0
             Exit
         } 
         if {$choice == "no"} Exit
     } else Exit
 }
 
 proc ConvSep {separ} {
     switch -- $separ {
         "Tab"     {set sep "\t"} 
         "Comma"   {set sep ","}
         "Newline" {set sep "\n"}
         "Blank"   {set sep " "}
         "None"    {set sep ""}
         "LaTeX"   {set sep " & "}
     }
     return $sep
 }
 
 # Export --
 #
 #      Export routine, allowing simple data tables with tab, space, comma
 #      or newline separators to be written, or LaTeX format table.
 #
 proc Export {} {
 global initdir exp exportname
 global v headrows rows sidecols cols cw rowsel colsel
     .w config -cursor watch
 
     set sep [ConvSep $exp(separ)]
 
     switch -- $exp(howmuch) {
  "All"         {
                    set prows [concat $headrows $rows]
                    set pcols [concat $sidecols $cols]
                } 
  "Selection"   {
                    set prows $rowsel
                    if {([lsearch $rowsel title] == -1) && $exp(titlerow)} {
                        set prows [concat title $rowsel]
                    }
                    set pcols $colsel
                    if {([lsearch $colsel title] == -1) && $exp(titlecol)} {
                        set pcols [concat title $colsel]
                    }
                }
     }
     set typelist {
         {"tk# files" {".tk#"}} 
         {"All files" {*}} 
     }
     if ![file isdirectory $initdir] {set initdir [pwd]}
     set exportname [tk_getSaveFile -defaultextension ".dat" -initialdir $initdir \
      -initialfile $exportname -filetypes $typelist -title "tk# file export"]
 
     if {$exportname != ""} {    
         set FileId [open $exportname w] 
 
         switch -- $exp(separ) {
             LaTeX {
                 puts -nonewline $FileId "\\begin\{tabular\}\{|"
                 foreach y $pcols {puts -nonewline $FileId " r |"}
                 puts $FileId "\}"
                 foreach x $prows {
                     puts $FileId {\hline}
                     foreach y $pcols {
                         if {[lsearch $pcols $y] > 0} {
                             puts -nonewline $FileId $sep
                         } 
                         if ![info exists v($x,$y)] {set v($x,$y) "?UNDEF"}
                         puts -nonewline $FileId \
                                 [string trim [FormattedCell $x $y $cw($y)]] 
                     }
                     puts $FileId "\\\\"
                 }
                 puts $FileId {\hline}
                 puts $FileId "\\end\{tabular\}"
             }
             default {
                 foreach x $prows {
                     foreach y $pcols {
                         if {[lsearch $pcols $y] > 0} {
                             puts -nonewline $FileId $sep
                         } 
                         # Remove separator char from string:
                         regsub $sep [FormattedCell $x $y $cw($y)] "_" z
                         puts -nonewline $FileId $z
                     }
                 puts $FileId ""
                 }
             }
         }
 
         close $FileId
     }
     .w config -cursor {}
 }
 
 # Avoid the generation of empty elements due to multiple separator chars
 proc BetterSplit {line ch} {
     regsub  "$ch$ch" $line "$ch" line
     regsub  "$ch$ch" $line "$ch" line
     regsub  "$ch$ch" $line "$ch" line
     return [split $line "$ch"]
 }
 
 # Import --
 #
 #      Counterpart of Export. 
 #      Currently only tab-separated tables WITH headers can be imported.
 #
 proc Import {} {
 global initdir exportname exp
 global f headrows rows sidecols cols cw
     # 
     .w config -cursor watch
 
     set sep [ConvSep $exp(separ)]
 
     set typelist {
         {"tk# files" {".tk#"}} 
         {"All files" {*}} 
     }
     if ![file isdirectory $initdir] {set initdir [pwd]}
     set exportname [tk_getOpenFile -defaultextension ".dat" -initialdir $initdir \
      -initialfile $exportname -filetypes $typelist -title "tk# file import"]
     if {$exportname != ""} {
         set FileId [open $exportname r] 
 
         # needs work...
         set prows {}; set pcols {}
         # title row:
         gets $FileId line
         set x [BetterSplit $line $sep]
         # Remove leading "-" from column names in title row:
         foreach y $x {set pcols [concat $pcols [string trim $y " -"]]}
         while {![eof $FileId]} {
             gets $FileId line
             # works with tab:
             set linelist [BetterSplit $line $sep]
             # Get row name, removing trailing "-":
             set rr [string trim [lindex $linelist 0] " -"]
             set prows [concat $prows $rr]
             # element-in-row counter:
             set iz 0
             foreach z [lrange $linelist 1 end] {
                 incr iz
                 set cc [lindex $pcols $iz]
                 # keep track of widest cell in column:
                 if [info exists cw($cc)] {
                     set sl [string length $z]
                     if {$sl > $cw($cc)} {
                         set cw($cc) $sl 
                     }
                 } else {set cw($cc) 12}
                 set f($rr,$cc) $z
             } 
         }
         close $FileId
         # Add the missing rows/cols
         foreach x $prows {
             if {([lsearch $headrows $x] == -1) && ([lsearch $rows $x] == -1)} {
                 set rows [concat $rows $x]
             }
         }
         foreach x $pcols {
             if {([lsearch $sidecols $x] == -1) && ([lsearch $cols $x] == -1)} {
                 set cols [concat $cols $x]
             }
         }
     }
     .w config -cursor {}
     ReCalc
     ReDisplay
 }
 
 # RecalcCell --
 #
 #      Recalculate a single cell value.
 #      Put ?UNDEF for undefined formulas. 
 #      Use uplevel to globalize any var definitions put by the user 
 #      into $f, so they will be available in other cells too
 #
 proc ReCalcCell {} {
 global rows cols cw r c
 global v f
     if ![info exists f($r,$c)] {set f($r,$c) "?UNDEF"}
     uplevel #0 {
         set w $cw($c)
         if [catch {set v($r,$c) [subst $f($r,$c)]} result] {
             set v($r,$c) "?ERR 4 $result"
         }
     }
 }
 
 # GetFormula --
 #
 #      After entry of a formula into the entrybox, evaluation and
 #      writing back of value result into spreadsheet.
 #
 proc GetFormula {} {
 global r c f autocalc rowsel colsel thisformula frq
     #
     # "thisformula" is the current content of the Formula: box.
     #
     # Temporary save of $r, $c, to allow their use in loops
     # (and availability of loop-$r and loop-$c to user):
     #
     set oldr $r; set oldc $c
     foreach r $rowsel {
         foreach c $colsel {
             if {$f($r,$c) != $thisformula} {
                 regsub "<F>" $thisformula $f($r,$c) f($r,$c)
                 # Mark modified only if actual formula change:
                 Modified
             }
         }
     }
     set r $oldr; set c $oldc
     # Only update the selected cells if autocalc off:
     # (Remember ReCalc does a ReDisplay)
     if {$autocalc} {ReCalc} else {ReCalc 1}
     PaintSelect
     # Prepare for arrow keys use:
     NavFocus 
 }
 
 # PanelRow --
 #
 #      Returns the row list identity ($rows or $headrows) belonging to this
 #      spreadsheet panel.
 #
 proc PanelRow {panel} {
 global rows headrows
     if {($panel == "main") || ($panel == "side")} { 
         return $rows 
     } else {
         return $headrows 
     }
 }
 
 # PanelCol --
 #
 #      Returns the col list identity ($cols or $sidecols) belonging to this
 #      spreadsheet panel.
 #
 proc PanelCol {panel} {
 global cols sidecols
     if {($panel == "main") || ($panel == "head")} { 
         return $cols 
     } else {
         return $sidecols 
     }
 }
 
 proc SetUpForEdit {} {
 global c r rowsel colsel frq
     if {($c != "title")} {set colsel $c}
     if {($r != "title")} {set rowsel $r}
     PaintSelect
     # Set up for data/formula entry:
     EditFocus
 }
 
 proc SetUpEntry {} {
 global r c thisformula f cw cwidth
     # Make width entry box current:
     set cwidth $cw($c)
     if ![info exists f($r,$c)] {set f($r,$c) "?UNDEF"}
     # Get current cell formula for editing:
     set thisformula $f($r,$c)
     SetUpForEdit
 }
 
 # GetMouse1 --
 #
 #      Callback routine for mouse button 1 (data entry) in panels:
 #
 proc GetMouse1 {panel} {
 global r c rowsel colsel thisformula f cw cwidth
     UnPaintCurrentCell
     # Get the proper name of row/column list for this panel:
     set prows [PanelRow $panel]
     set pcols [PanelCol $panel]
     foreach {r c} [GetCell $panel $prows $pcols] {break} 
     SetUpEntry
 }
 
 # GetMouse2 --
 #
 #      Handle mouse button 2 clicks: Mark insert point.
 #
 # Note: There is an overloading of this mouse button. It is also used
 #       to drag the panels. I don't know if this is OK or not (mv).
 #
 proc GetMouse2 {panel} {
 global rows cols headrows sidecols inspoint
     # remove previous insert marks in row or col headers:
     PaintCell "" "" "" noinsert
     set prows [PanelRow $panel]
     set pcols [PanelCol $panel]
     foreach {x y} [GetCell $panel $prows $pcols] {break} 
     if {($x == "title") || ($y == "title")} { 
         PaintCell $panel $x $y insert 
         if {$x != "title"} {
             set inspoint $x
         } elseif {$y != "title"} {
             set inspoint $y
         } else {set inspoint "title" }
     } else {set inspoint {^$} }
 }
 
 # GetMouse3 --
 #
 #      Handle mouse button 3 clicks: Selection bottom right corner.
 #
 proc GetMouse3 {panel} {
 global r c rowsel colsel
 global rows cols headrows sidecols
     set prows [PanelRow $panel]
     set pcols [PanelCol $panel]
     foreach {rr cc} [GetCell $panel $prows $pcols] {break}
     set allrows [concat $headrows $rows]
     set i [lsearch $allrows $r]
     # do not include "title" in selection:
     if {($r == "title")} {incr i}
     set j [lsearch $allrows $rr]
     if {($r != "title")} {set rowsel [lrange $allrows $i $j]}
     set allcols [concat $sidecols $cols]
     set i [lsearch $allcols $c]
     if {($c == "title")} {incr i}
     set j [lsearch $allcols $cc]
     if {($c != "title")} {set colsel [lrange $allcols $i $j]}
     PaintSelect 
     return
 }
 
 # GetCell --
 #
 #      Get cell address (row, col names as function value list) 
 #      from mouse click.
 #
 # Arguments:
 #      rect      current panel of spreadsheet
 #      prows     current row list
 #      pcols     current column list
 #
 proc GetCell {rect prows pcols} {
 global cw cs f frq
 
     # row address:
     set rn -1 
     while {[$frq.$rect compare current >= "1.0 + $rn lines"]} {
         incr rn
     }
     incr rn -1
     set r [lindex $prows $rn]
     if {$r == ""} {set r title} ;# play safe
 
     # col address (if possible):
     for {set jj 0} {$jj < [llength $pcols]} {incr jj} {
         set cc [lindex $pcols $jj]
         if {[$frq.$rect compare \
                  "current linestart + $cs($cc) chars" <= current]} {
             set c $cc
         } 
     }
 
     if {(![info exists c]) || (![info exists r])} {set r title; set c title}
     # Make a list containing two names, a row name and a column name, to return.
     return [list $r $c]
 }
 
 # RowColPanel --
 #
 #      Get panel identity as a name string, given $r and $c.
 #
 proc RowColPanel {r c} {
 global headrows sidecols
     if {[lsearch $headrows $r] > -1} {
         return [expr {([lsearch $sidecols $c] > -1) ? "corner" : "head" }]
     } else {
         return [expr {([lsearch $sidecols $c] > -1) ? "side" : "main" }]
     }
 }
 
 # PaintSelect --
 #
 #      Paint the selected rows/cols in the titles, and some more (clock cell,
 #      current cell).
 #
 proc PaintSelect {} {
 global rows cols headrows sidecols r c tr tc rowsel colsel
     PaintCell "" "" "" notitle
 
     # add "title" tag only to the selected cells' rows/cols:"
     foreach x $rowsel {
         PaintCell [RowColPanel $x title] $x title title
     }
     foreach y $colsel {
         PaintCell [RowColPanel title $y] title $y title
     }
 
     # tag the clock cell:
     PaintCell "" "" "" notime
     if [info exists tr] {
         PaintCell [RowColPanel $tr $tc] $tr $tc time
     }
     # tag the current cell:
     PaintCurrentCell
 }
 
 # FormattedCell --
 #
 #      Returns the string $v($rr,$cc) clipped to column width.
 #      Handles undefined v element (may happen!)
 #
 proc FormattedCell {rr cc w} {
 global v
     # Prevent crash 
     if ![info exists v($rr,$cc)] {set v($rr,$cc) "?UNDEF"}
     return [format "%${w}s" [string range "$v($rr,$cc)" 0 [expr $w - 1]]]
 }
 
 # Redisplay a single cell in the right attributes
 #
 # Arguments:
 #      none.
 #      globals $r $c used as display location.
 #
 proc ReDisplayCell {} {
 global cw v r c frq
     set w $cw($c)
     set panel [RowColPanel $r $c]
     set x [FormattedCell $r $c $w]
     foreach {cb ce} [GetCellEnds $r $c] {break}
 
     PanelsState normal
     if {[$frq.$panel compare $ce < end]}    {$frq.$panel delete $cb $ce}
     if {($r == "title") || ($c == "title")} {
         $frq.$panel insert $cb $x underline
     } else {
         $frq.$panel insert $cb $x
     }
     PanelsState disabled
     return
 }
 
 # GetCellEnds --
 #
 #      Return begin- and endpoints (character positions in row) 
 #      of a cell in its text widget (panel).
 #
 # Arguments:
 #      r, c   row, col names
 #
 proc GetCellEnds {r c} {
 global rs cs cw headrows rows sidecols cols
     if ![info exists rs($r)] {
         InitIndexRow $headrows
         InitIndexRow $rows
     }
     if ![info exists cs($c)] {
         InitIndexCol $sidecols
         InitIndexCol $cols
     }
     if [info exists rs($r)] {
         set linebgn  $rs($r)
         incr linebgn
         set cellbgn  $cs($c)
         set cellsize $cw($c)
         return [list "$linebgn.$cellbgn" "$linebgn.$cellbgn + $cellsize chars"]
     } else {
         return {1.0 1.0}
     }
 }
 
 # PaintCell --
 #
 #      Put proper attributes on a single cell
 #
 # Arguments:
 #      thispanel    panel to add attributes (tags) to
 #      r c          row and col number (LOCAL VARS!)
 #      switch       specifies kind of tag to use.
 #
 proc PaintCell {thispanel r c switch } {
 global cw cs rs frq
     foreach {cb ce} [GetCellEnds $r $c] {break}
 
     PanelsState normal
     foreach panel {main head side corner} { 
         switch -- $switch {
             noinsert   {$frq.$panel tag remove instag   1.0 end} 
             nocurrent  {$frq.$panel tag remove current  1.0 end}
             notime     {$frq.$panel tag remove time     1.0 end}
             notitle    {$frq.$panel tag remove title    1.0 end} 
             nocurtitle {$frq.$panel tag remove curtitle 1.0 end}
             default    {}
         }
     }
     switch -- $switch {
         title    {$frq.$thispanel tag add title    $cb $ce}
         insert   {$frq.$thispanel tag add instag   $cb $ce}
         curtitle {
             $frq.$thispanel tag add curtitle $cb $ce
             $frq.$thispanel see curtitle.last 
             $frq.$thispanel see curtitle.first
         }
         time     {$frq.$thispanel tag add time     $cb $ce}
         current  {
             $frq.$thispanel tag add current  $cb $ce 
             $frq.$thispanel see current.last
             $frq.$thispanel see current.first
         }
     } 
     PanelsState disabled
     return
 }
 
 proc ClearAll {} { 
 global frq
     PanelsState normal
     foreach panel {main side head corner} {$frq.$panel delete 1.0 end}
     PanelsState disabled
     return
 }
 
 # ReCalc --
 #
 # Recalc everything (sw = 0) or selection (sw = 1)
 #
 proc ReCalc {{sw 0}} {
 global f v rows cols headrows sidecols r c frq rowsel colsel
     .w config -cursor watch
     $frq.flag configure -text "Calc..."
     update idletasks
 
     if {$sw == 0} {
          set prows [ConcatNoTitle $rows $headrows]
          set pcols [ConcatNoTitle $cols $sidecols]
     } else {
         set prows $rowsel
         set pcols $colsel
     }
     InitIndex
     # r and c must be global :-( for cell evaluation in #0 scope;
     # however r and c must be available at eval time for each cell
     # within the two loops.
     set oldr $r ; set oldc $c
  
     foreach r $prows {
         foreach c $pcols {
              ReCalcCell
         }
     }
     $frq.flag configure -text "Display..."
     update idletasks
     if {$sw == 0} {
         # restore
         set r $oldr ; set c $oldc
         ReDisplay
     } else {
         foreach r $prows {
             foreach c $pcols {
                 ReDisplayCell 
             }
         }
         set r $oldr ; set c $oldc
         PaintSelect;
     }
 
 
     .w config -cursor {}
     NavFocus    
     return
 }
 
 #  ReDisplay --
 #
 #      Redisplay the whole assembly of four data panels.
 #      The three "title panels" are scaled to contain the text.
 #      Necessary attributes (tags) are added to the appropriate cells.
 #      Also newline characters (\n) added at the right places.
 #      For rows and columns, their names are used instead of 
 #      evaluated formulas.
 #
 proc ReDisplay {} {
 global f v cw rows cols headrows sidecols rowsel colsel inspoint frq
     InitIndex
     set ht [InitIndexRow $headrows]
     set wd [InitIndexCol $sidecols] 
  
     $frq.head   config -height $ht 
     $frq.side   config -width  $wd 
     $frq.corner config -width  $wd -height $ht 
     $frq.main   config -wrap none
 
     ClearAll
 
     set prows [concat $headrows $rows]
     set pcols [concat $sidecols $cols]
 
     foreach r $prows {set v($r,title) $r-} 
     foreach c $pcols {set v(title,$c) -$c} 
     set v(title,title) "title"
 
     PanelsState normal
     foreach r $prows {
         update idletasks
         set panel [RowColPanel $r [lindex $sidecols 0]]
         foreach c $sidecols {
             set x [FormattedCell $r $c $cw($c)]
             if {($r == "title") || ($c == "title")} {
                 $frq.$panel insert end $x underline
             } else {
                 $frq.$panel insert end $x
             }
         }
         set panel [RowColPanel $r [lindex $cols 0]]
         if {($r == "title")} {
             foreach c $cols {
                 set x [FormattedCell $r $c $cw($c)]
                 $frq.$panel insert end $x underline
             }
         } else {
             # inline format cmd, not FormattedCell call, for speed
             foreach c $cols {
                 if ![info exists v($r,$c)] {set v($r,$c) "?UNDEF"}
                 $frq.$panel insert end [format "%$cw($c)s" \
                         [string range "$v($r,$c)" 0 [expr $cw($c) - 1]]]
             }
         }
         set rn [lsearch $headrows $r]
         if {($rn > -1)} {
             incr rn
             foreach panel {head corner} {
                 if {$rn < [llength $headrows]} {
                     $frq.$panel insert "$rn.end" "\n"
                 }
             }
         } else {
             set rn [lsearch $rows $r]
             incr rn
             foreach panel {side main} {
                 if {$rn < [llength $rows]} {
                     $frq.$panel insert "$rn.end" "\n"
                 }
             }
         }
     }
     
     update idletasks
 
     PaintSelect 
 
     if {[info exists inspoint]} {
         # re-paint the inspoint title cell!
         if {([lsearch $prows $inspoint] > -1)} {
             set panel [RowColPanel $inspoint title]
             PaintCell $panel $inspoint title insert
         } elseif {([lsearch $pcols $inspoint] > -1)} {
             set panel [RowColPanel title $inspoint]
             PaintCell $panel title $inspoint insert 
         }
     }
     
     PanelsState disabled
     return
 }
 
 # ColWidth --
 #
 #      Get column width value from entry box
 #
 proc ColWidth {} {
 global cw c rows headrows cols sidecols
     # Use scan to guarantee integer return:
     set cwidth 12
     scan [.w.fr.box1.ew get] "%d" cwidth 
     if {($cwidth == 0)} {set cwidth 12}
     set cw($c) $cwidth
     ReDisplay
     return
 }
 
 #
 # Service routines for joint scrolling of all panels & scrollbars.
 # Do not touch unless you know your way around.
 #
 proc HorizScroll {args} {
 global frq
     eval [concat $frq.main xview $args]
     eval [concat $frq.head xview $args]
     return
 }
 
 proc VertScroll {args} {
 global frq
     eval [concat $frq.main yview $args]
     eval [concat $frq.side yview $args]
     return
 }
 
 proc BindDragto { x y args } {foreach w $args {$w scan dragto $x $y}}
 
 proc BindMark { x y args } {foreach w $args {$w scan mark $x $y}}
 
 # ColoursSet -- 
 #
 #      Make all colours valid on panels and tags after modification 
 #      through menu.
 #
 proc ColoursSet {} {
 global colours frq
     foreach panel {main side head corner} {
         $frq.$panel config \
                 -foreground $colours(textfg) -background $colours(textbg)
     }
     TagsConfig
     return
 }
 
 # Wrapper routine for colour editing
 proc ColourReconfig {colour} {
 global colours
     set colours($colour) [Colour $colours($colour) $colour]
     ColoursSet
     return
 }
 
 # FillListBox --
 #
 #      obtain rowsel/colsel and put into listbox
 #
 proc FillListBox {rclist pselName} {
 upvar $pselName psel
     .sel.f0.lb delete 0 end
 
     foreach x $rclist {
         .sel.f0.lb insert end $x
     }
 
     foreach x $rclist {
         set i [lsearch $rclist $x]
         if {[lsearch $psel $x] > -1} {
             .sel.f0.lb selection set $i
         }
     }
     return
 }
 # PaintInsAll --
 #
 #      Tag the insert pointer where-ever it is
 #
 proc PaintInsAll {} {
 global headrows rows sidecols cols inspoint
     PaintCell "" "" "" noinsert
     if [info exists inspoint] {
         PaintInsert $headrows corner 1
         PaintInsert $rows     side   1 
         PaintInsert $sidecols corner 0 
         PaintInsert $cols     head   0 
     }
     return
 }
 # PaintInsert --
 #
 #      Tag the insert pointer if in current panel
 #      sw indicates row or column pointer
 #      For usage see proc PaintInsAll
 #
 proc PaintInsert {rr panel sw} {
 global inspoint
     if {([lsearch $rr $inspoint] > -1)} {
         if $sw {
             PaintCell $panel $inspoint title insert
         } else {
             PaintCell $panel title $inspoint insert
         }
     }
     return
 }
 
 # ProcListBox
 #
 #      Obtain cursor selection, put into rowsel/colsel/inspoint, and exit
 #
 # Arguments:
 #      rclist  list of row/column names
 #      rc      flag for row select, col select, or insert point choose.
 #
 proc ProcListBox {rclist rc} {
 global rowsel colsel inspoint
 #global headrows rows sidecols cols
     set ii [.sel.f0.lb curselection]
     set locpsel {}; foreach i $ii {lappend locpsel [lindex $rclist $i]}
     switch -- $rc {
         "r" {set rowsel $locpsel} 
         "c" {set colsel $locpsel}
         "i" {set inspoint [lindex $locpsel 0]}
     }
     .sel.f0.lb selection clear 0 end
     wm withdraw .sel
     PaintSelect
     PaintInsAll
 
     return
 }
 
 # GetSel --
 #
 #      Get selection (rows, columns) by string matching with row/col names
 #
 # Arguments:
 #      rowselect   match string for row names
 #      colselect   match string for column names
 #
 proc GetSel {rowselect colselect} {
 global rowsel colsel rows headrows cols sidecols
     set rowsel {}
     foreach r [concat $rows $headrows] {
         if {[regexp $rowselect $r]} {
             if {$r != "title"} {
                 lappend rowsel $r
             }
         }
     }
     set colsel {}
     foreach c [concat $cols $sidecols] {
         if {[regexp $colselect $c]} {
             if {$c != "title"} {
                 lappend colsel $c
             }
         }
     }
     PaintSelect
     .w config -cursor {}
     wm withdraw .selm
     return
 }
 
 # SelectEdit --
 #
 #      Listbox user interface handling routine
 #
 proc SelectEdit {rclist rc title mode selName} {
 upvar $selName sel
     .w config -cursor watch
     set doScript [list ProcListBox $rclist $rc]
     if [winfo exists .sel] { 
         wm deiconify .sel 
         wm title .sel $title
         raise .sel 
         .sel.f0.lb config -selectmode $mode 
         FillListBox $rclist sel
         set doScript [list ProcListBox $rclist $rc]
         .sel.f1.do config -command $doScript
         .w config -cursor {}
         return
     }
     toplevel .sel
     wm title .sel $title
     CenterWin .sel .w
 
     foreach x {0 1} {frame .sel.f$x}
     listbox   .sel.f0.lb -selectmode $mode \
             -yscrollcommand {.sel.f0.sb set} -width 30
     scrollbar .sel.f0.sb -command {.sel.f0.lb yview}
     FillListBox $rclist sel
 
     button .sel.f1.do -text OK -command $doScript
     bind   .sel <Key-Return>            $doScript
     button .sel.f1.cancel -text cancel -command {wm withdraw .sel} 
     bind   .sel <Key-Escape>                    {wm withdraw .sel}
     
     pack .sel.f0.lb -fill both -expand true -side left
     pack .sel.f0.sb -fill both -expand false -side right
     pack .sel.f1.do -side left
     pack .sel.f1.cancel -side right
 
     grid columnconfigure .sel 0 -weight 1
     grid rowconfigure    .sel 0 -weight 1
     foreach x {0 1} {grid .sel.f$x -in .sel -row $x -sticky news}
 
     raise .sel
     PaintSelect
     .w config -cursor {}
     return
 }
 
 # SelectMatch --
 #
 #      Selection by string matching user interface handling routine
 #
 proc SelectMatch {} {
 global colours rowsel colsel headrows rows sidecols cols
     .w config -cursor watch
 
     if [winfo exists .selm] { 
         wm deiconify .selm; 
         raise .selm; return
         }
     toplevel .selm
     wm title .selm "Row/Col Select by Match"
     CenterWin .selm .w
 
     foreach x {1 2 3} {frame .selm.f$x}
     
     foreach {x y} {1 Row 2 Col} {
         label .selm.f$x.l$x -text "$y Select String:" -width 18 -anchor e
         entry .selm.f$x.e$x -textvariable ${y}SelString \
                                              -background $colours(textbg)
     }
 
     button .selm.f3.do -text OK -command {GetSel $RowSelString $ColSelString} 
     bind   .selm <Key-Return>            {GetSel $RowSelString $ColSelString}
 
     button .selm.f3.cancel -text cancel -command [list DoNothing .selm] 
     bind   .selm <Key-Escape>                    [list DoNothing .selm]
  
     foreach x {1 2} {
         pack .selm.f$x.l$x -side left     
         pack .selm.f$x.e$x -side left -fill x -expand true
     }
     
     pack .selm.f3.do -side left
     pack .selm.f3.cancel -side right
     
     foreach x {1 2 3} {grid .selm.f$x -in .selm -row $x -sticky ew}
 
     raise .selm
     return
 }
 
 # Service routine for the editing of formatting commands 
 proc ComposeCmd {fmt} {
 global thisformula
     set thisformula $fmt 
 }    
 
 # RCSpawn --
 #
 #      Service routine for row/column spawning.
 #
 # Arguments:
 #      rr1     row/col list 1
 #      rr2     row/col list 2
 #      switch  r for rows, c for columns
 #  
 proc RCSpawn {rr1Name rr2Name switch} {
 global r c inspoint rows headrows cols sidecols f v cw 
 global template spawn
     upvar $rr1Name rr1
     upvar $rr2Name rr2
 
     for {set in 0} {$in < $spawn} {incr in} {
         set i "($in)"
         # template may contain $i!
         set t [subst $template]
         if ![NewNameError [concat $rr1 $rr2] $t] {
             set ii [lsearch $rr1 $inspoint]
             if {$ii > -1} {
                 # insert AFTER first element:
                 set rr1 [concat [lrange $rr1 0 [Pred $ii]] $t \
                                              [lrange $rr1 [This $ii] end]] 
             } else {
                 set ii [lsearch $rr2 $inspoint]
                 if {$ii > -1} {
                     # insert BEFORE 1st el:
                     set rr2 [concat [lrange $rr2 0 [expr $ii - 1]] $t \
                                              [lrange $rr2 $ii end]] 
                 } else { 
                     set rr2 [concat $rr2 $t]
                 }
             }
             # copy over f,v,cw values:
             if {$switch == "r"} {
                 foreach y [concat $sidecols $cols] {
                     if [info exists f($r,$y)] {set f($t,$y) $f($r,$y)}
                     if [info exists v($r,$y)] {set v($t,$y) $v($r,$y)}
                 } 
             } else {
                 foreach x [concat $headrows $rows] {
                     if [info exists f($x,$c)] {set f($x,$t) $f($x,$c)}
                     if [info exists v($x,$c)] {set v($x,$t) $v($x,$c)}
                     set cw($t) $cw($c)
                 }
             }
         } 
     }
     Modified
     TemplateDefault
     .w config -cursor {}
     return
 }
 
 proc RowSpawn {win} {
 global rows headrows inspoint template spawn autocalc
     RCSpawn headrows rows r 
     if $autocalc ReCalc else ReDisplay
     wm withdraw $win
     return
 }
 
 proc ColSpawn {win} {
 global cols sidecols inspoint template spawn autocalc
     RCSpawn sidecols cols c
     if $autocalc ReCalc else Redisplay
     wm withdraw $win
     return
 }
 
 proc ReplaceElement {rr r newr} {
     set ii [lsearch $rr $r]
     if {($ii > -1)} {
         return [lreplace $rr $ii $ii $newr]
     } else {
         return $rr
     }     
 }
 
 # NewNameError --
 #
 #      Report error in rename row/col, such as empty template or 
 #      attempt at using already existing name
 # 
 # Arguments:
 #      rr    List of existing row or col names
 #      newr  The new name template proposed
 #
 # Results:
 #      Error code 1 in case of error
 #
 proc NewNameError {rr newr} {
 global template
     # Empty template:
     if {$newr == ""} {
         return 1
     }
     # Contains blanks:
     if {[string first " " $newr] > -1} {return 1}
     # Contains/is contained in already:
     foreach x $rr {
         if {([string first $newr $x] > -1) || ([string first $x $newr] > -1)} {
             return 1
         }
     } 
     return 0
 }
 
 # RowRename --
 #
 #      Rename selected rows. If given name (acc. to template)
 #      already exists, don't do it.
 #
 # Argument:
 #      win   The auxiliare window containing the dialogue.
 #
 proc RowRename {win} {
 global rows headrows sidecols cols r f v rs rowsel colsel
 
     set oldr $r
 
     set in 0
     foreach r $rowsel {
         if {$r != "title"} {
             incr in
             set i "($in)"
             set template [subst [$win.f0.e get]] 
             if ![NewNameError [concat $headrows $rows] $template] {
                 set headrows [ReplaceElement $headrows $r $template]
                 set rows     [ReplaceElement $rows $r $template]
                 set rowsel   [ReplaceElement $rowsel $r $template]
                 foreach c [concat $sidecols $cols] {
                     if [info exists f($r,$c)] {
                         set f($template,$c) $f($r,$c)
                         unset f($r,$c)
                     } 
                     if [info exists v($r,$c)] {
                         set v($template,$c) $v($r,$c)
                         unset v($r,$c)
                     }
                 }
                 set v($template,title) ${template}-
                 if [info exists rs($r)] {
                     set rs($template) $rs($r); unset rs($r)
                 } else {puts "RowRename: rs($r) not exist bug"}
                 if {$r == $oldr} {set oldr $template}
             }
         } 
     }
 
     set r $oldr
 
     ReDisplay
     wm withdraw $win 
     .w config -cursor {}
     Modified
     return
 }
 
 # ColRename --
 #
 #      Rename selected cols. If given name (acc. to template)
 #      already exists, don't do it.
 #
 # Argument:
 #      win   The auxiliare window containing the dialogue.
 #
 proc ColRename {win} {
 global cols sidecols rows headrows c f v cs cw colsel rowsel
     set oldc $c
     
     set in 0
     foreach c $colsel {
         if {$c != "title"} {
             incr in
             set i "($in)"
             set template [subst [$win.f0.e get]]
             if ![NewNameError [concat $sidecols $cols] $template] {
                 set sidecols [ReplaceElement $sidecols $c $template]
                 set cols     [ReplaceElement $cols $c $template]
                 set colsel   [ReplaceElement $colsel $c $template]
                 foreach r [concat $headrows $rows] {
                     if [info exists f($r,$c)] { 
                         set f($r,$template) $f($r,$c) 
                         unset f($r,$c)
                     }
                     if [info exists v($r,$c)] {
                     set v($r,$template) $v($r,$c) 
                     unset v($r,$c)
                     }
                 }
                 set v(title,$template) -${template}
                 if [info exists cs($c)] {
                     set cs($template) $cs($c); unset cs($c)
                 } else {puts "ColRename: cs($c) not exist bug"}
                 if [info exists cw($c)] {
                     set cw($template) $cw($c); unset cw($c)
                 } else {puts "ColRename: cw($c) not exist bug"}
                 if {($c == $oldc)} {set oldc $template}
             }
         }
     }
 
     set c $oldc
 
     ReDisplay
     wm withdraw $win
     .w config -cursor {}
     Modified
     return
 }
 
 # SplitSel
 #
 #      Split rr1, rr2 into "selected" (s) and "rest" (x1, x2)
 #
 # Arguments:
 #      rr1, rr2   row/col name lists
 #      rs         row/col selection list
 #      s          output selected names
 #      x1,x2      output rest
 #
 proc SplitSel {rr1 rr2 rs} {
     set s {}; set x1 {}; set x2 {}
     foreach y $rr1 {
         if {([lsearch $rs $y] == -1)} {lappend x1 $y} else {lappend s $y}
     }
     foreach y $rr2 {
         if {([lsearch $rs $y] == -1)} {lappend x2 $y} else {lappend s $y}
     }
     return [list $x1 $x2 $s]    
 }
 
 # CellAbove ... CellRight --
 #
 #      Procedures referring to the value in the neighbouring cell
 #
 proc CellAbove {} {
 global headrows rows r c v
     set itemlist [concat $headrows $rows]
     set x [lindex $itemlist [Pred [lsearch $itemlist $r] ] ]
     return $v($x,$c)
 }
 
 proc CellBelow {} {
 global headrows rows r c v
     set itemlist [concat $headrows $rows]
     set x [lindex $itemlist \
             [Succ [lsearch $itemlist $r] [llength $itemlist] ] ]
     return $v($x,$c)
 }
 
 proc CellLeft {} {
 global sidecols cols r c v
     set itemlist [concat $sidecols $cols]
     set x [lindex $itemlist [Pred [lsearch $itemlist $c] ] ]
     return $v($r,$x)
 }
 
 proc CellRight {} {
 global sidecols cols r c v
     set itemlist [concat $sidecols $cols]
     set x [lindex $itemlist \
             [Succ [lsearch $itemlist $c] [llength $itemlist] ] ]
     return $v($r,$x)
 }
 
 #
 # Functions Pred (predecessor), This, and Succ (successor), supporting
 # moves to neighbouring cells.
 #
 proc Pred {i} {
     set i [expr ($i - 1)]
     if {$i < 0} {set i 0}
     return $i
 }
 
 proc This {i} {
     if {$i < 1} {set i 1}
     return $i
 }
 
 proc Succ {i max} {
     incr i
     if {$i >= $max} {set i 0}
     return $i
 }
 
 # Service routine for row/col move.
 proc RCMove {rr1 rr2 rs} {
 global inspoint 
 
     foreach {x1 x2 s} [SplitSel $rr1 $rr2 $rs] {break}
     # ii is Insert Index
     set ii [lsearch $x1 $inspoint]
     if {$ii > -1} {
         return [list \
          [concat [lrange $x1 0 [Pred $ii]] $s [lrange $x1 [This $ii] end]] \
             $x2]
     } else {
         set ii [lsearch $x2 $inspoint]
         if {$ii > -1} {
             return [list $x1 \
                 [concat [lrange $x2 0 [Pred $ii]] $s [lrange $x2 [This $ii] end]]]
         } else {return [list $x1 [concat $x2 $s]]}
     }
     Modified
 }
 
 proc RowMove {} {
 global headrows rows rowsel
     foreach {headrows rows} [RCMove $headrows $rows $rowsel] {break}
     ReDisplay
 }
 
 proc ColMove {} {
 global sidecols cols colsel
     foreach {sidecols cols} [RCMove $sidecols $cols $colsel] {break}
     ReDisplay
 }
 
 # Service routine for row/column kill.
 proc RCKill {rrName rs} {
     upvar $rrName rr
     set x {}
     foreach y $rr {if {([lsearch $rs $y] == -1)} {lappend x $y}}
     set rr $x
     Modified
 }
 
 proc RowKill {} {
 global r rowsel rows headrows autocalc
     RCKill headrows $rowsel
     RCKill rows $rowsel
     set rowsel {}
     set r title ;# safe
     if $autocalc ReCalc ReDisplay
 }
 
 proc ColKill {} {
 global c colsel cols sidecols autocalc
     RCKill sidecols $colsel
     RCKill cols $colsel
     set colsel {}
     set c title
     if $autocalc ReCalc ReDisplay
 }
 
 #
 # Executed when regretting a subwindow operation (pressing Cancel)
 #
 proc DoNothing {win} {
     wm withdraw $win
     .w config -cursor {}
 }
 
 #
 # Window user interface for row/col spawn data input.
 #
 proc RCspawnWindow {title spawnCmd win} {
 global template spawn colours
     .w config -cursor watch
     if [winfo exists $win] { wm deiconify $win; raise $win; return }
 
     toplevel $win
     wm title $win $title 
     CenterWin $win .w
     wm resizable $win true false
 
     frame $win.f1
     frame $win.f2
     frame $win.f3
 
     label    $win.f1.l1 -text "Spawn Factor:" -width 15 -anchor e
     entry    $win.f1.e1 -textvariable spawn -width 5 -background $colours(textbg)
 
     label    $win.f2.lfac -text "Template:" -width 15 -anchor e
     entry    $win.f2.efac -textvariable template -background $colours(textbg)
 
     set com1 [list $spawnCmd $win]
     set com2 [list DoNothing $win]
     button $win.f3.ok    -text OK  -command $com1 
     bind     $win <Key-Return> $com1
     label    $win.f3.info    -text {-$i-} -justify center
     button $win.f3.close -text Cancel -command $com2
     bind     $win <Key-Escape> $com2
 
     pack $win.f1.l1 -side left 
     pack $win.f1.e1 -side left
     pack $win.f2.lfac -side left
     pack $win.f2.efac -fill x -expand true -side left
     pack $win.f3.ok -side left
     pack $win.f3.info -fill x -expand true -side left
     pack $win.f3.close -side right
 
     grid columnconf $win 0 -weight 1
     grid $win.f1 -in $win -column 0 -row 0 -sticky ew 
     grid $win.f2 -in $win -column 0 -row 1 -sticky ew 
     grid $win.f3 -in $win -column 0 -row 2 -sticky ew 
     
     raise $win
     return
 }
 
 # RCrenameWindow --
 #
 #      User interface service routine for inputting a string, 
 #      typically a template string for row/col rename.
 #
 # Arguments:
 #      title      To appear in window title.
 #      labeltext  To appear as label by the entry box.
 #      cmd        Callback cmd to be associated with OK.
 #      win        identifier of new toplevel window to be opened/used.
 #      rc         r for row rename, c for col rename
 #
 proc RCrenameWindow {title labeltext renameCmd win rc} {
 global colours
     if [winfo exists $win] { wm deiconify $win; raise $win; return }
     .w config -cursor watch
     toplevel $win
     wm title $win $title
     CenterWin $win .w
     wm resizable $win true false
 
     frame    $win.f0
     frame    $win.f1
 
     label    $win.f0.l -text $labeltext -anchor e
     entry    $win.f0.e -textvariable template -background $colours(textbg)
 
     set doScript     [list $renameCmd  $win] 
     set cancelScript [list DoNothing   $win]
 
     button $win.f1.tag   -text "Tag" -command "set template \\\$$rc#"
     button $win.f1.untag -text "Untag" -command \
             "set template {\[string trimright \$$rc \"#\"\]}"
     button $win.f1.do  -text "OK"       -command $doScript
     bind   $win <Key-Return>                     $doScript
     button $win.f1.close -text "Cancel" -command $cancelScript 
     bind   $win <Key-Escape>                     $cancelScript
     label  $win.f1.info  -text {-$i-} -justify center
 
     pack $win.f0.l -side left
     pack $win.f0.e -fill x -expand true -side left
     pack $win.f1.do $win.f1.tag $win.f1.untag -side left
     pack $win.f1.info -fill x -expand true -side left
     pack $win.f1.close -side right
 
     grid columnconf $win 0 -weight 1
     grid $win.f0 -in $win -sticky ew 
     grid $win.f1 -in $win -sticky ew 
     
     raise $win
     return
 }
 # Now, Today, USAtoday --
 #
 #      Return current time, formatted, for use in clock applications and 
 #      user file name generation.
 #
 proc Now {} {
     set x [clock format [clock seconds]]
     regsub -all { } $x {=} x
     return $x
 }
 
 proc Today {} {
     return [clock format [clock seconds] -format {%d-%h-%Y}]
 }
 
 proc USAtoday {} {
     return [clock format [clock seconds] -format {%Y/%h/%d}]
 }
 
 # StartClock, StopClock --
 #
 #      Routines to put a running clock (hours) into a cell, and to stop it.
 #      (this could be generalized by using time formatting; reminder mv)
 #
 proc StartClock {} {
 global r c tr tc f thisformula rows cw frq sidecols cols v
     if [info exists tr] {StopClock}
 
     # Make room for date strings:
     set cw(title) 36
     lappend rows [Now]
 
     # last (new) row:
     set r [lindex $rows [expr ([llength $rows] - 1)]]
 
     set fmt [.w.fr.box1.ef get]
     if {$fmt == ""} {set fmt {$cw($c).2}}
     set thisformula "\[format \"%${fmt}f\" \
      \[expr (\[clock seconds\] - [clock seconds]) / 3600.0 \]\]"
     foreach x [concat $sidecols $cols] {set f($r,$x) "-"; set v($r,$x) "-"}
     set f($r,$c) $thisformula
     set v($r,$c) CLOCK
     set tr $r; set tc $c
     ReDisplay
     Modified
 }
 
 proc StopClock {} {
 global r c f v thisformula tr tc
     # Make sure that CLOCK cell is stopped:
     set oldr $r; set oldc $c
     set r $tr; set c $tc
     ReCalcCell
     if [info exists v($r,$c)] {
         set thisformula [string trim $v($r,$c)]
     } else {set thisformula "?UNDEF"}
     set f($r,$c) $thisformula
     Modified
     ReDisplayCell
     PaintCell "" "" "" notime
     if [info exists tr] {unset tr}
     if [info exists tc] {unset tc}
     set r $oldr; set c $oldc
 }
 
 #  ComposeFixed ... ComposeCurr, AddExpr, LeftAlign
 #
 #      The formatted string composition routines, used in the 
 #      Formula box when editing.
 #
 proc ComposeFixed {} {
 global ef e
     ComposeCmd "\[format \"%[$ef get]f\" [$e get]\]"
 }
 
 proc ComposeFloat {} {
 global ef e
     ComposeCmd "\[format \"%[$ef get]g\" [$e get]\]"
 }
 
 proc ComposeInt {} {
 global ef e
     ComposeCmd "\[format \"%[$ef get]d\" \[scan [$e get] \"%d\" x; set x\]\]"
 }
 
 proc ComposeCurr {} {
 global w e
     ComposeCmd "\[format \"%$\{w\}.2f\" [$e get]\]" 
 }
 
 proc AddExpr {} {
 global e 
     ComposeCmd "\[expr [$e get]\]"
 }
 
 proc LeftAlign {} {
 global w e
     if [regexp "\[ \t\]" [$e get]] {
         # "Embrace" if multiword:
         ComposeCmd "\[format \"%-$\{w\}s\" \{[$e get]\}\]"
     } else {
         ComposeCmd "\[format \"%-$\{w\}s\" [$e get]\]"
     }
 }
 
 # CenterWin --
 #
 #      Centers a window (win) in its parent (otherwin). 
 #      Improved version of one found in Midnight Commander.
 #
 proc CenterWin {win otherwin} {
     wm withdraw $win
     foreach {c r} {x height y width} {set cen$c [winfo req$r $win]}
     set geo [split [wm geometry $otherwin] +x]
     foreach {p n} {pdx 0 pdy 1 px 2 py 3} {set $p [lindex $geo $n]}
     foreach c {x y} {set $c [expr \$p$c+((\$pd$c-\$cen$c)/2)]}
     wm geometry $win +$x+$y
     wm deiconify $win
 }
 
 # TagsConfig --
 #
 #      (re-)Configure the colour tags used in spreadsheet panels
 #
 proc TagsConfig {} {
 global frq colours
     foreach panel {main side head corner} {
         $frq.$panel tag config title -background $colours(selcolour)
         $frq.$panel tag config time      -foreground $colours(timecolour) 
         $frq.$panel tag config instag    -foreground $colours(inscolour)
         $frq.$panel tag config current   -background $colours(textcur)\
                                          -foreground $colours(textbg)
         # "blank" tag:
         $frq.$panel tag config curtitle    
         $frq.$panel tag config mancolour -background $colours(mancolour)
     }
     return
 }
 
 # KeyRight ... KeyDown --
 #
 #      One cell cursor motion routines.
 #
 proc KeyRight {} {
 global sidecols cols c
     KeyForward [concat $sidecols $cols] $c "c"
     return
 }
 
 proc KeyLeft {} {
 global sidecols cols c
     KeyBackward [concat $sidecols $cols] $c "c"
     return
 }
 
 proc KeyUp {} {
 global headrows rows r
     KeyBackward [concat $headrows $rows] $r "r"
     return
 }
 
 proc KeyDown {} {
 global headrows rows r
     KeyForward [concat $headrows $rows] $r "r"
     return
 }
 
 # UnPaintCurrentCell --
 #
 #      Remove "current cell" painting from WHOLE spreadsheet
 #
 proc UnPaintCurrentCell {} {
 global headrows rows sidecols cols
     PaintCell "" "" "" nocurrent
     PaintCell "" "" "" nocurtitle
     return
 }
 
 # PaintCurrentCell --
 #
 #      Paint the current cell with coloured tag "current", and tag
 #      (for "see" operation, scrolling) associated row/col title cells
 #
 proc PaintCurrentCell {} {
 global r c
     PaintCell [RowColPanel $r    $c] $r    $c current
     PaintCell [RowColPanel title $c] title $c curtitle
     PaintCell [RowColPanel $r title] $r title curtitle
     return
 }
 
 proc KeyForward {itemlist item rc} {
 global r c
     UnPaintCurrentCell
     set x [lindex $itemlist [Succ [lsearch $itemlist $item] [llength $itemlist] ] ]
     if {$rc == "r"} {set r $x} {set c $x}
     PaintCurrentCell
 }
 
 proc KeyBackward {itemlist item rc} {
 global r c
     UnPaintCurrentCell
     set x [lindex $itemlist [Pred [lsearch $itemlist $item] ] ]
     if {$rc == "r"} {set r $x} {set c $x}
     PaintCurrentCell
 }
 
 # Put an info label stating default dir of motion, autocalc:
 #
 proc PutInfo {} {
 global defmov autocalc fr tools
     if $autocalc {set au "Auto"} else {set au "-"}
     switch -- $defmov {
         {-}            {} 
         {Left}  KeyLeft
         {Right} KeyRight 
         {Up}    KeyUp
         {Down}  KeyDown
     }
     $tools.flag configure -text "$defmov $au"
 }
 
 #
 # Keep track of focus status:
 #
 proc NavFocus {} {
 global frq colours
     focus $frq
     $frq.flag configure -text "NAV" -foreground $colours(mancolour)
     .w config -cursor {}
     return
 }
 
 proc EditFocus {} {
 global frq colours
     focus .w.fr.box1.e
     $frq.flag configure -text "EDIT" -foreground $colours(mancolour)
     return
 }
 
 #
 # Keep track of modification status and display logo:
 #
 proc Modified {} {
 global modified frq
     MakeLogo red
     set modified 1
     set reload 1
 }
 
 proc UnModified {} {
 global modified frq
     MakeLogo #00b000
     set modified 0
 }
 
 # MakeLogo --
 #
 #      Draw the tk# logo in green or red (indicating "modified").
 #
 # Argument:
 #      colour   either green or red
 #
 proc MakeLogo {colour} {
 global colours
     return [if [info exists logo] {image delete logo} 
     image create bitmap logo -foreground $colour -data {
 #define tk_pic2_width 30
 #define tk_pic2_height 27
 static unsigned char tk_pic2_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x10, 0x02, 0x00, 0x00, 0x10, 0x02, 0x00, 0x00,
      0x18, 0x03, 0x00, 0x00, 0x08, 0x11, 0x00, 0x00, 0xbe, 0x1d, 0x00, 0x00,
      0x88, 0x05, 0x00, 0x00, 0x8c, 0xe3, 0x0c, 0x03, 0x84, 0xe2, 0x0c, 0x03,
      0xc6, 0x06, 0x0c, 0x03, 0x42, 0x0c, 0x8e, 0x03, 0x7e, 0x08, 0x86, 0x01,
      0x00, 0x00, 0x86, 0x01, 0x00, 0xe0, 0xff, 0x0f, 0x00, 0xe0, 0xff, 0x0f,
      0x00, 0x00, 0xc3, 0x00, 0x00, 0x00, 0xc3, 0x00, 0x00, 0x80, 0x61, 0x00,
      0x00, 0x80, 0x61, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x00, 0xf8, 0xff, 0x03,
      0x00, 0xc0, 0x30, 0x00, 0x00, 0xc0, 0x30, 0x00, 0x00, 0xe0, 0x38, 0x00,
      0x00, 0x60, 0x18, 0x00, 0x00, 0x60, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00};
 
     }] 
 }
 
 # Service routine for inserting math functions in Formula box:
 proc InsertFunction {be en} {
 global e
     if [$e selection present] {
         $e insert sel.first $be    
         $e insert sel.last  $en
         $e selection from [expr [$e index sel.first] - [string length $be]]
         $e selection to   [expr [$e index sel.last]  + [string length $en]]
         
     } else {
         $e insert insert $be
         $e insert insert $en
         $e icursor [expr [$e index insert] - [string length $en]]
     }
 }
 
 # ConcatNoTitle --
 #
 #      Concatenate two lists of row/col names, but leave "title" out
 #
 proc ConcatNoTitle {rr1 rr2} {
    set s {}
    set rr [concat $rr1 $rr2]
    foreach x $rr {
        if {$x != "title"} {lappend s $x}
    }
    return $s
 }
 
 # BuildMenu --
 #
 #      Construct the pulldown menu of tk#.
 #
 proc BuildMenu {} {
 global fr b exp lfl lfs defmov e reps
     set b [frame $fr.box0 -relief raised -borderwidth 2]
 
     menubutton $b.file -text File -menu $b.file.menu -underline 0
     set m [menu $b.file.menu -tearoff 0]
         $m add command -label Load           -command {Load 1} 
         $m add command -label Save           -command {Save 0} -accel "^S"
         $m add command -label "Save As..."   -command {Save 1}
         $m add command -label "Save Select"  -command {Save 2}
         $m add separator
         $m add command -label "Load Repository" -command {Load 2} 
         $m add command -label "Show Repositories" -command {
             wm title .w "Rep: $reps"
             }
         $m add separator
         $m add cascade -label "Export Set-Up" -menu $m.sub0
             set m2 [menu $m.sub0 -tearoff 1]
             $m2 add radio -label "All"       -variable exp(howmuch)
             $m2 add radio -label "Selection" -variable exp(howmuch)
             set exp(howmuch) "All"
             $m2 add separator
             $m2 add check -label "Title Row" -variable exp(titlerow)
             $m2 add check -label "Title Col" -variable exp(titlecol)
             set exp(titlerow) 0; set exp(titlecol) 0
             $m2 add separator
             $m2 add radio -label "Tab"     -variable exp(separ)
             $m2 add radio -label "Comma"   -variable exp(separ)
             $m2 add radio -label "Blank"   -variable exp(separ)
             $m2 add radio -label "Newline" -variable exp(separ)
             $m2 add radio -label "None"    -variable exp(separ)
             $m2 add radio -label "LaTeX"   -variable exp(separ)
             set exp(separ) "Tab"
         $m add command -label "Export"     -command Export
         $m add command -label "Import"     -command Import
         $m add separator
         $m add command -label Quit -command QuitWarn -accelerator "^Q"
         $m add separator
         # quotes to force eval here:
         $m add command -label "$lfl" -command "set filename $lfl ; Load 0"
         $m add command -label "$lfs" -command "set filename $lfs ; Load 0"
 
     menubutton $b.editrc -text Edit -menu .w.fr.box0.editrc.menu -underline 0
     set m [menu $b.editrc.menu -tearoff 0]
         $m add command -label "Row Spawn" -command {
             RCspawnWindow "Row Spawn" RowSpawn ".rs"
         }
         $m add command -label "Row Rename" -command {
             RCrenameWindow "Row Rename" "New Name Template:" RowRename\
                     .rren r
         } 
         $m add command -label "Row Move" -command RowMove 
         $m add command -label "Row Kill" -command RowKill 
      $m add separator
         $m add command -label "Col Spawn" -command {
             RCspawnWindow "Col Spawn" ColSpawn ".cs"
         }
         $m add command -label "Col Rename" -command {
             RCrenameWindow "Column Rename" "New Name Template:" ColRename\
                     .cren c
         } 
         $m add command -label "Col Move" -command ColMove 
         $m add command -label "Col Kill" -command ColKill 
 
     menubutton $b.sel -text Select -menu $b.sel.menu -underline 0
     set m [menu $b.sel.menu -tearoff 1]
         $m add command -label "Row Select Box" -command {
             SelectEdit [ConcatNoTitle $rows $headrows] r \
                 "Row Select by Listbox" multiple rowsel
         }
         $m add command -label "Col Select Box" -command {
             SelectEdit [ConcatNoTitle $cols $sidecols] c \
                 "Col Select by Listbox" multiple colsel
         } 
         $m add command -label "Select Match" -command SelectMatch
         $m add separator
         $m add command -label "Select All" -command {
             set rowsel [ConcatNoTitle $headrows $rows]
             set colsel [ConcatNoTitle $sidecols $cols]
             PaintSelect
         } 
         $m add separator
         $m add command -label "Insert Mark" -command {
             SelectEdit [concat $headrows $rows $sidecols $cols] i \
                  "Set Insert Mark" single inspoint
         }
         $m add separator
         # Here a match string for the selected set of rows/cols is inserted
         # (Thanks Bruce Gingery for the idea):
         $m add command -label "Row Matchmaker" -command {
             $e insert insert [join $rowsel |]
             # necessary :-(
             set rowsel $r
         }
         $m add command -label "Col Matchmaker" -command {
             $e insert insert [join $colsel |]
             set colsel $c
         }
 
     menubutton $b.format -text Format -menu $b.format.menu 
     set m [menu $b.format.menu -tearoff 1]
         $m add command -label "Fixed Real"    -acc "^F" -command ComposeFixed
         $m add command -label "Floating Real" -acc "^G" -command ComposeFloat
         $m add command -label "Integer"       -acc "^N" -command ComposeInt
         $m add command -label "Currency"      -acc "^C" -command ComposeCurr
         $m add command -label "Left-Align"    -acc "^L" -command LeftAlign
         $m add separator
         $m add command -label {Add        [expr...]} -acc "^E" -command AddExpr
         $m add command -label {Remove [expr...]} -command {
             if [regexp {^\[expr (.*)\]$} [$e get] dummy y] {ComposeCmd $y}
         }
         $m add command -label {Remove [format...]} -command {
             if [regexp {^\[format +"[^"]*" +(.*)\] *$} \
                     [$e get] dummy y] {
                 ComposeCmd $y
             }
             # Remove excess curlies if necessary (for leftalign multiword):
             if [regexp {\{(.*)\}} [$e get] dummy y] {
                 ComposeCmd $y
             }
             # remove scan if necessary (for compose integer):
             if [regexp {^\[scan +(.+)"[^"]*" +.+\] *$} [$e get] dummy y] {
                 ComposeCmd $y
             }
         }
         $m add separator
         $m add command -label "Replace by Value" \
             -command {set thisformula [subst [$e get]]} 
         $m add separator
         $m add command -label "Clear" -command {set thisformula ""} 
 
     menubutton $b.calc -text Options -menu $b.calc.menu -underline 0
     set m [menu $b.calc.menu -tearoff 0]
         $m add check -label AutoCalc -variable autocalc -command PutInfo
         $m add command -label ReCalc -command ReCalc
         $m add command -label "ReCalc Sel" -command {ReCalc 1}
         $m add command -label "ReDisplay"    -command ReDisplay
         $m add separator
         foreach x {- Left Right Up Down} {
             $m add radio -label $x -var defmov -command PutInfo
         }
         set defmov "-"
 
     menubutton $b.math -text Math -menu $b.math.menu -underline 0
     set m [menu $b.math.menu -tearoff 0]
         $m add cascade -label "Functions 1" -menu $m.sub1
             set m2 [menu $m.sub1 -tearoff 1]
         foreach x {acos cos sinh asin cosh log sqrt atan exp log10 tan tanh sin} {
             $m2 add command -label $x -command [list InsertFunction "$x\(" ")"]
         }
         $m add cascade -label "Functions 2" -menu $m.sub2
             set m2 [menu $m.sub2 -tearoff 1]
         foreach x {floor ceil abs double int round hypot atan2 pow fmod} {
             $m2 add command -label $x -command [list InsertFunction "$x\(" ")"]
         }
         $m add cascade -label "Row Aggregate" -menu $m.sub3
             set m2 [menu $m.sub3 -tearoff 1]
         foreach x {Sum Av Cnt wSum wAv Ssq sSsq RMS wRMS Sd wSd} {
             $m2 add command -label "$x" \
                  -command [list InsertFunction "\[$x r " "\]"]
             }
         $m add cascade -label "Col Aggregate" -menu $m.sub4
             set m2 [menu $m.sub4 -tearoff 1]
         foreach x {Sum Av Cnt wSum wAv Ssq sSsq RMS wRMS Sd wSd} {
             $m2 add command -label "$x" \
                  -command [list InsertFunction "\[$x c " "\]"]
             }
 
     menubutton $b.clock -text Clock -menu $b.clock.menu -underline 0
     set m [menu $b.clock.menu -tearoff 0]
         $m add command -label "(Re-)Start" -command StartClock
         $m add command -label "Stop"       -command StopClock
 
     menubutton $b.colour -text Colour -menu $b.colour.menu 
     set m [menu $b.colour.menu -tearoff 1]
         $m add command -lab "Foreground"   -command {ColourReconfig textfg}
         $m add command -lab "Background"   -command {ColourReconfig textbg} 
         $m add command -lab "Current Cell" -command {ColourReconfig textcur} 
         $m add command -lab "Insert Point" -command {ColourReconfig inscolour} 
         $m add command -lab "Selection"    -command {ColourReconfig selcolour} 
         $m add command -lab "Clock Cell"   -command {ColourReconfig timecolour} 
         $m add separator
         $m add command -lab "tk# icon"     -command {ColourReconfig iconcolour} 
         $m add command -lab "man titles"   -command {ColourReconfig mancolour} 
         $m add separator
         $m add command -lab "Default"      -command {
             ColourDefault
             ColoursSet
         } 
     menubutton $b.help -text Help -menu $fr.box0.help.menu -underline 0 
     set m [menu $b.help.menu -tearoff 0]
         $m add command -label "Manual"   -command Manual 
         $m add command -label "About..." -command About
 
 }
 
 # ShowWindow --
 # 
 #      Construct and display rest of the GUI of tk#.
 #
 proc ShowWindow {} {
 global thisformula cwidth titlerow titlecol
 global colours winsize
 global filename autocalc inspoint headrows rows sidecols cols
 # Symbolic widget names:
 #      b     menubutton row
 #      e     Formula:  entrybox
 #      ef    Format:   entrybox
 #      ew    Colwidth: entrybox
 #      fr    frame around everything
 #      frq   frame around spreadsheet panels
 #      tools tool button bar.
 global b e ef ew fr frq tools
     if {[winfo exists .w]} { wm deiconify .w; return }
     #
     # Widgets definition: 
     #
     frame .w ; pack .w
     wm geometry  .w $winsize
     wm minsize   .w 1 1
     wm resizable .w 1 1
     wm title     .w "tk# -- a spreadsheet with a difference"
 
     bind .w <Destroy> {if {"%W" == ".w"} {QuitWarn}}
     bind .w <Control-s> {Save 0}
     bind .w <Control-q> QuitWarn
 
     set fr  [frame .w.fr -borderwidth 0 -height 45 -width 50]
     set frq [frame $fr.frq -highlightcolor black -highlightthickness 2 \
                      -borderwidth 0]
 
     set logo [MakeLogo #00b000]
 
     button $frq.logo -padx 0 -pady 0 -image logo \
          -relief raised -borderwidth 2 -command {Save 0}
     label $frq.flag -anchor w -pady 0
     bind  $frq.flag <Button> NavFocus
     NavFocus
 
     set tools [frame $fr.tools -borderwidth 0]
 
     # toolbar:
     button $tools.quit  -pady 0 -text Quit -command QuitWarn
     button $tools.save  -pady 0 -text Save -command {Save 0}
     button $tools.calc  -pady 0 -text Calc -command ReCalc
     button $tools.view  -pady 0 -text View -command {ReDisplay; PutInfo}
     button $tools.start -pady 0 -text Start -command StartClock
     button $tools.stop  -pady 0 -text Stop -command StopClock
     label  $tools.flag  -pady 0 -width 20 -foreground $colours(mancolour)
     PutInfo
 
     # The two scrollbars:
     scrollbar $frq.hscroll -borderwidth 1 -comm {HorizScroll} -orient horiz 
     scrollbar $frq.vscroll -borderwidth 1 -comm {VertScroll}  -orient vert 
 
     # The four main spreadsheet panels:
     text $frq.main -wrap none -font fixed -background $colours(textbg) \
                      -foreground $colours(textfg)\
                 -xscrollcommand {.w.fr.frq.hscroll set} \
                 -yscrollcommand {.w.fr.frq.vscroll set}
     text $frq.head -wrap none -background $colours(textbg) \
                  -foreground $colours(textfg)\
                  -font fixed -height 3 -xscrollcommand {.w.fr.frq.hscroll set} 
     text $frq.side -wrap none -background $colours(textbg) \
                  -foreground $colours(textfg)\
                  -font fixed -width 20 -yscrollcommand {.w.fr.frq.vscroll set} 
     text $frq.corner -width 20 -height 3 -font fixed -wrap none\
                 -background $colours(textbg) -foreground $colours(textfg) 
 
     BuildMenu
 
     frame $fr.box1
     label $fr.box1.l -text "Formula:" -width 8 -anchor e
 
     set e [entry $fr.box1.e -textvariable thisformula \
                  -background $colours(textbg)]
     bind $e <Key-Return> {GetFormula}
 
     bind $e <Key-Escape> {NavFocus}
     bind $e <Key-Down>   {NavFocus; KeyDown}
     bind $e <Key-Up>     {NavFocus; KeyUp  }
 
     bind $e <Button> {EditFocus}
 
     # Keybindings for entry formatting:
     bind $e <Control-f> {ComposeFixed}
     bind $e <Control-g> {ComposeFloat}
     bind $e <Control-n> {ComposeInt}
     bind $e <Control-c> {ComposeCurr}
     bind $e <Control-e> {AddExpr}
     bind $e <Control-l> {LeftAlign}
 
     label $fr.box1.lw -text "Colwidth:" -width 8 -anchor e
     set ew [entry $fr.box1.ew -textvariable cwidth \
                 -background $colours(textbg) -width 4]
     bind $ew <Key-Return> {ColWidth}
     bind $ew <Key-Escape> {NavFocus}
     bind $ew <Button>     {EditFocus}
 
     label $fr.box1.lf -text "Format:" -width 7 -anchor e
     set ef [entry $fr.box1.ef -textvariable fmtitem \
                 -background $colours(textbg) -width 4]
     bind $ef <Button>     {EditFocus}
     bind $ef <Key-Escape> {NavFocus}
 
     foreach panel {main head side corner} {
         $frq.$panel config -cursor arrow
         bind $frq.$panel <Button-1> [list GetMouse1 $panel] 
         bind $frq.$panel <Button-3> [list GetMouse3 $panel] 
     }
     
     # bind the middle mouse button dragging function:
     foreach panel {main head side corner} {
         bind $frq.$panel <B2-Motion>\
               [list BindDragto %x %y $frq.main $frq.head $frq.side $frq.corner]
         bind $frq.$panel <Button-2> {
               [list BindMark   %x %y $frq.main $frq.head $frq.side $frq.corner]
         }
     } 
 
     foreach panel {main head side corner} {
         bind $frq.$panel <Button-2> [list GetMouse2 $panel]
     }
 
     # The arrow keys:
     bind $frq <Key-Right> KeyRight
     bind $frq <Key-Left>  KeyLeft
     bind $frq <Key-Down>  KeyDown
     bind $frq <Key-Up>    KeyUp
 
     bind $frq <Control-Key-Right> {$frq.main xview scroll  1 pages}
     bind $frq <Control-Key-Left>  {$frq.main xview scroll -1 pages}
     bind $frq <Control-Key-Down>  {$frq.main yview scroll  1 pages}
     bind $frq <Control-Key-Up>    {$frq.main yview scroll -1 pages}
  
     bind $frq <Key-Return> {SetUpEntry}
     bind $frq <Key-Escape> {SetUpForEdit}
 
     foreach panel {side head corner} {
         $frq.$panel tag config underline -background #d9d9d9 \
                 -relief raised -borderwidth 2
     }
 
     TagsConfig
  
     #
     # Geometry definition: 
     #
 
     grid columnconf .w 0 -weight 1
     grid rowconf    .w 0 -weight 1
 
     grid $fr -in .w -column 0 -row 0 -sticky news 
 
     grid columnconf $fr 0 -weight 1
     grid rowconf    $fr 3 -weight 1
 
     pack $b.file $b.editrc $b.format $b.sel \
              $b.calc $b.math $b.colour $b.clock -side left
     pack $b.help -side right
 
     pack $fr.box1.l -side left
     pack $fr.box1.e -side left -fill x -expand true
     pack $fr.box1.ew $fr.box1.lw $fr.box1.ef $fr.box1.lf -side right
 
     grid $b       -sticky ew
     grid $fr.box1 -sticky ew
 
     grid $tools   -sticky ew
 
     pack $tools.quit -side right
     pack $tools.save $tools.flag $tools.calc \
      $tools.view $tools.start $tools.stop -side left
 
     grid $frq -in $fr -sticky news
 
     grid columnconf $frq 2 -weight 1
     grid rowconf    $frq 2 -weight 1
 
     grid $frq.logo    $frq.flag   $frq.hscroll -sticky new
     grid ^            $frq.corner $frq.head    -sticky news
     grid $frq.vscroll $frq.side   $frq.main    -sticky news
 
     focus $frq
     UnModified
 }
 
 init $argc $argv
 
 ShowWindow 
 
 # command line filename(s):
 foreach filename $argv {
     Load 0
 }
 
 ReCalc

Comments edit

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References