File: PrefGeneral.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (197 lines) | stat: -rw-r--r-- 7,043 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
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
#  PrefGeneral.tcl ---
#  
#       This file is part of The Coccinella application. 
#       It implements a prefs dialog. So far very limited.
#      
#  Copyright (c) 2006  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: PrefGeneral.tcl,v 1.10 2007-09-16 12:00:28 matben Exp $
 
package provide PrefGeneral 1.0

namespace eval ::PrefGeneral:: {

    ::hooks::register prefsInitHook          ::PrefGeneral::InitPrefsHook
    ::hooks::register prefsBuildHook         ::PrefGeneral::BuildPrefsHook
    ::hooks::register prefsSaveHook          ::PrefGeneral::SavePrefsHook
    ::hooks::register prefsCancelHook        ::PrefGeneral::CancelPrefsHook
}

proc ::PrefGeneral::InitPrefsHook {} {
    global  prefs
    
    # These are actually never used from the prefs file.
    set prefs(prefsSameDrive) 0
    set prefs(prefsSameDir)   0
}

proc ::PrefGeneral::BuildPrefsHook {wtree nbframe} {
    global  this prefs config
    variable tmpPrefs
    
    # Seems to be duplicated.
    set prefs(prefsSameDir) $this(prefsPathAppDir)
    
    set tmpPrefs(prefsSameDrive) $prefs(prefsSameDrive)
    set tmpPrefs(prefsSameDir)   $prefs(prefsSameDir)
    
    set wpage [$nbframe page {General}]
    set wc $wpage.c
    ttk::frame $wc -padding [option get . notebookPageSmallPadding {}]
    pack $wc -side top -anchor [option get . dialogAnchor {}]
    
    # Settings drive.
    set wd $wc.d
    ttk::frame $wc.d
    ttk::label $wd.l -text [mc "Settings"]
    ttk::separator $wd.s -orient horizontal
    # TRANSLATORS: USB stick feature
    if {$config(prefs,sameDrive)} {
	ttk::checkbutton $wd.c -text [mc "Store preferences on same drive as program"] \
	  -variable [namespace current]::tmpPrefs(prefsSameDrive)
    } elseif {$config(prefs,sameDir)} {
	ttk::checkbutton $wd.c -text [mc "Store preferences in same folder as program"] \
	  -variable [namespace current]::tmpPrefs(prefsSameDir)
    }
    
    grid  $wd.l  $wd.s  -sticky w
    grid  $wd.c  -      -sticky w -pady 1
    grid $wd.s -sticky ew
    grid columnconfigure $wd 1 -weight 1
    
    pack $wd -side top -fill x -anchor w
    
    if {$config(prefs,sameDrive)} {

	# If the app not lives on another drive.
	if { ![::Init::IsAppOnRemovableDrive] } {
	    set prefs(prefsSameDrive) 0
	    $wd.c state {disabled}
	}
	
	# Don't know how to detect removable drives here.
	if { $this(platform) eq "unix" } {
	    set prefs(prefsSameDrive) 0
	    $wd.c state {disabled}
	}
    } elseif {$config(prefs,sameDir)} {

	# Must verify that application folder writable.
	set psplit [file split $this(appPath)]
	if {![file writable [eval file join [lrange $psplit 0 end-1]]]} {
	    set prefs(prefsSameDir) 0
	    $wd.c state {disabled}
	}
    }
        
    # Language.
    set wl $wc.l
    ttk::frame $wc.l -padding {0 6 0 0}
    ttk::label $wl.l -text [mc "Language"]
    ttk::separator $wl.s -orient horizontal
    ttk::label $wl.lr -text [mc "Requires a restart of %s" $prefs(appName)]
    ::Utils::LanguageMenubutton $wl.mb [namespace current]::tmpPrefs(locale)

    grid  $wl.l   $wl.s  -sticky w
    grid  $wl.lr   -      -sticky w -pady 1
    grid  $wl.mb  -      -sticky w
    grid $wl.s -sticky ew    
    grid columnconfigure $wl 1 -weight 1

    pack $wl -side top -fill x -anchor w

    ::balloonhelp::balloonforwindow $wl.mb \
      [mc "Requires a restart of %s" $prefs(appName)]

    bind $wpage <Destroy> {+::PrefGeneral::Free }
}

proc ::PrefGeneral::SavePrefsHook {} {
    global prefs this config
    variable tmpPrefs
    
    if {$config(prefs,sameDrive)} {
	if {$tmpPrefs(prefsSameDrive) && !$prefs(prefsSameDrive)} {
	    set ans [tk_messageBox -icon question -type yesno  \
	      -message [mc "You have chosen to store your preferences on the same drive as the application. If this drive is not a removable device your personal settings could be visible. Do you want to continue?"]]
	    if {$ans eq "yes"} {
		set prefs(prefsSameDrive) 1
		
		# Need to change all paths that depend on this(prefsPath) and make
		# sure dirs are there (removable drive).
		::Init::SetPrefsPathToRemovable
		::hooks::run prefsFilePathChangedHook
	    }
	} elseif {!$tmpPrefs(prefsSameDrive) && $prefs(prefsSameDrive)} {
	    
	    # Remove prefs file so we wont detect it next time we are launched.
	    set prefFile [file join [::Init::GetAppDrivePrefsPath] $this(prefsName)]
	    if {[file exists $prefFile]} {
		set ans [tk_messageBox -icon question -type yesno  \
		  -message [mc "You have chosen to store your preferences in the default location. If you remove or move your personal settings at %s, the preferences in the default location will be used the next time you start %s. Do you want to remove the old preferences?" $prefFile $prefs(appName)]]
		if {$ans eq "yes"} {
		    file delete $prefFile
		}	
	    }
	    ::Init::SetPrefsPathToDefault
	    set prefs(prefsSameDrive) 0
	    ::hooks::run prefsFilePathChangedHook
	}
    } elseif {$config(prefs,sameDir)} {
	if {$tmpPrefs(prefsSameDir) && !$prefs(prefsSameDir)} {
	    set prefs(prefsSameDir) 1
	    set this(prefsPathAppDir) 1
	    
	    # Need to change all paths that depend on this(prefsPath) and make
	    # sure dirs are there.
	    ::Init::SetPrefsPathToAppDir
	    ::hooks::run prefsFilePathChangedHook
	} elseif {!$tmpPrefs(prefsSameDir) && $prefs(prefsSameDir)} {

	    # Remove prefs file so we wont detect it next time we are launched.
	    set prefFile [file join [::Init::GetAppDirPrefsPath] $this(prefsName)]
	    if {[file exists $prefFile]} {
		set ans [tk_messageBox -icon question -type yesno  \
		  -message [mc "You have chosen to store your preferences in the default location. If you remove or move your personal settings at %s, the preferences in the default location will be used the next time you start %s. Do you want to remove the old preferences?" $prefFile $prefs(appName)]]
		if {$ans eq "yes"} {
		    file delete $prefFile
		}	
	    }
	    ::Init::SetPrefsPathToDefault
	    set prefs(prefsSameDir) 0
	    set this(prefsPathAppDir) 0
	    ::hooks::run prefsFilePathChangedHook
	}	
    }
    
    # Load any new message catalog.
    set prefs(messageLocale) $tmpPrefs(locale)
    ::msgcat::mclocale $tmpPrefs(locale)
    ::msgcat::mcload $this(msgcatPath)
}

proc ::PrefGeneral::CancelPrefsHook {} {
    global prefs
    variable tmpPrefs

    # @@@
}

proc ::PrefGeneral::Free {} {
    variable tmpPrefs
    
    unset -nocomplain tmpPrefs
}