From 503f080db1e4e0c0e5a067049fcc070e69064bb1 Mon Sep 17 00:00:00 2001
From: Stefan Frederik <stefan.schippers@gmail.com>
Date: Mon, 5 Sep 2022 18:06:57 +0200
Subject: [PATCH] balloon tooltip procedure made more general. Easy to reuse
 for any widget

---
 src/xschem.tcl | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/src/xschem.tcl b/src/xschem.tcl
index 1a64b313..3685bc04 100644
--- a/src/xschem.tcl
+++ b/src/xschem.tcl
@@ -4090,12 +4090,15 @@ proc get_file_path {ff} {
 #
 # Balloon help system, from https://wiki.tcl-lang.org/page/balloon+help
 #
-proc balloon {w help} {
-    bind $w <Any-Enter> "after 1000 [list balloon_show %W [list $help]]"
+proc balloon {w help {pos 1}} {
+    bind $w <Any-Enter> "after 1000 [list balloon_show %W [list $help] $pos]"
     bind $w <Any-Leave> "destroy %W.balloon"
 }
 
-proc balloon_show {w arg} {
+### pos: 
+## 0: set balloon close to mouse
+## 1: set balloon below related widget
+proc balloon_show {w arg pos} {
     if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
     set top $w.balloon
     catch {destroy $top}
@@ -4106,8 +4109,13 @@ proc balloon_show {w arg} {
     }   
     pack [message $top.txt -aspect 10000 -bg lightyellow \
         -font fixed -text $arg]
-    set wmx [winfo rootx $w]
-    set wmy [expr {[winfo rooty $w]+[winfo height $w]}]
+    if { $pos } {
+      set wmx [winfo rootx $w]
+      set wmy [expr {[winfo rooty $w]+[winfo height $w]}]
+    } else {
+      set wmx [expr [winfo pointerx $w] + 20]
+      set wmy [winfo pointery $w]
+    }
     wm geometry $top [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
     raise $top
 }