hypertext added

fruho/add_vpnbook.tcl

@@ -13,8 +13,8 @@ namespace eval ::vpnbook {
 
     # input entries - resettable/modifiable variables
     variable newprofilename ""
-    variable username vpnbook
-    variable password ChakU3ub
+    variable username ""
+    variable password ""
 
 }
 
@@ -32,12 +32,13 @@ proc ::vpnbook::create-import-frame {tab} {
     ttk::label $pconf.profilelabel -text "Profile name" -anchor e
     ttk::entry $pconf.profileinput -textvariable ::${name}::newprofilename
     ttk::label $pconf.profileinfo -foreground grey
-    ttk::label $pconf.usernamelabel -text "Username" -anchor e
+    ttk::label $pconf.usernamelabel -text "$dispname username" -anchor e
     ttk::entry $pconf.usernameinput -textvariable ::${name}::username
-    ttk::label $pconf.usernameinfo -foreground grey
+    ttk::label $pconf.usernameinfo -foreground grey -text "e.g. vpnbook"
     ttk::label $pconf.passwordlabel -text "$dispname password" -anchor e
     ttk::entry $pconf.passwordinput -textvariable ::${name}::password
     ttk::label $pconf.passwordinfo -foreground grey
+    hyperlink $pconf.link -command [list launchBrowser "https://www.vpnbook.com/freevpn"] -text "Get free account from vpnbook.com"
     ttk::frame $pconf.importline
     ttk::button $pconf.importline.button -text "Import configuration" -command [list go ::${name}::ImportClicked $tab]
     # must use non-ttk label for proper animated gif display
@@ -59,6 +60,7 @@ proc ::vpnbook::create-import-frame {tab} {
     grid $pconf.passwordlabel -row 7 -column 0 -sticky news -padx 5 -pady 5
     grid $pconf.passwordinput -row 7 -column 1 -sticky news -padx 5 -pady 5
     grid $pconf.passwordinfo -row 7 -column 2 -sticky news -pady 5
+    grid $pconf.link -sticky news -columnspan 3 -pady 10
     grid $pconf.importline -sticky news -columnspan 3
     return $pconf
 }

fruho/main.tcl

@@ -1728,29 +1728,20 @@ proc frame-usage-meter {p} {
 
 proc frame-toolbar {p} {
     set tb [ttk::frame $p.tb -borderwidth 0 -relief raised]
-    #ttk::button $tb.feedback
-    #img place 16/feedback  $tb.feedback 
-    #grid $tb.feedback -column 0 -row 0 -sticky w
-    label $tb.appealimg
-    img place 16/bang $tb.appealimg
-    label $tb.appeal1 -text "Help improve this program. Provide your"
-    hyperlink $tb.appeal2 -command [list launchBrowser "https://fruho.com/geo"] -text "feedback."
-    label $tb.appeal3 -text "We listen."
-
+    hypertext $tb.improve "Help improve this program. Provide your <https://fruho.com/geo><feedback.> We listen."
     button $tb.options -relief flat -command OptionsClicked
     img place 24/options  $tb.options
-    grid $tb.appealimg -column 0 -row 0 -sticky w
-    grid $tb.appeal1 -column 1 -row 0 -sticky w
-    grid $tb.appeal2 -column 2 -row 0 -sticky w
-    grid $tb.appeal3 -column 3 -row 0 -sticky w
-    grid $tb.options -column 4 -row 0 -sticky e
+    label $tb.bang
+    img place 16/bang $tb.bang
+    grid $tb.bang -row 0 -column 0 -sticky w
+    grid $tb.improve -row 0 -column 1 -sticky w
+    grid $tb.options -row 0 -column 2 -sticky e
     grid $tb -padx 5 -sticky news
     grid columnconfigure $tb $tb.options -weight 1
     return $tb
 }
 
 
-
 # create ip info panel in parent p
 proc frame-ipinfo {p} {
     set bg2 $::model::layout_bg2

sklib/skutil.tcl

@@ -771,6 +771,66 @@ proc hyperlink {name args} {
 }
 
 
+# Mixed text with hyperlinks
+# Create a composite frame of plain label text with hyperlinks as a single line
+# usage:
+# hypertext .my.widget.htext "plain text <http://my.url><my link name> other plain text"
+# for <optional my link name> to be treated as link name and not plain text there must be no space between <http://my.url> and <optional...>
+proc hypertext {hw composite} {
+    # first tokenize to "plain text" and "[bracketed]" tokens
+    set tokens [regexp -all -inline {[^<>]+} $composite]
+    # pairs is the list with the following semantics:
+    # {url1 label1 url2 label2 ...}
+    # where url is empty it's the plain text
+    set pairs {}
+    set previous_token ""
+    #puts stderr "TOKENS: $tokens"
+    foreach token $tokens {
+        set isurl [regexp {http.*} $token]
+        set previous_isurl [regexp {http.*} $previous_token]
+        set spacestart [string is space -strict [string index $token 0]]
+        #puts stderr "TOKEN: $token. previous_isurl=$previous_isurl, spacestart=$spacestart"
+        if {$previous_isurl} {
+            # if after the url there is a space starting string we use last url as label
+            if {$spacestart} {
+                lappend pairs $previous_token
+            } else {
+                lappend pairs $token
+            }
+        } else {
+            if {$isurl} {
+                lappend pairs $token
+            } else {
+                lappend pairs ""
+                lappend pairs $token
+            }
+        }
+        set previous_token $token
+    }
+    # in case the composite ends with url append repeating label
+    set previous_isurl [regexp {http.*} $previous_token]
+    if {$previous_isurl} {
+        lappend pairs $previous_token
+    }
+    #puts stderr "PAIRS: $pairs"
+    set count 0
+    frame $hw
+    foreach {url lbl} $pairs {
+        if {$url eq ""} {
+            label $hw.item$count -text $lbl
+        } else {
+            hyperlink $hw.item$count -command [list launchBrowser $url] -text $lbl
+        }
+        grid $hw.item$count -column $count -row 0 -sticky w
+        incr count
+    }
+
+    return $hw
+}
+
+
+
+
 proc launchBrowser {url} {
     try {
         if {$::tcl_platform(platform) eq "windows"} {