Eskil

Check-in [2970b5118f]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Handle balloon over labelframe
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 2970b5118fcfb744cb64d5e415ca1e600a353efbae18a61fe4546163a2699766
User & Date: peter 2018-05-21 15:45:13
Context
2018-06-05
15:51
Working on shortcuts for preprocess dialog. check-in: 544eded01c user: peter tags: trunk
2018-05-21
15:45
Handle balloon over labelframe check-in: 2970b5118f user: peter tags: trunk
2018-05-14
22:41
Added changeset tool to fourway check-in: f73bd4abeb user: peter tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to eskil.vfs/lib/psballoon/psballoon.tcl.

     1      1   #----------------------------------------------------------------------
     2      2   #
     3      3   #  psballoon.tcl,
     4      4   #   Procedures to create help message balloons or display balloons for
     5      5   #   listboxes and labels that can't display all of their contents.
     6      6   #
     7         -#  Copyright (c) 2003, Peter Spjuth  (peter.spjuth@space.se)
            7  +#  Copyright (c) 2003, Peter Spjuth  (peter.spjuth@gmail.com)
     8      8   #
     9      9   #  Permission is granted to use this code under the same terms as
    10     10   #  for the Tcl core code.
    11     11   #
    12     12   #----------------------------------------------------------------------
    13     13   # $Revision: 1.1 $
    14     14   #----------------------------------------------------------------------
................................................................................
    43     43               if {$ix < 0} {
    44     44                   set ix [string first " " $line]
    45     45                   if {$ix < 0} {
    46     46                       # Just cut at 80
    47     47                       set ix 80
    48     48                   }
    49     49               }
    50         -                
           50  +
    51     51               if {$ix == 0} {
    52     52                   set line [string trim $line]
    53     53               } else {
    54     54                   lappend lines [string range $line 0 $ix-1]
    55     55                   set line [string range $line $ix+1 end]
    56     56               }
    57     57           }
................................................................................
    67     67       set msg [lindex $args end]
    68     68       set args [lrange $args 0 end-1]
    69     69   
    70     70       # Request for formatting
    71     71       if {"-fmt" in $args && $msg ne ""} {
    72     72           set msg [Fmt $msg]
    73     73       }
    74         -    
           74  +
    75     75       set c [winfo class $w]
    76     76       if {$msg == "" && $c != "Listbox" && $c != "Label"} {
    77     77           error "Missing message to balloon for $w ($c)"
    78     78       }
    79     79       set balloon(msg,$w) $msg
    80     80       bind $w <Enter> {
    81     81           set ::psballoon::balloon(pending) 1
................................................................................
   133    133           }
   134    134           # Fallback to something reasonable of font fails.
   135    135           if {$font eq ""} {
   136    136               set font TkDefaultFont
   137    137           }
   138    138           set ww [winfo width $w]
   139    139           set ih [winfo height $w]
          140  +        if {[winfo class $w] in {TLabelframe Labelframe}} {
          141  +            # Put it below the label, not the entire widget.
          142  +            # 1.5 font heights is a reasonable guess
          143  +            set fh [font metrics $font -linespace]
          144  +            set ih [expr {$fh * 3 /2 }]
          145  +            # Below cursor at least
          146  +            if {$ih <= $my} {
          147  +                set ih [expr {$my + 5}]
          148  +            }
          149  +        }
   140    150           set ix 0
   141    151           set iy 0
   142    152           set create 1
   143    153           set msg $balloon(msg,$w)
   144    154           if {$msg == ""} {
   145    155               switch [winfo class $w] {
   146    156                   Listbox {
................................................................................
   149    159                       foreach {ix iy iw ih} [$w bbox $i] {break}
   150    160                   }
   151    161                   Label {
   152    162                       set msg [$w cget -text]
   153    163   		    set iw [Measure $font $msg]
   154    164                   }
   155    165               }
   156         -            #Don't create a balloon if the text is fully visible.
          166  +            # Don't create a balloon if the text is fully visible.
   157    167               set create [expr {$iw > $ww - 8}]
   158    168           } else {
   159    169               if {[string index $msg 0] eq "\["} {
   160    170                   set msg [subst -novariables -nobackslashes $msg]
   161    171               }
   162    172   	    set iw [Measure $font $msg]
   163    173   	}