source: trunk/BWidget-1.2.1/entry.tcl @ 984

Last change on this file since 984 was 931, checked in by toby, 11 years ago

include rest of files
File size: 14.1 KB
Line 
1# ------------------------------------------------------------------------------
2#  entry.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: entry.tcl,v 1.8 1999/07/09 08:10:31 eric Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - Entry::create
8#     - Entry::configure
9#     - Entry::cget
10#     - Entry::_destroy
11#     - Entry::_init_drag_cmd
12#     - Entry::_end_drag_cmd
13#     - Entry::_drop_cmd
14#     - Entry::_over_cmd
15#     - Entry::_auto_scroll
16#     - Entry::_scroll
17# ------------------------------------------------------------------------------
18
19namespace eval Entry {
20    Widget::tkinclude Entry entry :cmd \
21        remove {-state -cursor -foreground -textvariable}
22
23    Widget::declare Entry {
24        {-foreground         TkResource ""     0 entry}
25        {-disabledforeground TkResource ""     0 button}
26        {-state              Enum       normal 0 {normal disabled}}
27        {-text               String     "" 0}
28        {-textvariable       String     "" 0}
29        {-editable           Boolean    1  0}
30        {-command            String     "" 0}
31        {-relief             TkResource "" 0 entry}
32        {-borderwidth        TkResource "" 0 entry}
33        {-fg                 Synonym -foreground}
34        {-bd                 Synonym -borderwidth}
35    }
36
37    DynamicHelp::include Entry balloon
38    DragSite::include    Entry "" 3
39    DropSite::include    Entry {
40        TEXT    {move {}}
41        FGCOLOR {move {}}
42        BGCOLOR {move {}}
43        COLOR   {move {}}
44    }
45
46    foreach event [bind Entry] {
47        bind BwEntry $event [bind Entry $event]
48    }
49    bind BwEntry <Return>  {Entry::invoke %W}
50    bind BwEntry <Destroy> {Entry::_destroy %W}
51    bind BwDisabledEntry <Destroy> {Entry::_destroy %W}
52
53    proc ::Entry { path args } { return [eval Entry::create $path $args] }
54    proc use {} {}
55}
56
57
58# ------------------------------------------------------------------------------
59#  Command Entry::create
60# ------------------------------------------------------------------------------
61proc Entry::create { path args } {
62    variable $path
63    upvar 0  $path data
64
65    Widget::init Entry $path $args
66
67    set data(afterid) ""
68    if { [set varname [Widget::getoption $path -textvariable]] != "" } {
69        set data(varname) $varname
70    } else {
71        set data(varname) Entry::$path\(var\)
72    }
73
74    if { [GlobalVar::exists $data(varname)] } {
75        set curval [GlobalVar::getvar $data(varname)]
76        Widget::setoption $path -text $curval
77    } else {
78        set curval [Widget::getoption $path -text]
79        GlobalVar::setvar $data(varname) $curval
80    }
81
82    eval entry $path [Widget::subcget $path :cmd]
83    uplevel \#0 $path configure -textvariable [list $data(varname)]
84
85    set state    [Widget::getoption $path -state]
86    set editable [Widget::getoption $path -editable]
87    if { $editable && ![string compare $state "normal"] } {
88        bindtags $path [list $path BwEntry [winfo toplevel $path] all]
89        $path configure -takefocus 1
90    } else {
91        bindtags $path [list $path BwDisabledEntry [winfo toplevel $path] all]
92        $path configure -takefocus 0
93    }
94    if { $editable == 0 } {
95        $path configure -cursor left_ptr
96    }
97    if { ![string compare $state "disabled"] } {
98        $path configure -foreground [Widget::getoption $path -disabledforeground]
99    }
100
101    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd 1
102    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd 1
103    DynamicHelp::sethelp $path $path 1
104
105    rename $path ::$path:cmd
106    proc ::$path { cmd args } "return \[Entry::_path_command $path \$cmd \$args\]"
107
108    return $path
109}
110
111
112# ------------------------------------------------------------------------------
113#  Command Entry::configure
114# ------------------------------------------------------------------------------
115proc Entry::configure { path args } {
116    variable $path
117    upvar 0  $path data
118
119    Widget::setoption $path -text [$path:cmd get]
120
121    set res [Widget::configure $path $args]
122
123    set chstate    [Widget::hasChanged $path -state state]
124    set cheditable [Widget::hasChanged $path -editable editable]
125    set chfg       [Widget::hasChanged $path -foreground fg]
126    set chdfg      [Widget::hasChanged $path -disabledforeground dfg]
127
128    if { $chstate || $cheditable } {
129        set btags [bindtags $path]
130        if { $editable && ![string compare $state "normal"] } {
131            set idx [lsearch $btags BwDisabledEntry]
132            if { $idx != -1 } {
133                bindtags $path [lreplace $btags $idx $idx BwEntry]
134            }
135            $path:cmd configure -takefocus 1
136        } else {
137            set idx [lsearch $btags BwEntry]
138            if { $idx != -1 } {
139                bindtags $path [lreplace $btags $idx $idx BwDisabledEntry]
140            }
141            $path:cmd configure -takefocus 0
142            if { ![string compare [focus] $path] } {
143                focus .
144            }
145        }
146    }
147
148    if { $chstate || $chfg || $chdfg } {
149        if { ![string compare $state "disabled"] } {
150            $path:cmd configure -fg $dfg
151        } else {
152            $path:cmd configure -fg $fg
153        }
154    }
155
156    if { $cheditable } {
157        if { $editable } {
158            $path:cmd configure -cursor xterm
159        } else {
160            $path:cmd configure -cursor left_ptr
161        }
162    }
163
164    if { [Widget::hasChanged $path -textvariable varname] } {
165        if { [string length $varname] } {
166            set data(varname) $varname
167        } else {
168            catch {unset data(var)}
169            set data(varname) Entry::$path\(var\)
170        }
171        if { [GlobalVar::exists $data(varname)] } {
172            set curval [GlobalVar::getvar $data(varname)]
173            Widget::setoption $path -text $curval
174        } else {
175            Widget::hasChanged $path -text curval
176            GlobalVar::setvar $data(varname) $curval
177        }
178        uplevel \#0 $path:cmd configure -textvariable [list $data(varname)]
179    }
180
181    if { [Widget::hasChanged $path -text curval] } {
182        if { [Widget::getoption $path -textvariable] == "" } {
183            GlobalVar::setvar $data(varname) $curval
184        } else {
185            Widget::setoption $path -text [GlobalVar::getvar $data(varname)]
186        }
187    }
188
189    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd
190    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd
191    DynamicHelp::sethelp $path $path
192
193    return $res
194}
195
196
197# ------------------------------------------------------------------------------
198#  Command Entry::cget
199# ------------------------------------------------------------------------------
200proc Entry::cget { path option } {
201    Widget::setoption $path -text [$path:cmd get]
202    return [Widget::cget $path $option]
203}
204
205
206# ------------------------------------------------------------------------------
207#  Command Entry::invoke
208# ------------------------------------------------------------------------------
209proc Entry::invoke { path } {
210    if { [set cmd [Widget::getoption $path -command]] != "" } {
211        uplevel \#0 $cmd
212    }
213}
214
215
216# ------------------------------------------------------------------------------
217#  Command Entry::_path_command
218# ------------------------------------------------------------------------------
219proc Entry::_path_command { path cmd larg } {
220    if { ![string compare $cmd "configure"] || ![string compare $cmd "cget"] } {
221        return [eval Entry::$cmd $path $larg]
222    } else {
223        return [eval $path:cmd $cmd $larg]
224    }
225}
226
227
228# ------------------------------------------------------------------------------
229#  Command Entry::_destroy
230# ------------------------------------------------------------------------------
231proc Entry::_destroy { path } {
232    variable $path
233    upvar 0  $path data
234
235    Widget::destroy $path
236    rename $path {}
237    unset data
238}
239
240
241# ------------------------------------------------------------------------------
242#  Command Entry::_init_drag_cmd
243# ------------------------------------------------------------------------------
244proc Entry::_init_drag_cmd { path X Y top } {
245    variable $path
246    upvar 0  $path data
247
248    if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
249        return [uplevel \#0 $cmd [list $path $X $Y $top]]
250    }
251    set type [Widget::getoption $path -dragtype]
252    if { $type == "" } {
253        set type "TEXT"
254    }
255    if { [set drag [$path get]] != "" } {
256        if { [$path:cmd selection present] } {
257            set idx  [$path:cmd index @[expr $X-[winfo rootx $path]]]
258            set sel0 [$path:cmd index sel.first]
259            set sel1 [expr [$path:cmd index sel.last]-1]
260            if { $idx >=  $sel0 && $idx <= $sel1 } {
261                set drag [string range $drag $sel0 $sel1]
262                set data(dragstart) $sel0
263                set data(dragend)   [expr {$sel1+1}]
264                if { ![Widget::getoption $path -editable] ||
265                     [Widget::getoption $path -state] == "disabled" } {
266                    return [list $type {copy} $drag]
267                } else {
268                    return [list $type {copy move} $drag]
269                }
270            }
271        } else {
272            set data(dragstart) 0
273            set data(dragend)   end
274            if { ![Widget::getoption $path -editable] ||
275                 [Widget::getoption $path -state] == "disabled" } {
276                return [list $type {copy} $drag]
277            } else {
278                return [list $type {copy move} $drag]
279            }
280        }
281    }
282}
283
284
285# ------------------------------------------------------------------------------
286#  Command Entry::_end_drag_cmd
287# ------------------------------------------------------------------------------
288proc Entry::_end_drag_cmd { path target op type dnddata result } {
289    variable $path
290    upvar 0  $path data
291
292    if { [set cmd [Widget::getoption $path -dragendcmd]] != "" } {
293        return [uplevel \#0 $cmd [list $path $target $op $type $dnddata $result]]
294    }
295    if { $result && $op == "move" && $path != $target } {
296        $path:cmd delete $data(dragstart) $data(dragend)
297    }
298}
299
300
301# ------------------------------------------------------------------------------
302#  Command Entry::_drop_cmd
303# ------------------------------------------------------------------------------
304proc Entry::_drop_cmd { path source X Y op type dnddata } {
305    variable $path
306    upvar 0  $path data
307
308    if { $data(afterid) != "" } {
309        after cancel $data(afterid)
310        set data(afterid) ""
311    }
312    if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
313        set idx [$path:cmd index @[expr $X-[winfo rootx $path]]]
314        return [uplevel \#0 $cmd [list $path $source $idx $op $type $dnddata]]
315    }
316    if { $type == "COLOR" || $type == "FGCOLOR" } {
317        configure $path -foreground $dnddata
318    } elseif { $type == "BGCOLOR" } {
319        configure $path -background $dnddata
320    } else {
321        $path:cmd icursor @[expr $X-[winfo rootx $path]]
322        if { $op == "move" && $path == $source } {
323            $path:cmd delete $data(dragstart) $data(dragend)
324        }
325        set sel0 [$path index insert]
326        $path:cmd insert insert $dnddata
327        set sel1 [$path index insert]
328        $path:cmd selection range $sel0 $sel1
329    }
330    return 1
331}
332
333
334# ------------------------------------------------------------------------------
335#  Command Entry::_over_cmd
336# ------------------------------------------------------------------------------
337proc Entry::_over_cmd { path source event X Y op type dnddata } {
338    variable $path
339    upvar 0  $path data
340
341    set x [expr $X-[winfo rootx $path]]
342    if { ![string compare $event "leave"] } {
343        if { [string length $data(afterid)] } {
344            after cancel $data(afterid)
345            set data(afterid) ""
346        }
347    } elseif { [_auto_scroll $path $x] } {
348        return 2
349    }
350
351    if { [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
352        set x   [expr $X-[winfo rootx $path]]
353        set idx [$path:cmd index @$x]
354        set res [uplevel \#0 $cmd [list $path $source $event $idx $op $type $dnddata]]
355        return $res
356    }
357
358    if { ![string compare $type "COLOR"]   ||
359         ![string compare $type "FGCOLOR"] ||
360         ![string compare $type "BGCOLOR"] } {
361        DropSite::setcursor based_arrow_down
362        return 1
363    }
364    if { [Widget::getoption $path -editable] && ![string compare [Widget::getoption $path -state] "normal"] } {
365        if { [string compare $event "leave"] } {
366            $path:cmd selection clear
367            $path:cmd icursor @$x
368            DropSite::setcursor based_arrow_down
369            return 3
370        }
371    }
372    DropSite::setcursor dot
373    return 0
374}
375
376
377# ------------------------------------------------------------------------------
378#  Command Entry::_auto_scroll
379# ------------------------------------------------------------------------------
380proc Entry::_auto_scroll { path x } {
381    variable $path
382    upvar 0  $path data
383
384    set xmax [winfo width $path]
385    if { $x <= 10 && [$path:cmd index @0] > 0 } {
386        if { $data(afterid) == "" } {
387            set data(afterid) [after 100 "Entry::_scroll $path -1 $x $xmax"]
388            DropSite::setcursor sb_left_arrow
389        }
390        return 1
391    } else {
392        if { $x >= $xmax-10 && [$path:cmd index @$xmax] < [$path:cmd index end] } {
393            if { $data(afterid) == "" } {
394                set data(afterid) [after 100 "Entry::_scroll $path 1 $x $xmax"]
395                DropSite::setcursor sb_right_arrow
396            }
397            return 1
398        } else {
399            if { $data(afterid) != "" } {
400                after cancel $data(afterid)
401                set data(afterid) ""
402            }
403        }
404    }
405    return 0
406}
407
408
409# ------------------------------------------------------------------------------
410#  Command Entry::_scroll
411# ------------------------------------------------------------------------------
412proc Entry::_scroll { path dir x xmax } {
413    variable $path
414    upvar 0  $path data
415
416    $path:cmd xview scroll $dir units
417    $path:cmd icursor @$x
418    if { ($dir == -1 && [$path:cmd index @0] > 0) ||
419         ($dir == 1  && [$path:cmd index @$xmax] < [$path:cmd index end]) } {
420        set data(afterid) [after 100 "Entry::_scroll $path $dir $x $xmax"]
421    } else {
422        set data(afterid) ""
423        DropSite::setcursor dot
424    }
425}
426
Note: See TracBrowser for help on using the repository browser.