This is the mail archive of the insight@sources.redhat.com mailing list for the Insight project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [RFA] balloon.tcl


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]