File: listentry.tcl

package info (click to toggle)
moomps 4.6-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,444 kB
  • ctags: 2,307
  • sloc: tcl: 34,882; sh: 167; makefile: 91
file content (181 lines) | stat: -rw-r--r-- 8,201 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: listentry.tcl,v 1.23 2005/01/02 00:45:07 jfontain Exp $


class listEntry {

    proc listEntry {this parentPath args} composite {
        [new selectTable $parentPath\
            -background $widget::option(entry,background) -focuscommand "listEntry::focus $this"\
            -selectcommand "listEntry::select $this"\
        ] $args
    } {
        ::set ($this,entry) 0
        composite::complete $this
        newRowEntry $this 0                                                                               ;# start with an empty row
    }

    proc ~listEntry {this} {
        variable ${this}row
        catch {unset ${this}row}
    }

    proc options {this} {                                                                              ;# force sizes initialization
        return [list\
            [list -height 50]\
            [list -state normal normal]\
            [list -width 100]\
        ]
    }

    proc set-height {this value} {                                                                                      ;# in pixels
        composite::configure $composite::($this,base) base -height $value
    }
    proc set-width {this value} {                                                                                       ;# in pixels
        composite::configure $composite::($this,base) base -width $value
    }

    proc set-state {this value} {
        composite::configure $composite::($this,base) -state $value
        foreach window [selectTable::windows $composite::($this,base)] {
            $window configure -state $value
        }
    }

    proc newRowEntry {this row} {
        ::set base $composite::($this,base)
        ::set path $selectTable::($base,tablePath)
        ::set entry [entry $path.$($this,entry)\
            -font $font::(mediumNormal) -borderwidth 0 -highlightthickness 0 -state $composite::($this,-state)\
        ]
        bindings $this $entry $row
        selectTable::windowConfigure $base $row,0 -window $entry -padx 1 -pady 1 -sticky nsew
        incr ($this,entry)
        return $entry
    }

    proc bindings {this entry row} {
        bind $entry <FocusIn>\
            "listEntry::refresh $this $entry; selectTable::select $composite::($this,base) \[listEntry::row $this $entry\]"
        bind $entry <Return> "listEntry::enter $this $entry"
        bind $entry <KP_Enter> "listEntry::enter $this $entry"
    }

    proc row {this entry} {
        variable ${this}row                                                                                                 ;# cache

        if {[info exists ${this}row($entry)]} {
            return [::set ${this}row($entry)]
        }
        ::set base $composite::($this,base)
        ::set rows [selectTable::rows $base]
        for {::set row 0} {$row < $rows} {incr row} {
            if {[string equal [selectTable::window $base $row,0] $entry]} {
                return [::set ${this}row($entry) $row]
            }
        }
    }

    proc refresh {this {entry {}}} {    ;# remove empty rows except currently edited row if any, and possibly leave single empty row
        variable ${this}row                                                                                                 ;# cache

        ::set base $composite::($this,base)
        if {[string length $entry] > 0} {::set current [row $this $entry]}
        ::set delete {}
        ::set rows [selectTable::rows $base]
        for {::set row 0} {$row < $rows} {incr row} {
            if {[info exists current] && ($row == $current)} continue                                           ;# skip current line
            ::set entry [selectTable::window $base $row,0]
            if {[string length [string trim [$entry get]]] == 0} {
                lappend delete $row
            }
        }
        ::set refresh 0
        if {[llength $delete] > 0} {
            selectTable::delete $base $delete
            unset ${this}row                                                                                          ;# reset cache
            ::set refresh 1
        }
        if {[selectTable::rows $base] == 0} {
            selectTable::rows $base 1
            newRowEntry $this 0                                                                       ;# always leave an empty entry
            ::set refresh 1
        }
        if {$refresh} {
            selectTable::refreshBorders $base
        }
    }

    proc enter {this entry} {                                         ;# rows have been updated at this point since it got the focus
        ::set row [row $this $entry]
        incr row                                                                                                  ;# move down 1 row
        ::set base $composite::($this,base)
        ::set rows [selectTable::rows $base]
        if {$row == $rows} {                                                                                          ;# on last row
            if {[string length [$entry get]] > 0} {                                                                     ;# not empty
                selectTable::rows $base [incr rows]
                ::set entry [newRowEntry $this $row]                                                       ;# create a new empty row
                selectTable::refreshBorders $base
                selectTable::see $base $row,0          ;# make sure new row is seen as setting focus is not set on invisible entries
            }                                                                                                     ;# else stay there
        } else {
            ::set entry [selectTable::window $base $row,0]
        }
        ::focus $entry
    }

    proc focus {this row in} {
        if {$in} {
            ::focus [selectTable::window $composite::($this,base) $row,0]
        }
    }

    proc select {this target} {
        ::set base $composite::($this,base)
        ::set rows [selectTable::rows $base]
        for {::set row 0} {$row < $rows} {incr row} {
            if {$row == $target} continue                                                                      ;# skip row to select
            [selectTable::window $base $row,0] selection clear
        }
        return 1                                                                                       ;# allow selection to proceed
    }

    # public procedures follow:

    proc set {this list} {                                               ;# list of strings to be used in place of any existing list
        ::set base $composite::($this,base)
        ::set rows {}
        ::set maximum [selectTable::rows $base]
        for {::set row 0} {$row < $maximum} {incr row} {lappend rows $row}
        selectTable::delete $base $rows
        selectTable::clear $base
        ::set state $composite::($this,-state)
        selectTable::rows $base [llength $list]                                        ;# note: must be done before rows are created
        ::set row 0
        foreach string $list {
            ::set entry [newRowEntry $this $row]
            $entry configure -state normal
            $entry insert end $string
            $entry configure -state $state
            incr row
        }
        refresh $this                                            ;# eliminate empty rows or create single empty row if list is empty
        selectTable::refreshBorders $base
    }

    proc get {this} {                                                                    ;# retrieve list of possibly edited entries
        ::set base $composite::($this,base)
        ::set rows [selectTable::rows $base]
        ::set strings {}
        for {::set row 0} {$row < $rows} {incr row} {
            ::set string [string trim [[selectTable::window $base $row,0] get]]
            if {[string length $string] > 0} {                                                        ;# only keep non blank strings
                lappend strings $string
            }
        }
        return $strings
    }

}