1############################################################################### 2############################################################################### 3## Ayuda.tcl 4############################################################################### 5############################################################################### 6## Includes the procedures needed for the commands in the 'help' menu 7############################################################################### 8############################################################################### 9## (c) 1999-2008 Andr�s Garc�a Garc�a. fandom@telefonica.net 10## You may distribute the contents of this file under the terms of the GPL v2 11############################################################################### 12############################################################################### 13 14namespace eval Ayuda { 15 16set tclLogo [image create photo -file "$dirGetleft(images)/pwrdLogo150.gif"] 17set about [image create photo -file "$dirGetleft(images)/about.gif"] 18set curl [image create photo -file "$dirGetleft(images)/curl.gif"] 19 20############################################################################### 21# Ayuda 22# Show the given topic in the Help file. 23# 24# Parameter: 25# topic: contents, changes, GPL, ... 26############################################################################### 27proc Ayuda {topic} { 28 global dirGetleft 29 30 help::init [file join $dirGetleft(doc) help.help] $topic "" 450 600 31 32 return 33} 34 35############################################################################### 36# About 37# Shows some info about the program. 38############################################################################### 39proc About {} { 40 global dirGetleft 41 global labelButtons labelTitles indexButtons 42 43 if {[winfo exists .acercade]} { 44 raise .acercade . 45 return 46 } 47 48 set coord(x) [winfo rootx .] 49 set coord(y) [winfo rooty .] 50 51 set ven [toplevel .acercade] 52 keynav::enableMnemonics $ven 53 54 wm title $ven $labelTitles(about) 55 wm resizable $ven 0 0 56 wm geometry $ven +[expr {$coord(x)+180}]+[expr {$coord(y)+50}] 57 58 set interno [ttk::frame $ven.interno] 59 set internoLft [ttk::frame $interno.left] 60 set internoCnt [ttk::frame $interno.center] 61 set internoRgt [ttk::frame $interno.right] 62 63 set tclIma [ttk::button $internoLft.tcl -image $Ayuda::tclLogo \ 64 -cursor hand2 -style Toolbutton \ 65 -command "Ayuda::InvokeBrowser http://tcl.activestate.com $ven"] 66 set textIma [ttk::button $internoCnt.texto -image $Ayuda::about \ 67 -cursor hand2 -style Toolbutton \ 68 -command "Ayuda::InvokeBrowser http://personal1.iddeo.es/andresgarci/getleft/english/ $ven"] 69 set curlIma [ttk::button $internoRgt.curl -image $Ayuda::curl \ 70 -cursor hand2 -style Toolbutton \ 71 -command "Ayuda::InvokeBrowser http://curl.haxx.se $ven"] 72 73 set buttonFrame [ttk::frame $ven.buttons] 74 set aceptar [ttk::button $buttonFrame.aceptar -underline $indexButtons(ok) \ 75 -textvariable labelButtons(ok) -command "destroy $ven"] 76 77 pack $interno 78 pack $internoLft $internoCnt $internoRgt -side left 79 pack $tclIma 80 pack $textIma 81 pack $curlIma 82 pack $buttonFrame -fill x 83 pack $aceptar -pady 4 84 85 bind $ven <Escape> "$aceptar invoke" 86 87 focus $aceptar 88 89 return 90} 91 92############################################################################### 93# GuessLinuxBrowser 94# If the user hasn't set a browser yet we will try to guess it by using the 95# BROWSER enviromental variable, if that fails, mozilla-firefoz seems like a 96# safe bet. 97# 98# Returns: 99# The browser to use. 100############################################################################### 101proc GuessLinuxBrowser {} { 102 global env 103 104 if {[info exists env(BROWSER)]} { 105 return $env(BROWSER) 106 } 107 return mozilla-firefox 108} 109 110############################################################################### 111# EnableBrowserEntry 112# Enables or disables the entry to choose a browser. 113# 114# Parameter: 115# entryPath: Just that. 116############################################################################### 117proc EnableBrowserEntry {entryPath} { 118 variable browserTemp 119 global getleftOptions 120 121 if {$browserTemp=="other"} { 122 $entryPath configure -state normal 123 focus $entryPath 124 } else { 125 $entryPath configure -state disabled 126 } 127 return 128} 129 130############################################################################### 131# ChooseLinuxBrowserCommon 132# This procedure takes care of creating the parts of the window that are 133# shared between the proper 'Choose Browser' dialog and the one in the 134# configuration wizard. 135# 136# Parameter: 137# The widget in which it will be put. 138############################################################################### 139proc ChooseLinuxBrowserCommon {parent} { 140 global getleftOptions getleftState labelDialogs labelFrames indexDialogs 141 variable window 142 143 set extFrame [ttk::frame $parent.extFrame] 144 set labelFrame [ttk::labelframe $extFrame.labelFrame -labelanchor nw \ 145 -labelwidget [ttk::label $extFrame.labelFramelb \ 146 -textvariable labelFrames(browser)]] 147 raise $extFrame.labelFramelb 148 149 set galeon [ttk::radiobutton $labelFrame.galeon -underline 0 \ 150 -value "galeon" -text Galeon -variable Ayuda::browserTemp \ 151 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 152 set konqueror [ttk::radiobutton [list $labelFrame.kfmclient openProfile webbrowsing] \ 153 -value [list kfmclient openProfile webbrowsing] -underline 0 \ 154 -text Konqueror -variable Ayuda::browserTemp \ 155 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 156 set mozilla [ttk::radiobutton $labelFrame.mozilla -underline 0 \ 157 -value "mozilla" -text Mozilla -variable Ayuda::browserTemp \ 158 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 159 set netscape [ttk::radiobutton $labelFrame.netscape -underline 0 \ 160 -value "netscape" -text Netscape -variable Ayuda::browserTemp \ 161 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 162 set opera [ttk::radiobutton $labelFrame.opera -underline 3 \ 163 -value "opera" -text Opera -variable Ayuda::browserTemp \ 164 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 165 set firefox [ttk::radiobutton $labelFrame.mozilla-firefox \ 166 -value "mozilla-firefox" -underline 0 \ 167 -text Firefox -variable Ayuda::browserTemp \ 168 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 169 170 set other [ttk::radiobutton $labelFrame.other -underline 1 \ 171 -value "other" \ 172 -textvariable labelDialogs(other) -variable Ayuda::browserTemp \ 173 -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"] 174 175 set browserEntry [ttk::entry $labelFrame.browserEntry -width 20] 176 menuEntry::menuEntry $browserEntry 177 178 set window(browserEntry) $browserEntry 179 180 if {![info exists getleftState(browser)]} { 181 set Ayuda::browserTemp other 182 set getleftState(browser) [GuessLinuxBrowser] 183 } 184 185 if {[catch {$labelFrame.$getleftState(browser) invoke}]} { 186 set browserTemp other 187 $browserEntry delete 0 end 188 $browserEntry insert 0 $getleftState(browser) 189 focus $browserEntry 190 } else { 191 focus $labelFrame.$getleftState(browser) 192 } 193 194 if {$::tcl_version>=8.5} { 195 grid anchor $extFrame c 196 } 197 198 grid $extFrame -ipadx 10 -ipady 5 199 grid $labelFrame -ipadx 30 -ipady 7 -pady 5 -padx 3 200 201 if {$::tcl_version>=8.5} { 202 grid anchor $labelFrame c 203 } 204 205 grid $firefox -sticky w 206 grid $galeon -sticky w 207 grid $konqueror -sticky w 208 grid $mozilla -sticky w 209 grid $netscape -sticky w 210 grid $opera -sticky w 211 grid $other -sticky w 212 grid $browserEntry -sticky w 213 214 return 215} 216 217############################################################################### 218# ChooseLinuxBrowserControl 219# Gets invoked when the user accepts or cancels the dialog to choose the 220# Linux Broswer. 221# 222# Parameters: 223# set: '1' if the user accepted, so we set the browser. 224# parent: Window over which the messages will appear 225# 226# Returns: 227# '0' if all is well, '1' if it isn't. 228############################################################################### 229proc ChooseLinuxBrowserControl {set parent} { 230 global getleftState labelTitles labelMessages 231 variable browserTemp 232 variable window 233 234 if {$set==1} { 235 if {$browserTemp=="other"} { 236 # No paths allowed. 237 set temp [file tail [$window(browserEntry) get]] 238 if {$temp==""} { 239 Dialogos::Dialogo $parent.error -type ok -icon error \ 240 -title $labelTitles(error) \ 241 -message $labelMessages(fillBrowser) 242 return 1 243 } 244 set getleftState(browser) $temp 245 } else { 246 set getleftState(browser) $browserTemp 247 } 248 } 249 catch {destroy .chooseBrowser} 250 251 return 0 252} 253 254############################################################################### 255# ChooseLinuxBrowser 256# Since I don't know how to get the favourite browser automagically, I 257# will have to ask for it. 258# 259# Parameter 260# parent: Window over which the dialog will appear, it defaults to the 261# main window. 262############################################################################### 263proc ChooseLinuxBrowser {{parent .}} { 264 global getleftState labelButtons labelTitles labelMessages indexButtons 265 variable window 266 267 if {$getleftState(os)!="unix"} { 268 Dialogos::Dialogo $parent.error -type ok -icon error \ 269 -title $labelTitles(error) -message $labelMessages(noWin) 270 return 271 } 272 273 set coord(x) [winfo rootx $parent] 274 set coord(y) [winfo rooty $parent] 275 276 set win [toplevel .chooseBrowser] 277 278 wm title $win $labelTitles(chooseBrow) 279 wm resizable $win 0 0 280 wm geometry $win +[expr {$coord(x)+125}]+[expr {$coord(y)+75}] 281 282 set window(toplevel) $win 283 284 ChooseLinuxBrowserCommon $win 285 286 set buttons [ttk::frame $win.extFrame.buttons -class BottonFrame] 287 set accept [ttk::button $buttons.accept -width 8 \ 288 -underline $indexButtons(ok) -textvariable labelButtons(ok) \ 289 -command "Ayuda::ChooseLinuxBrowserControl 1 $win"] 290 set cancel [ttk::button $buttons.cancel -width 8 \ 291 -underline $indexButtons(cancel) -textvariable labelButtons(cancel)\ 292 -command "Ayuda::ChooseLinuxBrowserControl 0 $win"] 293 294 bind $window(browserEntry) <Return> "focus $accept" 295 bind $window(browserEntry) <KP_Enter> "focus $accept" 296 297 grid $buttons -sticky e 298 grid $accept $cancel -padx 2 299 300 return 301} 302 303############################################################################### 304# ChangeHelpCursor 305# For a few seconds after clicking on a http link, the cursor will change 306# to the watch cursor. 307# 308# Parameter 309# Parent: The window for which the cursor will be changed. 310############################################################################### 311proc ChangeHelpCursor {parent} { 312 313 $parent configure -cursor watch 314 after 5000 "catch {$parent configure -cursor arrow}" 315 316 return 317} 318 319############################################################################### 320# InvokeBrowserWindows 321# Invokes the default internet browser in a Windows machine and opens the 322# page passed as a parameter. 323# 324# I got most of this from a Chris Nelson entry at the Tclers' wiki. 325# 326# Parameter: 327# urlToOpen: The url to open after the browser start up. 328# parent: The window over which, if needed, the error message will appear, 329# default to the help window. 330############################################################################### 331proc InvokeBrowserWindows {urlToOpen parent} { 332 global labelTitles labelMessages 333 334 # Look for the application under HKEY_CLASSES_ROOT 335 set root HKEY_CLASSES_ROOT 336 337 # Get the application key for HTML files 338 set appKey [registry get $root\\.html ""] 339 340 # Get the command for opening HTML files 341 set appCmd [registry get $root\\$appKey\\shell\\open\\command ""] 342 343 # Substitute the HTML filename into the command for %1, 344 # IE doesn't seem to use the %1, so we simply append it. 345 if {![regsub {%1} $appCmd "$urlToOpen" appCmd]} { 346 set appCmd [concat $appCmd $urlToOpen] 347 } 348 349 # Double up the backslashes for eval. 350 regsub -all {\\} $appCmd {\\\\} appCmd 351 352 # Invoke the command 353 ChangeHelpCursor $parent 354 if {[catch {eval exec $appCmd &}]} { 355 Dialogos::Dialogo $parent.error -type ok -icon error \ 356 -title $labelTitles(error) -message $labelMessages(cantBrowser). 357 } 358 return 359} 360 361############################################################################### 362# InvokeBrowserLinux 363# Invokes the internet browser given by the user and opens the 364# page passed as a parameter. 365# 366# Parameter: 367# urlToOpen: The url to open after the browser start up. 368# parent: The window over which, if needed, the error message will appear. 369############################################################################### 370proc InvokeBrowserLinux {urlToOpen parent} { 371 global getleftState labelTitles labelMessages 372 373 ChangeHelpCursor $parent 374 375 if {![info exists getleftState(browser)]} { 376 set getleftState(browser) [GuessLinuxBrowser] 377 } 378 379 # I have to be this convoluted because to open Konqueror we have to 380 # use a command with parameters and urls might have spaces. 381 # It means though, that a command with a path that contains spaces 382 # won't work, so no paths. 383 if {[catch {eval "exec $getleftState(browser) [list $urlToOpen] &"}]} { 384 Dialogos::Dialogo $parent.error -type ok -icon error \ 385 -title $labelTitles(error) \ 386 -message "$labelMessages(cantBrowser):\n$getleftState(browser)" 387 } 388 return 389} 390 391############################################################################### 392# InvokeBrowser 393# Invokes the default internet browser depending on the operating system 394# we are in. 395# 396# Parameters: 397# urlToOpen: The url to open after the browser starts up. 398# parent: The window over which, if needed, the error messages will 399# appear, defaults to the help window. 400############################################################################### 401proc InvokeBrowser {urlToOpen {parent .tophelpwindow}} { 402 global getleftState labelMessages 403 404 if {(![regexp {:/} $urlToOpen])&&(![regexp {^/} $urlToOpen])} { 405 set urlToOpen http://$urlToOpen 406 } 407 408 switch -exact -- $getleftState(os) { 409 win { 410 InvokeBrowserWindows $urlToOpen $parent 411 } 412 unix { 413 InvokeBrowserLinux $urlToOpen $parent 414 } 415 mac { 416 exec open $urlToOpen 417 } 418 default { 419 Dialogos::Dialogo $parent.error -type ok -icon error \ 420 -title $labelTitles(error) \ 421 -message $labelMessages(noBrowser) 422 } 423 } 424 return 425} 426 427} 428