1# ------------------------------------------------------------------------------
2#  entry.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: entry.tcl,v 1.23 2009/09/06 21:13:55 oberdorfer 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::define Entry entry DragSite DropSite DynamicHelp
21
22    # Note:  -textvariable is pulled off of the tk entry and put onto the
23    # BW Entry so that we avoid the TkResource test for it, which screws up
24    # the existance/non-existance bits of the -textvariable.
25    Widget::tkinclude Entry entry :cmd \
26    	remove { -state -background -foreground -textvariable
27    		 -disabledforeground -disabledbackground }
28
29    set declare [list \
30	    [list -background   Color       "SystemWindow"       0] \
31	    [list -foreground   Color       "SystemWindowText"   0] \
32            [list -disabledbackground Color "SystemButtonFace"   0] \
33            [list -disabledforeground Color "SystemDisabledText" 0] \
34	    [list -highlightcolor     Color "SystemHighlight"    0] \
35	    [list -state        Enum        normal 0  [list normal disabled]] \
36	    [list -text         String      ""	   0] \
37	    [list -textvariable String      ""     0] \
38	    [list -editable     Boolean     1      0] \
39	    [list -command      String      ""     0] \
40	    [list -relief       TkResource  ""     0  entry] \
41	    [list -borderwidth  TkResource  ""     0  entry] \
42	    [list -fg           Synonym     -foreground] \
43	    [list -bg           Synonym     -background] \
44	    [list -bd           Synonym     -borderwidth] \
45	]
46
47    Widget::declare Entry $declare
48    Widget::addmap Entry "" :cmd { -textvariable {} }
49
50    DynamicHelp::include Entry balloon
51    DragSite::include    Entry "" 3
52    DropSite::include    Entry {
53        TEXT    {move {}}
54        FGCOLOR {move {}}
55        BGCOLOR {move {}}
56        COLOR   {move {}}
57    }
58
59    foreach event [bind Entry] {
60        bind BwEntry $event [bind Entry $event]
61    }
62
63    # Copy is kind of a special event.  It should be enabled when the
64    # widget is editable but not disabled, and not when the widget is disabled.
65    # To make this a bit easier to manage, we will handle it separately.
66
67    bind BwEntry <<Copy>> {}
68    bind BwEditableEntry <<Copy>> [bind Entry <<Copy>>]
69
70    bind BwEntry <Return>          [list Entry::invoke %W]
71    bind BwEntry <Destroy>         [list Entry::_destroy %W]
72    bind BwDisabledEntry <Destroy> [list Entry::_destroy %W]
73
74    if {[lsearch [bindtags .] EntryThemeChanged] < 0} {
75        bindtags . [linsert [bindtags .] 1 EntryThemeChanged]
76    }
77}
78
79
80# ------------------------------------------------------------------------------
81#  Command Entry::create
82# ------------------------------------------------------------------------------
83proc Entry::create { path args } {
84    variable $path
85    upvar 0 $path data
86
87    array set maps [list Entry {} :cmd {}]
88    array set maps [Widget::parseArgs Entry $args]
89
90    set data(afterid) ""
91    eval [list entry $path] $maps(:cmd)
92    Widget::initFromODB Entry $path $maps(Entry)
93    set state    [Widget::getMegawidgetOption $path -state]
94    set editable [Widget::getMegawidgetOption $path -editable]
95    set text     [Widget::getMegawidgetOption $path -text]
96    if { $editable && [string equal $state "normal"] } {
97        bindtags $path [list $path BwEntry [winfo toplevel $path] all]
98        $path configure -takefocus 1 -insertontime 600
99    } else {
100        bindtags $path [list $path BwDisabledEntry [winfo toplevel $path] all]
101        $path configure -takefocus 0 -insertontime 0
102    }
103    if { $editable == 0 } {
104        $path configure -cursor left_ptr
105    }
106    if { [string equal $state "disabled"] } {
107        $path configure \
108            -foreground [Widget::getMegawidgetOption $path -disabledforeground] \
109            -background [Widget::getMegawidgetOption $path -disabledbackground]
110    } else {
111	$path configure \
112                -foreground [Widget::getMegawidgetOption $path -foreground] \
113                -background [Widget::getMegawidgetOption $path -background]
114	bindtags $path [linsert [bindtags $path] 2 BwEditableEntry]
115    }
116    if { [string length $text] } {
117	set varName [$path cget -textvariable]
118	if { ![string equal $varName ""] } {
119	    uplevel \#0 [list set $varName [Widget::cget $path -text]]
120	} else {
121	    set validateState [$path cget -validate]
122	    $path configure -validate none
123	    $path delete 0 end
124	    $path configure -validate $validateState
125	    $path insert 0 [Widget::getMegawidgetOption $path -text]
126	}
127    }
128
129    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd 1
130    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd 1
131    DynamicHelp::sethelp $path $path 1
132
133    bind EntryThemeChanged <<ThemeChanged>> \
134	   "+ [namespace current]::_themechanged $path"
135
136    Widget::create Entry $path
137    proc ::$path { cmd args } \
138    	"return \[Entry::_path_command [list $path] \$cmd \$args\]"
139    return $path
140}
141
142
143# ------------------------------------------------------------------------------
144#  Command Entry::configure
145# ------------------------------------------------------------------------------
146proc Entry::configure { path args } {
147    # Cheat by setting the -text value to the current contents of the entry
148    # This might be better hidden behind a function in ::Widget.
149    set Widget::Entry::${path}:opt(-text) [$path:cmd get]
150
151    set res [Widget::configure $path $args]
152
153    # Extract the modified bits that we are interested in.
154    set vars [list chstate cheditable chfg chdfg chbg chdbg chtext]
155    set opts [list -state -editable -foreground -disabledforeground \
156                -background -disabledbackground -text]
157    foreach $vars [eval [linsert $opts 0 Widget::hasChangedX $path]] { break }
158
159    if { $chstate || $cheditable } {
160	set state [Widget::getMegawidgetOption $path -state]
161	set editable [Widget::getMegawidgetOption $path -editable]
162        set btags [bindtags $path]
163        if { $editable && [string equal $state "normal"] } {
164            set idx [lsearch $btags BwDisabledEntry]
165            if { $idx != -1 } {
166                bindtags $path [lreplace $btags $idx $idx BwEntry]
167            }
168            $path:cmd configure -takefocus 1 -insertontime 600
169        } else {
170            set idx [lsearch $btags BwEntry]
171            if { $idx != -1 } {
172                bindtags $path [lreplace $btags $idx $idx BwDisabledEntry]
173            }
174            $path:cmd configure -takefocus 0 -insertontime 0
175            if { [string equal [focus] $path] } {
176                focus .
177            }
178        }
179    }
180
181    if { $chstate || $chfg || $chdfg || $chbg || $chdbg } {
182	set state [Widget::getMegawidgetOption $path -state]
183        if { [string equal $state "disabled"] } {
184            $path:cmd configure \
185                -fg [Widget::cget $path -disabledforeground] \
186                -bg [Widget::cget $path -disabledbackground]
187        } else {
188            $path:cmd configure \
189                -fg [Widget::cget $path -foreground] \
190                -bg [Widget::cget $path -background]
191        }
192    }
193    if { $chstate } {
194	if { [string equal $state "disabled"] } {
195	    set idx [lsearch -exact [bindtags $path] BwEditableEntry]
196	    if { $idx != -1 } {
197		bindtags $path [lreplace [bindtags $path] $idx $idx]
198	    }
199	} else {
200	    set idx [expr {[lsearch [bindtags $path] Bw*Entry] + 1}]
201	    bindtags $path [linsert [bindtags $path] $idx BwEditableEntry]
202	}
203    }
204
205    if { $cheditable } {
206        if { $editable } {
207            $path:cmd configure -cursor xterm
208        } else {
209            $path:cmd configure -cursor left_ptr
210        }
211    }
212
213    if { $chtext } {
214	# Oh my lordee-ba-goordee
215	# Do some magic to prevent multiple validation command firings.
216	# If there is a textvariable, set that to the right value; if not,
217	# disable validation, delete the old text, enable, then set the text.
218	set varName [$path:cmd cget -textvariable]
219	if { ![string equal $varName ""] } {
220	    uplevel \#0 [list set $varName \
221		    [Widget::getMegawidgetOption $path -text]]
222	} else {
223	    set validateState [$path:cmd cget -validate]
224	    $path:cmd configure -validate none
225	    $path:cmd delete 0 end
226	    $path:cmd configure -validate $validateState
227	    $path:cmd insert 0 [Widget::getMegawidgetOption $path -text]
228	}
229    }
230
231    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd
232    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd
233    DynamicHelp::sethelp $path $path
234
235    return $res
236}
237
238
239# ------------------------------------------------------------------------------
240#  Command Entry::cget
241# ------------------------------------------------------------------------------
242proc Entry::cget { path option } {
243    if { [string equal "-text" $option] } {
244	return [$path:cmd get]
245    }
246    Widget::cget $path $option
247}
248
249
250# ------------------------------------------------------------------------------
251#  Command Entry::invoke
252# ------------------------------------------------------------------------------
253proc Entry::invoke { path } {
254    if {[llength [set cmd [Widget::getMegawidgetOption $path -command]]]} {
255        uplevel \#0 $cmd
256    }
257}
258
259
260# ------------------------------------------------------------------------------
261#  Command Entry::_path_command
262# ------------------------------------------------------------------------------
263proc Entry::_path_command { path cmd larg } {
264    switch -exact -- $cmd {
265        configure - cget - invoke {
266            return [eval [linsert $larg 0 Entry::$cmd $path]]
267        }
268        default {
269            return [eval [linsert $larg 0 $path:cmd $cmd]]
270        }
271    }
272}
273
274
275# ------------------------------------------------------------------------------
276#  Command Entry::_init_drag_cmd
277# ------------------------------------------------------------------------------
278proc Entry::_init_drag_cmd { path X Y top } {
279    variable $path
280    upvar 0  $path data
281
282    if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} {
283        return [uplevel \#0 $cmd [list $path $X $Y $top]]
284    }
285    set type [Widget::getoption $path -dragtype]
286    if { $type == "" } {
287        set type "TEXT"
288    }
289    if { [set drag [$path get]] != "" } {
290        if { [$path:cmd selection present] } {
291            set idx  [$path:cmd index @[expr {$X-[winfo rootx $path]}]]
292            set sel0 [$path:cmd index sel.first]
293            set sel1 [expr {[$path:cmd index sel.last]-1}]
294            if { $idx >=  $sel0 && $idx <= $sel1 } {
295                set drag [string range $drag $sel0 $sel1]
296                set data(dragstart) $sel0
297                set data(dragend)   [expr {$sel1+1}]
298                if { ![Widget::getoption $path -editable] ||
299                     [Widget::getoption $path -state] == "disabled" } {
300                    return [list $type {copy} $drag]
301                } else {
302                    return [list $type {copy move} $drag]
303                }
304            }
305        } else {
306            set data(dragstart) 0
307            set data(dragend)   end
308            if { ![Widget::getoption $path -editable] ||
309                 [Widget::getoption $path -state] == "disabled" } {
310                return [list $type {copy} $drag]
311            } else {
312                return [list $type {copy move} $drag]
313            }
314        }
315    }
316}
317
318
319# ------------------------------------------------------------------------------
320#  Command Entry::_end_drag_cmd
321# ------------------------------------------------------------------------------
322proc Entry::_end_drag_cmd { path target op type dnddata result } {
323    variable $path
324    upvar 0  $path data
325
326    if {[llength [set cmd [Widget::getoption $path -dragendcmd]]]} {
327        return [uplevel \#0 $cmd [list $path $target $op $type $dnddata $result]]
328    }
329    if { $result && $op == "move" && $path != $target } {
330        $path:cmd delete $data(dragstart) $data(dragend)
331    }
332}
333
334
335# ------------------------------------------------------------------------------
336#  Command Entry::_drop_cmd
337# ------------------------------------------------------------------------------
338proc Entry::_drop_cmd { path source X Y op type dnddata } {
339    variable $path
340    upvar 0  $path data
341
342    if { $data(afterid) != "" } {
343        after cancel $data(afterid)
344        set data(afterid) ""
345    }
346    if {[llength [set cmd [Widget::getoption $path -dropcmd]]]} {
347        set idx [$path:cmd index @[expr {$X-[winfo rootx $path]}]]
348        return [uplevel \#0 $cmd [list $path $source $idx $op $type $dnddata]]
349    }
350    if { $type == "COLOR" || $type == "FGCOLOR" } {
351        configure $path -foreground $dnddata
352    } elseif { $type == "BGCOLOR" } {
353        configure $path -background $dnddata
354    } else {
355        $path:cmd icursor @[expr {$X-[winfo rootx $path]}]
356        if { $op == "move" && $path == $source } {
357            $path:cmd delete $data(dragstart) $data(dragend)
358        }
359        set sel0 [$path index insert]
360        $path:cmd insert insert $dnddata
361        set sel1 [$path index insert]
362        $path:cmd selection range $sel0 $sel1
363    }
364    return 1
365}
366
367
368# ------------------------------------------------------------------------------
369#  Command Entry::_over_cmd
370# ------------------------------------------------------------------------------
371proc Entry::_over_cmd { path source event X Y op type dnddata } {
372    variable $path
373    upvar 0  $path data
374
375    set x [expr {$X-[winfo rootx $path]}]
376    if { [string equal $event "leave"] } {
377        if { [string length $data(afterid)] } {
378            after cancel $data(afterid)
379            set data(afterid) ""
380        }
381    } elseif { [_auto_scroll $path $x] } {
382        return 2
383    }
384
385    if {[llength [set cmd [Widget::getoption $path -dropovercmd]]]} {
386        set x   [expr {$X-[winfo rootx $path]}]
387        set idx [$path:cmd index @$x]
388        set res [uplevel \#0 $cmd [list $path $source $event $idx $op $type $dnddata]]
389        return $res
390    }
391
392    if { [string equal $type "COLOR"]   ||
393         [string equal $type "FGCOLOR"] ||
394         [string equal $type "BGCOLOR"] } {
395        DropSite::setcursor based_arrow_down
396        return 1
397    }
398    if { [Widget::getoption $path -editable]
399	&& [string equal [Widget::getoption $path -state] "normal"] } {
400        if { ![string equal $event "leave"] } {
401            $path:cmd selection clear
402            $path:cmd icursor @$x
403            DropSite::setcursor based_arrow_down
404            return 3
405        }
406    }
407    DropSite::setcursor dot
408    return 0
409}
410
411
412# ------------------------------------------------------------------------------
413#  Command Entry::_auto_scroll
414# ------------------------------------------------------------------------------
415proc Entry::_auto_scroll { path x } {
416    variable $path
417    upvar 0  $path data
418
419    set xmax [winfo width $path]
420    if { $x <= 10 && [$path:cmd index @0] > 0 } {
421        if { $data(afterid) == "" } {
422            set data(afterid) [after 100 [list Entry::_scroll $path -1 $x $xmax]]
423            DropSite::setcursor sb_left_arrow
424        }
425        return 1
426    } else {
427        if { $x >= $xmax-10 && [$path:cmd index @$xmax] < [$path:cmd index end] } {
428            if { $data(afterid) == "" } {
429                set data(afterid) [after 100 [list Entry::_scroll $path 1 $x $xmax]]
430                DropSite::setcursor sb_right_arrow
431            }
432            return 1
433        } else {
434            if { $data(afterid) != "" } {
435                after cancel $data(afterid)
436                set data(afterid) ""
437            }
438        }
439    }
440    return 0
441}
442
443
444# ------------------------------------------------------------------------------
445#  Command Entry::_scroll
446# ------------------------------------------------------------------------------
447proc Entry::_scroll { path dir x xmax } {
448    variable $path
449    upvar 0  $path data
450
451    $path:cmd xview scroll $dir units
452    $path:cmd icursor @$x
453    if { ($dir == -1 && [$path:cmd index @0] > 0) ||
454         ($dir == 1  && [$path:cmd index @$xmax] < [$path:cmd index end]) } {
455        set data(afterid) [after 100 [list Entry::_scroll $path $dir $x $xmax]]
456    } else {
457        set data(afterid) ""
458        DropSite::setcursor dot
459    }
460}
461
462
463# ------------------------------------------------------------------------------
464#  Command Entry::_destroy
465# ------------------------------------------------------------------------------
466proc Entry::_destroy { path } {
467    variable $path
468    upvar 0 $path data
469    Widget::destroy $path
470    unset data
471}
472
473# ----------------------------------------------------------------------------
474#  Command ListBox::_themechanged
475# ----------------------------------------------------------------------------
476proc Entry::_themechanged { path } {
477
478    if { ![winfo exists $path] } { return }
479    BWidget::set_themedefaults
480       $path configure \
481           -foreground         $BWidget::colors(SystemWindowText) \
482           -background         $BWidget::colors(SystemWindow) \
483	   -selectforeground   $BWidget::colors(SystemHighlightText) \
484	   -selectbackground   $BWidget::colors(SystemHighlight) \
485           -disabledbackground $BWidget::colors(SystemButtonFace) \
486	   -disabledforeground $BWidget::colors(SystemDisabledText) \
487	   -highlightcolor     $BWidget::colors(SystemHighlight)
488}
489