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