git-gui: fix display of path in browser title
[git/dscho.git] / lib / shortcut.tcl
blob78878ef89d11210d614fc8b3d2957705611bdaa3
1 # git-gui desktop icon creators
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 proc do_windows_shortcut {} {
5 global _gitworktree
6 set fn [tk_getSaveFile \
7 -parent . \
8 -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \
9 -initialfile "Git [reponame].lnk"]
10 if {$fn != {}} {
11 if {[file extension $fn] ne {.lnk}} {
12 set fn ${fn}.lnk
14 if {[catch {
15 win32_create_lnk $fn [list \
16 [info nameofexecutable] \
17 [file normalize $::argv0] \
18 ] \
19 [file normalize $_gitworktree]
20 } err]} {
21 error_popup [strcat [mc "Cannot write shortcut:"] "\n\n$err"]
26 proc do_cygwin_shortcut {} {
27 global argv0 _gitworktree
29 if {[catch {
30 set desktop [exec cygpath \
31 --windows \
32 --absolute \
33 --long-name \
34 --desktop]
35 }]} {
36 set desktop .
38 set fn [tk_getSaveFile \
39 -parent . \
40 -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \
41 -initialdir $desktop \
42 -initialfile "Git [reponame].lnk"]
43 if {$fn != {}} {
44 if {[file extension $fn] ne {.lnk}} {
45 set fn ${fn}.lnk
47 if {[catch {
48 set sh [exec cygpath \
49 --windows \
50 --absolute \
51 /bin/sh.exe]
52 set me [exec cygpath \
53 --unix \
54 --absolute \
55 $argv0]
56 win32_create_lnk $fn [list \
57 $sh -c \
58 "CHERE_INVOKING=1 source /etc/profile;[sq $me] &" \
59 ] \
60 [file normalize $_gitworktree]
61 } err]} {
62 error_popup [strcat [mc "Cannot write shortcut:"] "\n\n$err"]
67 proc do_macosx_app {} {
68 global argv0 env
70 set fn [tk_getSaveFile \
71 -parent . \
72 -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \
73 -initialdir [file join $env(HOME) Desktop] \
74 -initialfile "Git [reponame].app"]
75 if {$fn != {}} {
76 if {[file extension $fn] ne {.app}} {
77 set fn ${fn}.app
79 if {[catch {
80 set Contents [file join $fn Contents]
81 set MacOS [file join $Contents MacOS]
82 set exe [file join $MacOS git-gui]
84 file mkdir $MacOS
86 set fd [open [file join $Contents Info.plist] w]
87 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
88 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
89 <plist version="1.0">
90 <dict>
91 <key>CFBundleDevelopmentRegion</key>
92 <string>English</string>
93 <key>CFBundleExecutable</key>
94 <string>git-gui</string>
95 <key>CFBundleIdentifier</key>
96 <string>org.spearce.git-gui</string>
97 <key>CFBundleInfoDictionaryVersion</key>
98 <string>6.0</string>
99 <key>CFBundlePackageType</key>
100 <string>APPL</string>
101 <key>CFBundleSignature</key>
102 <string>????</string>
103 <key>CFBundleVersion</key>
104 <string>1.0</string>
105 <key>NSPrincipalClass</key>
106 <string>NSApplication</string>
107 </dict>
108 </plist>}
109 close $fd
111 set fd [open $exe w]
112 puts $fd "#!/bin/sh"
113 foreach name [lsort [array names env]] {
114 set value $env($name)
115 switch -- $name {
116 GIT_DIR { set value [file normalize [gitdir]] }
119 switch -glob -- $name {
120 SSH_* -
121 GIT_* {
122 puts $fd "if test \"z\$$name\" = z; then"
123 puts $fd " export $name=[sq $value]"
124 puts $fd "fi &&"
128 puts $fd "export PATH=[sq [file dirname $::_git]]:\$PATH &&"
129 puts $fd "cd [sq [file normalize [pwd]]] &&"
130 puts $fd "exec \\"
131 puts $fd " [sq [info nameofexecutable]] \\"
132 puts $fd " [sq [file normalize $argv0]]"
133 close $fd
135 file attributes $exe -permissions u+x,g+x,o+x
136 } err]} {
137 error_popup [strcat [mc "Cannot write icon:"] "\n\n$err"]