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
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 2970b5118fcfb744cb64d5e415ca1e600a353efbae18a61fe4546163a2699766
User & Date: peter 2018-05-21 15:45:13.272
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
Unified Diff Ignore Whitespace Patch
Changes to eskil.vfs/lib/psballoon/psballoon.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14

#----------------------------------------------------------------------
#
#  psballoon.tcl,
#   Procedures to create help message balloons or display balloons for
#   listboxes and labels that can't display all of their contents.
#
#  Copyright (c) 2003, Peter Spjuth  (peter.spjuth@space.se)
#
#  Permission is granted to use this code under the same terms as
#  for the Tcl core code.
#
#----------------------------------------------------------------------
# $Revision: 1.1 $
#----------------------------------------------------------------------







|








1
2
3
4
5
6
7
8
9
10
11
12
13
14

#----------------------------------------------------------------------
#
#  psballoon.tcl,
#   Procedures to create help message balloons or display balloons for
#   listboxes and labels that can't display all of their contents.
#
#  Copyright (c) 2003, Peter Spjuth  (peter.spjuth@gmail.com)
#
#  Permission is granted to use this code under the same terms as
#  for the Tcl core code.
#
#----------------------------------------------------------------------
# $Revision: 1.1 $
#----------------------------------------------------------------------
︙︙
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

            if {$ix < 0} {
                set ix [string first " " $line]
                if {$ix < 0} {
                    # Just cut at 80
                    set ix 80
                }
            }
                
            if {$ix == 0} {
                set line [string trim $line]
            } else {
                lappend lines [string range $line 0 $ix-1]
                set line [string range $line $ix+1 end]
            }
        }








|








43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

            if {$ix < 0} {
                set ix [string first " " $line]
                if {$ix < 0} {
                    # Just cut at 80
                    set ix 80
                }
            }

            if {$ix == 0} {
                set line [string trim $line]
            } else {
                lappend lines [string range $line 0 $ix-1]
                set line [string range $line $ix+1 end]
            }
        }
︙︙
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

    set msg [lindex $args end]
    set args [lrange $args 0 end-1]

    # Request for formatting
    if {"-fmt" in $args && $msg ne ""} {
        set msg [Fmt $msg]
    }
    
    set c [winfo class $w]
    if {$msg == "" && $c != "Listbox" && $c != "Label"} {
        error "Missing message to balloon for $w ($c)"
    }
    set balloon(msg,$w) $msg
    bind $w <Enter> {
        set ::psballoon::balloon(pending) 1








|








67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

    set msg [lindex $args end]
    set args [lrange $args 0 end-1]

    # Request for formatting
    if {"-fmt" in $args && $msg ne ""} {
        set msg [Fmt $msg]
    }

    set c [winfo class $w]
    if {$msg == "" && $c != "Listbox" && $c != "Label"} {
        error "Missing message to balloon for $w ($c)"
    }
    set balloon(msg,$w) $msg
    bind $w <Enter> {
        set ::psballoon::balloon(pending) 1
︙︙
133
134
135
136
137
138
139










140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

        }
        # Fallback to something reasonable of font fails.
        if {$font eq ""} {
            set font TkDefaultFont
        }
        set ww [winfo width $w]
        set ih [winfo height $w]










        set ix 0
        set iy 0
        set create 1
        set msg $balloon(msg,$w)
        if {$msg == ""} {
            switch [winfo class $w] {
                Listbox {
                    set i [$w index @$mx,$my]
                    set msg [$w get $i]
                    foreach {ix iy iw ih} [$w bbox $i] {break}
                }
                Label {
                    set msg [$w cget -text]
		    set iw [Measure $font $msg]
                }
            }
            #Don't create a balloon if the text is fully visible.
            set create [expr {$iw > $ww - 8}]
        } else {
            if {[string index $msg 0] eq "\["} {
                set msg [subst -novariables -nobackslashes $msg]
            }
	    set iw [Measure $font $msg]
	}








>
>
>
>
>
>
>
>
>
>
















|








133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

        }
        # Fallback to something reasonable of font fails.
        if {$font eq ""} {
            set font TkDefaultFont
        }
        set ww [winfo width $w]
        set ih [winfo height $w]
        if {[winfo class $w] in {TLabelframe Labelframe}} {
            # Put it below the label, not the entire widget.
            # 1.5 font heights is a reasonable guess
            set fh [font metrics $font -linespace]
            set ih [expr {$fh * 3 /2 }]
            # Below cursor at least
            if {$ih <= $my} {
                set ih [expr {$my + 5}]
            }
        }
        set ix 0
        set iy 0
        set create 1
        set msg $balloon(msg,$w)
        if {$msg == ""} {
            switch [winfo class $w] {
                Listbox {
                    set i [$w index @$mx,$my]
                    set msg [$w get $i]
                    foreach {ix iy iw ih} [$w bbox $i] {break}
                }
                Label {
                    set msg [$w cget -text]
		    set iw [Measure $font $msg]
                }
            }
            # Don't create a balloon if the text is fully visible.
            set create [expr {$iw > $ww - 8}]
        } else {
            if {[string index $msg 0] eq "\["} {
                set msg [subst -novariables -nobackslashes $msg]
            }
	    set iw [Measure $font $msg]
	}
︙︙