Scid  4.6.5
file.tcl
Go to the documentation of this file.
1 # ::file::Exit
2 #
3 # Prompt for confirmation then exit.
4 #
5 proc ::file::Exit {} {
6  # Check for altered game in all bases except the clipbase:
7  set unsavedCount 0
8  set savedBase [sc_base current]
9  set msg ""
10  foreach i [sc_base list] {
11  sc_base switch $i
12  if {[sc_game altered] && ![sc_base isReadOnly $i]} {
13  if {$unsavedCount == 0} {
14  append msg $::tr(ExitUnsaved)
15  append msg "\n\n"
16  }
17  incr unsavedCount
18  set fname [file tail [sc_base filename $i]]
19  set g [sc_game number]
20  append msg " Base $i: $fname "
21  append msg "($::tr(game) $g)"
22  append msg "\n"
23  }
24  }
25  # Switch back to original database:
26  sc_base switch $savedBase
27 
28  # Check if a mask is opened and dirty
30 
31  if {$msg != ""} {
32  append msg "\n"
33  }
34  append msg $::tr(ExitDialog)
35 
36  # Only ask before exiting if there are unsaved changes:
37  if {$unsavedCount > 0} {
38  set answer [tk_messageBox -title "Scid: [tr FileExit]" \
39  -message $msg -type yesno -icon question]
40  if {$answer != "yes"} { return}
41  }
42  if {$::optionsAutoSave} {
44  }
47  destroy .
48 }
49 
50 
51 # ::file::New
52 #
53 # Opens file-save dialog and creates a new database.
54 #
55 proc ::file::New {} {
56  set ftype {
57  { "Scid databases" {".si4"} }
58  }
59 
60  set fName [tk_getSaveFile \
61  -initialdir $::initialDir(base) \
62  -filetypes $ftype \
63  -defaultextension ".si4" \
64  -title "Create a Scid database"]
65 
66  if {$fName == ""} { return}
67  if {[file extension $fName] == ".si4"} {
68  set fName [file rootname $fName]
69  }
70  if {[catch {sc_base create $fName} baseId]} {
71  ERROR::MessageBox "$fName\n"
72  return
73  }
74  set ::curr_db $baseId
75  set ::initialDir(base) [file dirname $fName]
76  ::recentFiles::add "$fName.si4"
79 }
80 
81 # ::file::Open
82 #
83 # Opens file-open dialog and opens the selected Scid database.
84 #
85 proc ::file::Open {{fName ""}} {
86  set err [::file::Open_ "$fName"]
87  if {$err == 0} {
88  set ::curr_db $::file::lastOpened
89  ::windows::gamelist::Open $::curr_db
91  set g [sc_base extra $::curr_db autoload]
92  if {$g != 0} { ::game::Load $g 0}
94  }
95  return $err
96 }
97 
98 proc ::file::openBaseAsTree { { fName "" } } {
99  set current [sc_base current]
100  set err [::file::Open_ "$fName"]
101  sc_base switch $current
103  if {$err == 0} { ::tree::make $::file::lastOpened 1}
104  return $err
105 }
106 
107 proc ::file::Open_ {{fName ""} } {
108  if {$fName == ""} {
109  if {[sc_info gzip]} {
110  set ftype {
111  { "All Scid files" {".si4" ".si3" ".pgn" ".pgn.gz" ".epd" ".epd.gz"} }
112  { "Scid databases, PGN files" {".si4" ".si3" ".pgn" ".PGN" ".pgn.gz"} }
113  { "Scid databases" {".si4" ".si3"} }
114  { "PGN files" {".pgn" ".PGN" ".pgn.gz"} }
115  { "EPD files" {".epd" ".EPD" ".epd.gz"} }
116  }
117  } else {
118  set ftype {
119  { "All Scid files" {".si4" ".si3" ".pgn" ".epd"} }
120  { "Scid databases, PGN files" {".si4" ".si3" ".pgn" ".PGN"} }
121  { "Scid databases" {".si4" ".si3"} }
122  { "PGN files" {".pgn" ".PGN"} }
123  { "EPD files" {".epd" ".EPD"} }
124  }
125  }
126 
127  set fName [tk_getOpenFile -initialdir $::initialDir(base) -filetypes $ftype -title "Open a Scid file"]
128  if {$fName == ""} { return 2}
129  }
130 
131  set ext [string tolower [file extension "$fName"]]
132  if {"$ext" == ".si4"} { set fName [file rootname "$fName"]}
133  if {[sc_base slot $fName] != 0} {
134  tk_messageBox -title "Scid: opening file" -message "The database you selected is already opened."
135  return 1
136  }
137 
138  set err 0
139  if {"$ext" == ".si3"} {
140  set err [::file::Upgrade [file rootname "$fName"]]
141  } elseif {"$ext" == ".pgn"} {
142  # PGN file:
143  progressWindow "Scid" "$::tr(OpeningTheDatabase): $fName..." $::tr(Cancel)
144  set err [catch {sc_base open PGN "$fName"} ::file::lastOpened]
146  if {$err} {
147  ERROR::MessageBox "$fName\n"
148  } else {
149  sc_base extra $::file::lastOpened type 3
150  set ::initialDir(base) [file dirname "$fName"]
151  ::recentFiles::add "$fName"
152  }
153  } elseif {"$ext" == ".epd" || "$ext" == ".gz"} {
154  # PNG.gz or EPD file:
155  set err [catch {sc_base create MEMORY "$fName"} ::file::lastOpened]
156  if {$err} {
157  ERROR::MessageBox "$fName\n"
158  } else {
159  importPgnFile $::file::lastOpened [list "$fName"]
160  sc_base extra $::file::lastOpened type 3
161  set ::initialDir(base) [file dirname "$fName"]
162  ::recentFiles::add "$fName"
163  }
164  } elseif {"$ext" eq ".si4" || "$ext" eq ""} {
165  progressWindow "Scid" "$::tr(OpeningTheDatabase): [file tail "$fName"]..."
166  set err [catch {sc_base open "$fName"} ::file::lastOpened]
168  if {$err} {
169  if { $::errorCode == $::ERROR::NameDataLoss } { set err 0}
170  ERROR::MessageBox "$fName.si4\n"
171  } else {
172  set ::initialDir(base) [file dirname "$fName"]
173  ::recentFiles::add "$fName.si4"
174  }
175  } else {
176  tk_messageBox -title "Scid: opening file" -message "Unsupported database format: $ext"
177  set err 1
178  }
179 
180  return $err
181 }
182 
183 # ::file::Upgrade
184 #
185 # Upgrades an old (version 3) Scid database to version 4.
186 #
187 proc ::file::Upgrade {name} {
188  if {[file readable "$name.si4"]} {
189  set msg [string trim $::tr(ConfirmOpenNew)]
190  set res [tk_messageBox -title "Scid" -type yesno -icon info -message $msg]
191  if {$res == "no"} { return}
192  return [::file::Open_ "$name.si4"]
193  }
194 
195  set msg [string trim $::tr(ConfirmUpgrade)]
196  set res [tk_messageBox -title "Scid" -type yesno -icon info -message $msg]
197  if {$res == "no"} { return}
198 
199  set err [catch {
200  file copy "$name.sg3" "$name.sg4"
201  file copy "$name.sn3" "$name.sn4"
202  file copy "$name.si3" "$name.si4"}]
203  if {$err} {
204  ERROR::MessageBox "$name\n"
205  return 1
206  }
207 
208  progressWindow "Scid" "$::tr(Opening): [file tail $name]..." $::tr(Cancel)
209  set err [catch {sc_base open $name} ::file::lastOpened]
211  if {$::errorCode == $::ERROR::NameDataLoss} {
212  ERROR::MessageBox "$name\n"
213  set err 0
214  }
215  if {$err} {
216  ERROR::MessageBox "$name\n"
217  catch {
218  file delete "$name.sg4"
219  file delete "$name.sn4"
220  file delete "$name.si4"}]
221  } else {
222  progressWindow "Scid" [concat $::tr(CompactDatabase) "..."] $::tr(Cancel)
223  set err_compact [catch {sc_base compact $::file::lastOpened}]
225  if {$err_compact} { ERROR::MessageBox}
226  }
227  return $err
228 }
229 
230 # ::file::Close:
231 # Closes the active base.
232 #
233 proc ::file::Close {{base -1}} {
234  # Remember the current base:
235  set current [sc_base current]
236  if {$base < 0} { set base $current}
237  if {![sc_base inUse $base]} { return}
238  # Switch to the base which will be closed, and check for changes:
239  sc_base switch $base
240  set confirm [::game::ConfirmDiscard]
241  if {$confirm == 0} {
242  sc_base switch $current
243  return
244  }
245  # Close Tree window whenever a base is closed/switched:
246  if {[winfo exists .treeWin$base]} { destroy .treeWin$base}
247 
248  # If base to close was the current one, reset to clipbase
249  if { $current == $base } { set current 9}
250 
252 
253  if {[catch {sc_base close $base}]} {
255  }
256 
257  if {$confirm == 2} { ::notify::DatabaseModified $::clipbase_db}
258 
259  # Now switch back to the original base
260  ::file::SwitchToBase $current 0
261 }
262 
263 proc ::file::SwitchToBase {{b} {saveHistory 1}} {
264  if {$saveHistory == 1} {
265  ::gameHistory::updatePos $::curr_db [sc_game number] [sc_pos location]
266  }
267  if {![catch {sc_base switch $b} res]} {
268  set ::curr_db $res
269  # Close email window when a base is switched:
270  if {[winfo exists .emailWin]} { destroy .emailWin}
271  if {$saveHistory == 1} {
272  ::gameHistory::pushBack $::curr_db [sc_game number] [sc_pos location]
273  }
274  }
277 }
278 
279 # Databases that will be automatically loaded ad startup
280 proc ::file::autoLoadBases.load {} {
281  if {![info exists ::autoLoadBases]} { return}
282  foreach base $::autoLoadBases {
283  if {[::file::Open $base] != 0} {
284  set idx [lsearch -exact $::autoLoadBases $base]
285  if {$idx != -1} { set ::autoLoadBases [lreplace $::autoLoadBases $idx $idx]}
286  }
287  }
288 }
289 
290 proc ::file::autoLoadBases.save { {channelId} } {
291  if {![info exists ::autoLoadBases]} { return}
292  puts $channelId "set ::autoLoadBases [list $::autoLoadBases]"
293 }
294 proc ::file::autoLoadBases.find { {baseIdx} } {
295  if {![info exists ::autoLoadBases]} { return -1}
296  if {[ catch {set base [sc_base filename $baseIdx]}]} { return -1}
297  return [lsearch -exact $::autoLoadBases $base]
298 }
299 proc ::file::autoLoadBases.add { {baseIdx} } {
300  if {[ catch {set base [sc_base filename $baseIdx]}]} { return}
301  lappend ::autoLoadBases $base
302 }
303 proc ::file::autoLoadBases.remove { {baseIdx} } {
304  if {![info exists ::autoLoadBases]} { return}
305  if {[ catch {set base [sc_base filename $baseIdx]}]} { return}
306  set idx [lsearch -exact $::autoLoadBases $base]
307  if {$idx != -1} {
308  set ::autoLoadBases [lreplace $::autoLoadBases $idx $idx]
309  }
310 }