00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: preferences.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 5/13/2013
00022 # Brief: Namespace for handling preferences
00023 ######################################################################
00024
00025 namespace eval preferences {
00026
00027 variable base_preference_file [file join $::tke_dir data preferences.tkedat]
00028
00029 array set loaded_prefs {}
00030 array set prefs {}
00031 array set base_prefs {}
00032 array set base_comments {}
00033
00034 set preferences_dir $::tke_home
00035
00036 ######################################################################
00037 # Returns the preference item for the given name.
00038 proc get {name {dflt ""}} {
00039
00040 variable prefs
00041
00042 if {[info exists prefs($name)]} {
00043 return $prefs($name)
00044 }
00045
00046 return $dflt
00047
00048 }
00049
00050 ######################################################################
00051 # Returns a reference to the preference variable associated with
00052 # the given name.
00053 proc ref {{name ""}} {
00054
00055 if {$name eq ""} {
00056 return "preferences::prefs"
00057 } else {
00058 return "preferences::prefs($name)"
00059 }
00060
00061 }
00062
00063 ######################################################################
00064 # Returns the pathname of the given user preference file.
00065 proc get_user_preference_file {} {
00066
00067 variable preferences_dir
00068
00069 return [file join $preferences_dir preferences.tkedat]
00070
00071 }
00072
00073 ######################################################################
00074 # Returns true if the given session/language preferences currently exist.
00075 proc language_exists {session language} {
00076
00077 variable loaded_prefs
00078
00079 if {$session eq ""} {
00080 return [info exists loaded_prefs(user,$language)]
00081 } else {
00082 return [info exists loaded_prefs(session,$session,$language)]
00083 }
00084
00085 }
00086
00087 ######################################################################
00088 # Returns the loaded preference values for the given session name and
00089 # language.
00090 proc get_loaded {{session ""} {language ""}} {
00091
00092 variable loaded_prefs
00093
00094 # If the session has not been previously loaded, attempt to do it now
00095 if {($session ne "") && ![info exists loaded_prefs(session,$session,global)]} {
00096 sessions::load_prefs $session
00097 }
00098
00099 # Figure out key prefix
00100 if {($session eq "") || ![info exists loaded_prefs(session,$session,global)]} {
00101 set prefix "user"
00102 } else {
00103 set prefix "session,$session"
00104 array set lprefs $loaded_prefs(user,global)
00105 }
00106
00107 array set lprefs $loaded_prefs($prefix,global)
00108
00109 if {($language ne "") && [info exists loaded_prefs($prefix,$language)]} {
00110 array set lprefs $loaded_prefs($prefix,$language)
00111 }
00112
00113 return [array get lprefs]
00114
00115 }
00116
00117 ######################################################################
00118 # Called whenever the current text is changed. Reloads the preferences
00119 # based on the given set of preferences.
00120 proc update_prefs {{session ""}} {
00121
00122 variable loaded_prefs
00123 variable prefs
00124
00125 # Calculate the preference prefix
00126 if {($session ne "") && [info exists loaded_prefs(session,$session,global)]} {
00127 set prefix "session,$session"
00128 } else {
00129 set prefix "user"
00130 }
00131
00132 array set temp_prefs $loaded_prefs($prefix,global)
00133
00134 # Load language-specific preferences, if necessary
00135 if {([set txt [gui::current_txt]] ne "") && \
00136 ([set language [syntax::get_language $txt]] ne [msgcat::mc "None"]) && \
00137 [info exists loaded_prefs($prefix,$language)]} {
00138 array set temp_prefs $loaded_prefs($prefix,$language)
00139 }
00140
00141 # Remove any preferences that have not changed value
00142 foreach {name value} [array get temp_prefs] {
00143 if {[info exists prefs($name)] && ($prefs($name) eq $temp_prefs($name))} {
00144 unset temp_prefs($name)
00145 }
00146 }
00147
00148 # Set the preferences
00149 array set prefs [array get temp_prefs]
00150
00151 }
00152
00153 ######################################################################
00154 # Loads the base preferences information, sorting out the comments from
00155 # the preferences information and storing this information in the
00156 # namespace base_prefs and base_comments arrays.
00157 proc load_base_prefs {} {
00158
00159 variable base_preference_file
00160 variable base_prefs
00161 variable base_comments
00162
00163 # Only load the base preferences information if we have previously done so
00164 if {[array size base_prefs] == 0} {
00165
00166 # Read the base preferences file (sort out comments from preferences)
00167 if {![catch { tkedat::read $base_preference_file } rc]} {
00168 foreach {key value} $rc {
00169 if {[lassign [split $key ,] opt] eq "comment"} {
00170 set base_comments($opt) $value
00171 } else {
00172 set base_prefs($opt) $value
00173 }
00174 }
00175 }
00176
00177 }
00178
00179 }
00180
00181 ######################################################################
00182 # Loads the preferences file
00183 proc load {} {
00184
00185 # Load the preferences file contents
00186 load_file
00187
00188 }
00189
00190 ######################################################################
00191 # Save the preference array to the preferences file.
00192 proc save_prefs {session language data} {
00193
00194 variable loaded_prefs
00195 variable prefs
00196 variable preferences_dir
00197
00198 if {$session eq ""} {
00199
00200 # Get the filename to write and update the appropriate loaded_prefs array
00201 if {$language eq ""} {
00202 if {[info exists loaded_prefs(user,global)]} {
00203 array set content $loaded_prefs(user,global)
00204 }
00205 array set content $data
00206 set loaded_prefs(user,global) [array get content]
00207 tkedat::write [get_user_preference_file] $loaded_prefs(user,global) 0
00208 } else {
00209 if {[info exists loaded_prefs(user,$language)]} {
00210 array set content $loaded_prefs(user,$language)
00211 }
00212 array set content $data
00213 set loaded_prefs(user,$language) [array get content Editor
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480