File: default.tcl

package info (click to toggle)
tkabber 1.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster, jessie, jessie-kfreebsd, sid, stretch
  • size: 6,492 kB
  • ctags: 2,836
  • sloc: tcl: 57,858; xml: 3,668; sh: 1,457; makefile: 78
file content (129 lines) | stat: -rw-r--r-- 3,876 bytes parent folder | download
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
118
119
120
121
122
123
124
125
126
127
128
129
# $Id: default.tcl 2018 2013-09-15 15:12:55Z sergei $

if {$tcl_platform(platform) == "windows"} {
    package require dde
}

proc postload {} {}

proc menuload {menudesc} { return $menudesc }

proc finload  {} {}

proc browser_loadopt {} {
    custom::defvar webbrowser "" \
	[::msgcat::mc "Command to be run when you click a URL\
in a message.  '%s' will be replaced with this URL (e.g. \"galeon -n %s\")."]\
	-group IFace -type string
}
hook::add postload_hook browser_loadopt


proc browseurl {url} {
    global env tcl_platform

    set_status $url
    update idletask

    set url [string map {\u0009 %09 \u000a %0a \u000d %0d \u0020 %20
			 \" %22 \' %27 \< %3c \> %3e
			 \{ %7b \| %7c \} %7d \\ %5c} $url]

    debugmsg browseurl "Mapped URL: '$url'"

    if {[info exists ::webbrowser] && $::webbrowser != ""} {
	# If user specified a browser, use it

        set url [string map {; \\;} $url]
	eval exec [format $::webbrowser $url] &
	return
    }

    # Set the clipboard value to this url in-case the user needs to paste the 
    # url in (some windows systems).

    clipboard clear
    clipboard append $url

    switch -- $tcl_platform(platform) {
        windows {
            # DDE uses commas to separate command parts

            set url [string map {, %2c} $url]

            # See if we can use dde and an existing browser.

            set handled 0
            foreach app {Opera Firefox {Mozilla Firebird} Mozilla Netscape IExplore} {
                if {[dde services $app WWW_OpenURL] != {}} {
                    if {[catch {dde request $app WWW_OpenURL $url,} msg]} {
                        debugmsg browseurl "dde request $app failed: \"$msg\""
                    } else {
                        set handled 1
                        break
                    }
                }
	    }

	    # The windows NT shell treats '&' as a special character. Using
	    # a '^' will escape it. See http://wiki.tcl.tk/557 for more info. 

            if {! $handled} {
                if {[string compare $tcl_platform(os) "Windows NT"] == 0} { 
                    set url [string map {& ^&} $url]
                }
                if {[catch {eval exec [auto_execok start] [list $url] &} emsg]} {
                    MessageDlg .browse_err -aspect 50000 -icon info \
			-buttons ok -default 0 -cancel 0 -type user \
                        -message \
			    [format \
				 [::msgcat::mc "Error displaying %s in browser\n\n%s"] \
				 $url $emsg]
                }
            }
        }

        macintosh {
            if {![info exists env(BROWSER)]} {
                set env(BROWSER) "Browse the Internet"
                AppleScript execute \
                "tell application \"env(BROWSER)\"\nopen url \"$url\"\nend tell\n"
            }
        }

        default {
            if {![info exists env(BROWSER)]} {
                foreach b [list firefox galeon konqueror mozilla-firefox \
                               mozilla-firebird mozilla netscape \
                               iexplorer opera] {
                    if {[llength [set e [auto_execok $b]]] > 0} {
                        set env(BROWSER) [lindex $e 0]
                        break
                    }
                }
                if {![info exists env(BROWSER)]} {
		    if {[string equal $tcl_platform(os) Darwin]} {
			exec open $url &
			set_status ""
			return
		    }
                    MessageDlg .browse_err -aspect 50000 -icon info \
                        -message [::msgcat::mc "Please define environment variable BROWSER"] \
			-type user \
			-buttons ok -default 0 -cancel 0
                    return
                }
            }

            if {[catch { exec $env(BROWSER) -remote openURL($url,new-tab) }]} {
		if {[catch { exec $env(BROWSER) -remote $url }]} {
		    exec $env(BROWSER) $url &
		}
	    }
	}
    }

    set_status ""
}