/usr/share/tcltk/transcriber/tcl/About.tcl is in transcriber 1.5.1.1-10.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | # RCS: @(#) $Id: About.tcl,v 1.12 2004/11/29 14:52:15 galliano Exp $
# Copyright (C) 1998-2004, DGA - part of the Transcriber program
# distributed under the GNU General Public License (see COPYING file)
#######################################################################
proc ViewHelp {{name "Index"}} {
global v
array set arr {
"Presentation" "present_local.html"
"Main features" "functions.html"
"User guide" "user.html"
"Reference manual" "reference.html"
}
set Lg [string toupper [string index $v(lang) 0]][string range \
$v(lang) 1 end]
set arr(Index) [file join [pwd] $v(path,doc) Index$Lg.html]
set dir [file join [pwd] $v(path,doc) $v(lang)]
if {![file exists $arr(Index)] || ![file exists $dir]} {
set arr(Index) [file join [pwd] $v(path,doc) Index.html]
set dir [file join [pwd] $v(path,doc) "en"]
}
set url [file join $dir $arr($name)]
OpenURL file:$url
}
proc OpenURL { URL } {
#
# Job Open an url with the default browser
# If it doesn't work, it asks the user to define the new default browser
# If you want to open a file, add file: prefix to URL (ex: file:c:\tmp\try.html)
#
# In A valid URL
# Out
# Modify If v(browser) is not set, it is set to the default browser (except on Mac)
#
# Mathieu MANTA - DGA
# V 1.0
# July 27, 2004
#
global v
if {$::tcl_platform(os) == "Darwin"} {
if { $v(browser) == ""} { exec open $URL &}
else { exec $v(browser) $URL &}
}
if {$::tcl_platform(os) == "Linux"} {
if { $v(browser) == ""} {
if { [catch {exec mozilla $URL &}] == 0 } {
set v(browser) mozilla
} elseif { [catch {exec firefox $URL &}] == 0 } {
set v(browser) firefox
} else {
tk_messageBox -type ok -icon error -message [format [Local "Please define your default browser."] ]
set v(browser) [SelectBrowser]
catch { exec $v(browser) $URL &}
}
} else {
catch { exec $v(browser) $URL &}
}
}
if {$::tcl_platform(platform) == "windows"} {
if { $v(browser) == ""} {
set v(browser) [FindWinDefaultBrowser]
}
catch { exec $v(browser) $URL &}
}
}
proc FindWinDefaultBrowser {} {
#
# Job Find Windows default browser in the registry
#
# In
# Out Path to the default browser
# Modify
#
# Mathieu MANTA - DGA
# V 1.0
# July 27, 2004
#
set BrowserKey [registry get HKEY_CLASSES_ROOT\\http\\shell\\open\\command ""]
if { [string equal [string index [string trim $BrowserKey " "] 0] "\""]} {
set BrowserPath [string trimleft $BrowserKey "\""]
set BrowserPath [string range $BrowserPath 0 [expr { [string first "\"" $BrowserPath ]-1}]]
} else {
set BrowserPath [string range $BrowserKey 0 [string first " " $BrowserKey ]]
}
return $BrowserPath
}
proc SelectBrowser {{parent "."}} {
#
# Job Select default browser through selection box
#
# In
# Out Return the path to the file selected
#
# Mathieu MANTA - DGA
# V 1.0
# July 27, 2004
#
global v
set name [tk_getOpenFile -title [Local "Select your default browser"] -initialdir $v(trans,path) -parent $parent]
return $name
}
|