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: sessions.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 8/3/2015
00022 # Brief: Namespace for session support.
00023 ######################################################################
00024
00025 namespace eval sessions {
00026
00027 variable user_name ""
00028 variable current_name ""
00029
00030 array set names {}
00031 array set current_content {}
00032
00033 set sessions_dir [file join $::tke_home sessions]
00034
00035 ######################################################################
00036 # Loads the names of all available sessions. This should be called
00037 # before any sessions are loaded.
00038 proc preload {} {
00039
00040 variable names
00041 variable sessions_dir
00042
00043 if {[file exists $sessions_dir]} {
00044 foreach name [glob -nocomplain -directory $sessions_dir -tails *.tkedat] {
00045 set names([file rootname $name]) 1
00046 }
00047 }
00048
00049 }
00050
00051 ######################################################################
00052 # Save the current settings as a given session. The legal values for
00053 # type are the following:
00054 # - last = Save information useful for the next time TKE is started.
00055 # - prefs = Only save preference information to the session file, leaving the rest intact.
00056 # - find = Only save find information to the session file, leaving the rest intact.
00057 # - full = Save all information
00058 proc save {type {name ""}} {
00059
00060 variable user_name
00061 variable names
00062 variable current_name
00063 variable current_content
00064 variable sessions_dir
00065
00066 # If we are being told to save the last session, set the name to the session.tkedat file
00067 if {$type eq "last"} {
00068 set name [file join $::tke_home session]
00069 }
00070
00071 # If the name has not been specified, ask the user for a name
00072 if {$name eq ""} {
00073 if {[gui::get_user_response "Session name:" sessions::user_name]} {
00074 set name $user_name
00075 set names($name) 1
00076 set current_name $name
00077 } else {
00078 return
00079 }
00080 }
00081
00082 # Create the sessions directory if it does not exist
00083 if {![file exists $sessions_dir]} {
00084 file mkdir $sessions_dir
00085 }
00086
00087 # If we are saving preferences only, set the value of content to match
00088 # the currently loaded session.
00089 if {($type eq "prefs") || ($type eq "find")} {
00090
00091 # Get the current content information
00092 array set content [array get current_content]
00093
00094 # Make sure that the content(session) is not set
00095 catch { unset content(session) }
00096
00097 # Update and save the UI state on a full/last save
00098 } else {
00099
00100 # Get the session information from the UI
00101 set content(gui) [gui::save_session]
00102
00103 # Set the session name if we are saving the last
00104 if {$type eq "last"} {
00105 set content(session) $current_name
00106 }
00107
00108 }
00109
00110 # Get the session information from preferences
00111 if {($type eq "prefs") || ($type eq "full")} {
00112 set content(prefs) [preferences::save_session $name]
00113 }
00114
00115 # Get the find information from the UI
00116 if {($type eq "find") || ($type eq "full") || ($type eq "last")} {
00117 set content(find) [search::save_session]
00118 }
00119
00120 # Create the session file path
00121 if {$type eq "last"} {
00122 set session_file $name.tkedat
00123 } else {
00124 set session_file [file join $sessions_dir $name.tkedat]
00125 }
00126
00127 # Write the content to the save file
00128 catch { tkedat::write $session_file [array get content] }
00129
00130 if {$type eq "full"} {
00131
00132 # Save the current name
00133 set current_name $name
00134
00135 # Update the title
00136 gui::set_title
00137
00138 # Indicate to the user that we successfully saved
00139 gui::set_info_message "Session \"$current_name\" saved"
00140
00141 } elseif {$type eq "prefs"} {
00142 gui::set_info_message "Session \"$name\" preferences saved"
00143
00144 }
00145
00146 }
00147
00148 ######################################################################
00149 # Loads the given session. The legal values for type are the following:
00150 # - last = Save information useful for the next time TKE is started.
00151 # - prefs = Only save preference information to the session file, leaving the rest intact.
00152 # - full = Save all information
00153 # - nosave = Only read the given session name without worrying about saving.
00154 # Name specifies the base name of the session to load while 'new'
00155 # specifies whether the session should be loaded in the current window (0)
00156 # or a new window (1).
00157 proc load {type name new} {
00158
00159 variable current_name
00160 variable current_content
00161 variable sessions_dir
00162
00163 # If we need to load the last saved session, set the name appropriately
00164 if {$type eq "last"} {
00165 set name ""
00166 set session_file [file join $::tke_home session.tkedat]
00167 } else {
00168 set session_file [file join $sessions_dir $name.tkedat]
00169 }
00170
00171 # If we need to open
00172 if {$current_name ne ""} {
00173 if {$new} {
00174 array set frame [info frame 0]
00175 exec -ignorestderr [info nameofexecutable] $frame(file) -s $name -n &
00176 return
00177 }
00178 } elseif {($type eq "full") && ![gui::untitled_check]} {
00179 switch [tk_messageBox -parent . -icon question -default yes -type yesnocancel -message [msgcat::mc "Save session?"] -detail [msgcat::mc "Session state will be lost if not saved"]] {
00180 yes { save "full" }
00181 cancel { return }
00182 }
00183 }
00184
00185 # Read the information from the session file
00186 if {[catch { tkedat::read $session_file } rc]} {
00187 gui::set_info_message "Unable to load session \"$name\""
00188 return
00189 }
00190
00191 array set content $rc
00192
00193 # Clear the UI
00194 gui::close_all
00195 sidebar::clear
00196
00197 # Load the GUI session information (provide backward compatibility)
00198 if {[info exists content(gui)]} {
00199 gui::load_session $content(gui) $new
00200 } else {
00201 gui::load_session $rc $new
00202 }
00203
00204 # Load the find session information
00205 if {[info exists content(find)]} {
00206 search::load_session $content(find)
00207 }
00208
00209 # Save the current name (provide backward compatibility)
00210 if {[info exists content(session)] && [file exists [file join $sessions_dir $content(session).tkedat]]} {
00211 set current_name $content(session)
00212 } else {
00213 set current_name $name
00214 }
00215
00216 # Load the preference session information (provide backward compatibility)
00217 if {[info exists content(prefs)]} {
00218 preferences::load_session $name $content(prefs)
00219 } elseif {$current_name ne ""} {
00220 load_prefs $current_name
00221 }
00222
00223 # Save the current content
00224 array set current_content [array get content]
00225
00226 # Update the title
00227 gui::set_title
00228
00229 }
00230
00231 ######################################################################
00232 # Load the preferences information for the given session.
00233 proc load_prefs {name} {
00234
00235 variable sessions_dir
00236
00237 # Get the path of the session file
00238 set session_file [file join $sessions_dir $name.tkedat]
00239
00240 # Read the information from the session file
00241 if {[catch { tkedat::read $session_file } rc]} {
00242 return
00243 }
00244
00245 array set content $rc
00246
00247 # Load the preference session information (provide backward compatibility)
00248 if {[info exists content(prefs)]} {
00249 preferences::load_session $name $content(prefs)
00250 }
00251
00252 }
00253
00254 ######################################################################
00255 # Loads the given session and raises the window.
00256 proc load_and_raise_window {name} {
00257
00258 # Load the session in the current window
00259 after idle [list sessions::load full $name 0]
00260
00261 # Raise the window
00262 gui::raise_window
00263
00264 }
00265
00266 ######################################################################
00267 # Closes the currently opened session.
00268 proc close_current {} {
00269
00270 variable current_name
00271
00272 # Clear the current name
00273 set current_name ""
00274
00275 # Update the window title
00276 gui::set_title
00277
00278 # Load the default preferences
00279 preferences::update_prefs
00280
00281 }
00282
00283 ######################################################################
00284 # Deletes the session with the given name.
00285 proc delete {name} {
00286
00287 variable current_name
00288 variable names
00289 variable sessions_dir
00290
00291 if {[info exists names($name)]} {
00292
00293 # Confirm the deletion
00294 if {[tk_messageBox -icon warning -parent . -default no -type yesnocancel -message "Delete session \"$name\"?"] ne "yes"} {
00295 return
00296 }
00297
00298 # Delete the session file
00299 catch { file delete -force [file join $sessions_dir $name.tkedat] }
00300
00301 # Delete the name from the names list
00302 unset names($name)
00303
00304 }
00305
00306 # If the name matches the current name, clear the current name and update the title
00307 if {$current_name eq $name} {
00308 set current_name ""
00309 gui::set_title
00310 }
00311
00312 }
00313
00314 ######################################################################
00315 # Returns the current session name.
00316 proc current {} {
00317
00318 variable current_name
00319
00320 return $current_name
00321
00322 }
00323
00324 ######################################################################
00325 # Returns the list of session names.
00326 proc get_names {} {
00327
00328 variable names
00329
00330 return [lsort [array names names]]
00331
00332 }
00333
00334 ######################################################################
00335 # Returns the list of files in the TKE home directory to copy.
00336 proc get_share_items {dir} {
00337
00338 return [list sessions]
00339
00340 }
00341
00342 ######################################################################
00343 # Called whenever the share directory changes.
00344 proc share_changed {dir} {
00345
00346 variable sessions_dir
00347
00348 set sessions_dir [file join $dir sessions]
00349
00350 }
00351
00352 }
