home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / label.tcl < prev    next >
Text File  |  2000-11-02  |  9KB  |  264 lines
  1. # ------------------------------------------------------------------------------
  2. #  label.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: label.tcl,v 1.2 1996/03/21 06:37:18 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - Label::create
  8. #     - Label::configure
  9. #     - Label::cget
  10. #     - Label::setfocus
  11. #     - Label::_drag_cmd
  12. #     - Label::_drop_cmd
  13. #     - Label::_over_cmd
  14. # ------------------------------------------------------------------------------
  15.  
  16. namespace eval Label {
  17.     Widget::tkinclude Label label :cmd \
  18.         remove {-foreground -text -textvariable -underline}
  19.  
  20.     Widget::declare Label {
  21.         {-name               String     "" 0}
  22.         {-text               String     "" 0}
  23.         {-textvariable       String     "" 0}
  24.         {-underline          Int        -1 0 {=-1}}
  25.         {-focus              String     "" 0}
  26.         {-foreground         TkResource "" 0 label}
  27.         {-disabledforeground TkResource "" 0 button}
  28.         {-state              Enum       normal 0  {normal disabled}}
  29.         {-fg                 Synonym    -foreground}
  30.  
  31.     }
  32.     DynamicHelp::include Label balloon
  33.     DragSite::include    Label "" 1
  34.     DropSite::include    Label {
  35.         TEXT    {move {}}
  36.         IMAGE   {move {}}
  37.         BITMAP  {move {}}
  38.         FGCOLOR {move {}}
  39.         BGCOLOR {move {}}
  40.         COLOR   {move {}}
  41.     }
  42.  
  43.     Widget::syncoptions Label "" :cmd {-text {} -underline {}}
  44.  
  45.     proc ::Label { path args } { return [eval Label::create $path $args] }
  46.     proc use {} {}
  47.  
  48.     bind BwLabel <FocusIn> {Label::setfocus %W}
  49.     bind BwLabel <Destroy> {Widget::destroy %W; rename %W {}}
  50. }
  51.  
  52.  
  53. # ------------------------------------------------------------------------------
  54. #  Command Label::create
  55. # ------------------------------------------------------------------------------
  56. proc Label::create { path args } {
  57.     Widget::init Label $path $args
  58.  
  59.     if { [Widget::getoption $path -state] == "normal" } {
  60.         set fg [Widget::getoption $path -foreground]
  61.     } else {
  62.  
  63.     # XXX: Disabled labels still should look enabled. See also some procs below
  64.         #set fg [Widget::getoption $path -disabledforeground]
  65.         set fg [Widget::getoption $path -foreground]
  66.     }
  67.  
  68.     set var [Widget::getoption $path -textvariable]
  69.     if {  $var == "" &&
  70.           [Widget::getoption $path -image] == "" &&
  71.           [Widget::getoption $path -bitmap] == ""} {
  72.         set desc [BWidget::getname [Widget::getoption $path -name]]
  73.         if { $desc != "" } {
  74.             set text  [lindex $desc 0]
  75.             set under [lindex $desc 1]
  76.         } else {
  77.             set text  [Widget::getoption $path -text]
  78.             set under [Widget::getoption $path -underline]
  79.         }
  80.     } else {
  81.         set under -1
  82.         set text  ""
  83.     }
  84.  
  85.     eval label $path [Widget::subcget $path :cmd] \
  86.         [list -text $text -textvariable $var -underline $under -foreground $fg]
  87.  
  88.     set accel [string tolower [string index $text $under]]
  89.     if { $accel != "" } {
  90.         bind [winfo toplevel $path] <Alt-$accel> "Label::setfocus $path"
  91.     }
  92.  
  93.     bindtags $path [list $path Label BwLabel [winfo toplevel $path] all]
  94.  
  95.     DragSite::setdrag $path $path Label::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
  96.     DropSite::setdrop $path $path Label::_over_cmd Label::_drop_cmd 1
  97.     DynamicHelp::sethelp $path $path 1
  98.  
  99.     rename $path ::$path:cmd
  100.     proc ::$path { cmd args } "return \[eval Label::\$cmd $path \$args\]"
  101.  
  102.     return $path
  103. }
  104.  
  105.  
  106. # ------------------------------------------------------------------------------
  107. #  Command Label::configure
  108. # ------------------------------------------------------------------------------
  109. proc Label::configure { path args } {
  110.     set oldunder [$path:cmd cget -underline]
  111.     if { $oldunder != -1 } {
  112.         set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
  113.     } else {
  114.         set oldaccel ""
  115.     }
  116.     set res [Widget::configure $path $args]
  117.  
  118.     set cfg  [Widget::hasChanged $path -foreground fg]
  119.     set cdfg [Widget::hasChanged $path -disabledforeground dfg]
  120.     set cst  [Widget::hasChanged $path -state state]
  121.  
  122.     if { $cst || $cfg || $cdfg } {
  123.         if { $state == "normal" } {
  124.             $path:cmd configure -fg $fg
  125.         } else {
  126.         # XXX 
  127.         $path:cmd configure -fg $fg
  128.             # $path:cmd configure -fg $dfg
  129.         }
  130.     }
  131.  
  132.     set cv [Widget::hasChanged $path -textvariable var]
  133.     set cb [Widget::hasChanged $path -image img]
  134.     set ci [Widget::hasChanged $path -bitmap bmp]
  135.     set cn [Widget::hasChanged $path -name name]
  136.     set ct [Widget::hasChanged $path -text text]
  137.     set cu [Widget::hasChanged $path -underline under]
  138.  
  139.     if { $cv || $cb || $ci || $cn || $ct || $cu } {
  140.         if {  $var == "" && $img == "" && $bmp == "" } {
  141.             set desc [BWidget::getname $name]
  142.             if { $desc != "" } {
  143.                 set text  [lindex $desc 0]
  144.                 set under [lindex $desc 1]
  145.             }
  146.         } else {
  147.             set under -1
  148.             set text  ""
  149.         }
  150.         set top [winfo toplevel $path]
  151.         if { $oldaccel != "" } {
  152.             bind $top <Alt-$oldaccel> {}
  153.         }
  154.         set accel [string tolower [string index $text $under]]
  155.         if { $accel != "" } {
  156.             bind $top <Alt-$accel> "Label::setfocus $path"
  157.         }
  158.         $path:cmd configure -text $text -underline $under -textvariable $var
  159.     }
  160.  
  161.     set force [Widget::hasChanged $path -dragendcmd dragend]
  162.     DragSite::setdrag $path $path Label::_init_drag_cmd $dragend $force
  163.     DropSite::setdrop $path $path Label::_over_cmd Label::_drop_cmd
  164.     DynamicHelp::sethelp $path $path
  165.  
  166.     return $res
  167. }
  168.  
  169.  
  170. # ------------------------------------------------------------------------------
  171. #  Command Label::cget
  172. # ------------------------------------------------------------------------------
  173. proc Label::cget { path option } {
  174.     return [Widget::cget $path $option]
  175. }
  176.  
  177.  
  178. # ------------------------------------------------------------------------------
  179. #  Command Label::setfocus
  180. # ------------------------------------------------------------------------------
  181. proc Label::setfocus { path } {
  182.     if { ![string compare [Widget::getoption $path -state] "normal"] } {
  183.         set w [Widget::getoption $path -focus]
  184.         if { [winfo exists $w] && [Widget::focusOK $w] } {
  185.             focus $w
  186.         }
  187.     }
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command Label::_init_drag_cmd
  193. # ------------------------------------------------------------------------------
  194. proc Label::_init_drag_cmd { path X Y top } {
  195.     if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
  196.         return [uplevel \#0 $cmd [list $path $X $Y $top]]
  197.     }
  198.     if { [set data [$path:cmd cget -image]] != "" } {
  199.         set type "IMAGE"
  200.         pack [label $top.l -image $data]
  201.     } elseif { [set data [$path:cmd cget -bitmap]] != "" } {
  202.         set type "BITMAP"
  203.         pack [label $top.l -bitmap $data]
  204.     } else {
  205.         set data [$path:cmd cget -text]
  206.         set type "TEXT"
  207.     }
  208.     set usertype [Widget::getoption $path -dragtype]
  209.     if { $usertype != "" } {
  210.         set type $usertype
  211.     }
  212.     return [list $type {copy} $data]
  213. }
  214.  
  215.  
  216. # ------------------------------------------------------------------------------
  217. #  Command Label::_drop_cmd
  218. # ------------------------------------------------------------------------------
  219. proc Label::_drop_cmd { path source X Y op type data } {
  220.     if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
  221.         return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]]
  222.     }
  223.     if { $type == "COLOR" || $type == "FGCOLOR" } {
  224.         configure $path -foreground $data
  225.     } elseif { $type == "BGCOLOR" } {
  226.         configure $path -background $data
  227.     } else {
  228.         set text   ""
  229.         set image  ""
  230.         set bitmap ""
  231.         switch -- $type {
  232.             IMAGE   {set image $data}
  233.             BITMAP  {set bitmap $data}
  234.             default {
  235.                 set text $data
  236.                 if { [set var [$path:cmd cget -textvariable]] != "" } {
  237.                     configure $path -image "" -bitmap ""
  238.                     GlobalVar::setvar $var $data
  239.                     return
  240.                 }
  241.             }
  242.         }
  243.         configure $path -text $text -image $image -bitmap $bitmap
  244.     }
  245.     return 1
  246. }
  247.  
  248.  
  249. # ------------------------------------------------------------------------------
  250. #  Command Label::_over_cmd
  251. # ------------------------------------------------------------------------------
  252. proc Label::_over_cmd { path source event X Y op type data } {
  253.     if { [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
  254.         return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]]
  255.     }
  256.     if { [Widget::getoption $path -state] == "normal" ||
  257.          $type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } {
  258.         DropSite::setcursor based_arrow_down
  259.         return 1
  260.     }
  261.     DropSite::setcursor dot
  262.     return 0
  263. }
  264.