Permalink
Browse files

hypertext added

  • Loading branch information...
hypatia2 committed Nov 4, 2015
1 parent e211722 commit ed06c5dafa760942844736556c080758ffed27b8
Showing with 72 additions and 19 deletions.
  1. +6 −4 fruho/add_vpnbook.tcl
  2. +6 −15 fruho/main.tcl
  3. +60 −0 sklib/skutil.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
}
@@ -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
@@ -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"} {

0 comments on commit ed06c5d

Please sign in to comment.