[RFA] balloon.tcl

[RFA] balloon.tcl

[Martin M. Hunt]

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  <hunt@redhat.com>

	* 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.

Re: [RFA] balloon.tcl

[Keith Seitz]

On Thu, 7 Mar 2002, Martin M. Hunt wrote:

> 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?

Approved. Upvar makes me nervous, though. I wish there was a way we could
just to a function callback, but that would be a much larger change. For
now, let's see how this works.

Thanks, Martin.
Keith

> 2002-03-07  Martin M. Hunt  <hunt@redhat.com>
>
> 	* 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.
>
>
>

Re: [RFA] balloon.tcl

[Martin M. Hunt]

Checked in.

On Thursday 07 March 2002 12:11 pm, Keith Seitz wrote:
> On Thu, 7 Mar 2002, Martin M. Hunt wrote:
> > 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?
>
> Approved. Upvar makes me nervous, though. I wish there was a way we could
> just to a function callback, but that would be a much larger change. For
> now, let's see how this works.
>
> Thanks, Martin.
> Keith
>
> > 2002-03-07  Martin M. Hunt  <hunt@redhat.com>
> >
> > 	* 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.