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