File: MailtoURI.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (67 lines) | stat: -rw-r--r-- 1,917 bytes parent folder | download | duplicates (4)
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
# MailtoURI.tcl --
# 
#       Parses any in-text mailto: URIs.
#
#  Copyright (c) 2007 Mats Bengtsson
#  
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#       
# $Id: MailtoURI.tcl,v 1.9 2007-11-17 07:40:52 matben Exp $

package require uri
package require uriencode

namespace eval ::MailtoURI {

    component::define MailtoURI "Parses in-text mailto: URIs"
}

proc ::MailtoURI::Init {} {

    # Perhaps we shal simplify this to: {^mailto:.+}
    variable mailtoRE $::uri::mailto::url
    
    ::Text::RegisterURI $mailtoRE ::MailtoURI::TextCmd
    component::register MailtoURI
}

proc ::MailtoURI::TextCmd {uri} {
    global  this prefs
    
    if {$prefs(mailClient) eq "gmail"} {

	# http://gentoo-wiki.com/HOWTO_Open_mailto:_links_in_gmail
	# http://www.howtogeek.com/howto/ubuntu/set-gmail-as-default-mail-client-in-ubuntu/#comment-16706
	set base "https://mail.google.com/mail/?view=cm&tf=0&to="
	regsub {^mailto:([^&?]+)[&?]?(.*)$} $uri {\1\&\2} guri
	regsub {subject=} $guri {su=} guri
	set gmailuri $base$guri
	
	::Utils::OpenURLInBrowser $gmailuri
    } else {
	switch -- $this(platform) {
	    macosx {
		exec open $uri
	    }
	    unix {
		# Special.
		set mail [::Utils::UnixGetEmailClient]
		catch {exec $mail $uri &}
	    }
	    windows {
		::Windows::OpenURI $uri
	    }
	}
    }
}