session_management.tcl 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. # this file implements machine session management
  2. namespace eval session_management {
  3. set_help_text save_session \
  4. {save_session [<name>]
  5. Saves the state of all your currently running machines as a session with the
  6. given name.
  7. Any existing session with that name will be silently overwritten.
  8. See also 'load_session', 'list_sessions' and 'delete_session'.
  9. }
  10. set_help_text load_session \
  11. {load_session <name>
  12. Restores the state of all machines of the session with the given name and
  13. reactivates the machine that was active at save time. Note: all machines
  14. already running will be silently destroyed! (Unless no single machine succeeded
  15. to be restored.)
  16. See also 'save_session', 'list_sessions' and 'delete_session'.
  17. }
  18. set_help_text list_sessions \
  19. {list_sessions
  20. Returns the names of all previously saved sessions.
  21. See also 'save_session', 'load_session' and 'delete_session'.
  22. }
  23. set_help_text delete_session \
  24. {delete_session <name>
  25. Delete a previously saved session.
  26. See also 'save_session', 'load_session' and 'list_sessions'.
  27. }
  28. user_setting create boolean enable_session_management "Whether to save your session at exit and restore it again at start up." false
  29. proc tabcompletion {args} {
  30. return [list_sessions]
  31. }
  32. set_tabcompletion_proc load_session [namespace code tabcompletion]
  33. set_tabcompletion_proc save_session [namespace code tabcompletion]
  34. set_tabcompletion_proc delete_session [namespace code tabcompletion]
  35. proc delete_session {name} {
  36. set directory [file normalize $::env(OPENMSX_USER_DATA)/../sessions/${name}]
  37. # remove old session under this name
  38. file delete -force -- $directory
  39. }
  40. proc list_sessions {} {
  41. set directory [file normalize $::env(OPENMSX_USER_DATA)/../sessions]
  42. return [lsort [glob -tails -directory $directory -type d -nocomplain *]]
  43. }
  44. proc get_machine_representation {machine_id} {
  45. return "[utils::get_machine_display_name $machine_id] @ [utils::get_machine_time $machine_id]"
  46. }
  47. proc save_session {{name "untitled"}} {
  48. if {[llength [list_machines]] == 0} {
  49. return "Nothing to save..."
  50. }
  51. set result ""
  52. set directory [file normalize $::env(OPENMSX_USER_DATA)/../sessions/${name}]
  53. # remove old session under this name
  54. delete_session $name
  55. file mkdir $directory
  56. # save using ID as file names
  57. foreach machine [list_machines] {
  58. append result "Saving machine $machine ([get_machine_representation $machine])...\n"
  59. store_machine $machine [file join $directory ${machine}.oms]
  60. }
  61. # save in a separate file the currently active machine
  62. set fileId [open [file join $directory active_machine] "w"]
  63. puts $fileId [format "%s.oms" [machine]]
  64. close $fileId
  65. append result "Session saved as $name\n"
  66. return $result
  67. }
  68. proc load_session {name} {
  69. set result ""
  70. # get all savestate files
  71. set directory [file normalize $::env(OPENMSX_USER_DATA)/../sessions/${name}]
  72. set states_to_restore [glob -tails -directory $directory -nocomplain *.oms *.xml.gz]
  73. # abort if we have nothing to restore
  74. if {[llength $states_to_restore] == 0} {
  75. error "Nothing found to restore..."
  76. }
  77. # sort them in order of ID, to guarantee consistent order as saved
  78. set states_to_restore [lsort -dictionary $states_to_restore]
  79. # save the machines we start with
  80. set orginal_machines [list_machines]
  81. # try to load file with active machine
  82. set active_machine ""
  83. catch {
  84. set fp [open [file join $directory active_machine] "r"]
  85. set active_machine [read -nonewline $fp]
  86. close $fp
  87. }
  88. # restore all saved machines
  89. set first true
  90. foreach state $states_to_restore {
  91. set fullname [file join $directory $state]
  92. if {[catch { ;# skip machines failing to restore
  93. set newID [restore_machine $fullname]
  94. append result "Restored $state as $newID ([get_machine_representation $newID])...\n"
  95. # activate saved active machine or alternatively, first machine
  96. if {(($active_machine ne "") && ($state eq $active_machine)) || \
  97. (($active_machine eq "") && $first)} {
  98. activate_machine $newID
  99. }
  100. set first false
  101. } error_result]} {
  102. append result "Skipping $state: $error_result\n"
  103. }
  104. }
  105. # if restoring at least one machine succeeded, delete all original machines
  106. if {[llength [list_machines]] > [llength $orginal_machines]} {
  107. foreach machine $orginal_machines {
  108. delete_machine $machine
  109. }
  110. } else {
  111. append result "Couldn't restore a single machine, aborting...\n"
  112. }
  113. # if the active machine failed to load, activate the first machine (if available):
  114. if {[activate_machine] eq "" && [llength [list_machines]] > 0} {
  115. activate_machine [lindex [list_machines] 0]
  116. }
  117. return $result
  118. }
  119. variable after_quit_id
  120. # do actual session management
  121. if {$::enable_session_management} {
  122. # need after realtime command here, because openMSX needs to have started up first
  123. after realtime 0 {load_session "default_session"}
  124. set after_quit_id [after quit {save_session "default_session"}]
  125. }
  126. proc setting_changed {name1 name2 op} {
  127. variable after_quit_id
  128. if {$::enable_session_management} {;# setting changed from disabled to enabled
  129. set after_quit_id [after quit {save_session "default_session"}]
  130. } else { ;# setting changed from enabled to disabled
  131. after cancel $after_quit_id
  132. }
  133. }
  134. trace add variable ::enable_session_management "write" [namespace code setting_changed]
  135. namespace export save_session
  136. namespace export load_session
  137. namespace export list_sessions
  138. namespace export delete_session
  139. } ;# namespace session_management
  140. namespace import session_management::*