From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 12576 invoked by alias); 7 Mar 2002 09:43:42 -0000 Mailing-List: contact insight-help@sources.redhat.com; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: insight-owner@sources.redhat.com Received: (qmail 12520 invoked from network); 7 Mar 2002 09:43:41 -0000 Received: from unknown (HELO localhost.localdomain) (12.230.181.242) by sources.redhat.com with SMTP; 7 Mar 2002 09:43:41 -0000 Received: from there (DRAGON [127.0.0.1]) by localhost.localdomain (8.11.6/8.11.6) with SMTP id g279h8x04308 for ; Thu, 7 Mar 2002 01:43:08 -0800 Message-Id: <200203070943.g279h8x04308@localhost.localdomain> Content-Type: text/plain; charset="iso-8859-1" From: "Martin M. Hunt" Organization: Red Hat Inc To: Insight Mailing List Subject: [RFA] balloon.tcl Date: Thu, 07 Mar 2002 01:43:00 -0000 X-Mailer: KMail [version 1.3.2] MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-SW-Source: 2002-q1/txt/msg00189.txt.bz2 I want balloon help to work like this: balloon register $twin "" balloon variable $twin [scope help] balloon notify [code $this foo] $twin Then in your private method "foo", you just set $help to whatever you want and it appears in the balloon window. Sounds OK? The following changes do that. They fix "balloon variable" and also all the code that actual sets and uses the variable. I did not clean up balloon.tcl; its still ugly, but at least it seems to work better. Comments? -- Martin Hunt GDB Engineer Red Hat, Inc. 2002-03-07 Martin M. Hunt * library/balloon.tcl (_set_variable): Set the public variable before calling notifiers. Set the help text from the public variable afterwards. (BALLOON_command_variable): Fix call with no args to return variable name. Index: balloon.tcl =================================================================== RCS file: /cvs/src/src/libgui/library/balloon.tcl,v retrieving revision 1.3 diff -u -p -r1.3 balloon.tcl --- balloon.tcl 2001/09/08 22:34:46 1.3 +++ balloon.tcl 2002/03/07 09:37:03 @@ -260,18 +260,26 @@ itcl_class Balloon { if {$index == ""} then { set value "" } elseif {[info exists _notifiers($index)] && ! $_in_notifier} then { + if {$variable != ""} { + upvar $variable var + set var $_help_text($index) + } set _in_notifier 1 uplevel \#0 $_notifiers($index) set _in_notifier 0 # Get value afterwards to give notifier a chance to change it. + if {$variable != ""} { + upvar $variable var + set _help_text($index) $var + } set value $_help_text($index) } else { set value $_help_text($index) } if {$variable != ""} then { - # itcl 1.5 forces us to do this in a strange way. - ::uplevel \#0 [list set $variable $value] + upvar $variable var + set var $value } } @@ -283,7 +291,6 @@ itcl_class Balloon { # An ordinary window. Position below the window, and right of # center. set _active $W - set help $_help_text($W) set left [expr {[winfo rootx $W] + round ([winfo width $W] * .75)}] set ypos [expr {[winfo rooty $W] + [winfo height $W]}] set alt_ypos [winfo rooty $W] @@ -292,8 +299,6 @@ itcl_class Balloon { set _recent_parent [winfo parent $W] } else { set _active $W,$tag - set help $_help_text($W,$tag) - # Switching on class name is bad. Do something better. Can't # just use the widget's bbox method, because the results differ # for Text and Canvas widgets. Bummer. @@ -329,6 +334,8 @@ itcl_class Balloon { } } + set help $_help_text($_active) + # On Windows, the popup location is always determined by the # cursor. Actually, the rule seems to be somewhat more complex. # Unfortunately it doesn't seem to be written down anywhere. @@ -489,8 +496,8 @@ proc BALLOON_command_withdraw {window} { proc BALLOON_command_variable {window args} { if {[llength $args] == 0} then { # Fetch. - set b [BALLOON_find_balloon [lindex $args 0]] - return [lindex [$b configure -variable] 4] + set b [BALLOON_find_balloon $window] + return [$b cget -variable] } else { # FIXME: no arg checking here. # Set.