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 }