-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathproject.tin
257 lines (228 loc) · 11.8 KB
/
project.tin
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet project-open-cb (self)
(opt (project-open-low self)) )
(defnet project-open-low (self)
(deflocal a i path)
(set a (cons (queue) (queue)))
(sqlite3-exec-data _db (netptr project-open-cback) a
"SELECT name,path1,path2 FROM projects ORDER BY name" )
(if (= (length (car a)) 0)
then (iup-warning60 self $"There are no valid projects.")
(fail) )
(set i (iup-choose-menu (car a)))
(integerp i)
(set path (car <(cdr a) i>))
(alt (open-common-low 1 path false)
(sound-iup-error60 self (+ "can't open `" path "'")) )
(set path (cdr <(cdr a) i>))
(alt (open-common 2 path)
(sound-iup-error60 self (+ "can't open `" path "'")) )
(gui-report)
(gui-update-image)
(gui-update) )
(defnet project-open-cback (a name path1 path2)
(if (and (pathexists path1) (pathexists path2))
then (queue-put (car a) name)
(queue-put (cdr a) (cons path1 path2)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet project-save-cb (self)
(sqlite3-begin _db)
(alt (seq (project-save-low self)
(sqlite3-end _db)
(gui-update) )
(sqlite3-rollback _db) ))
(defnet project-save-low (self)
(deflocal path1 path2 name newname)
(set path1 <_kv "path1">)
(stringp path1)
(set path2 <_kv "path2">)
(stringp path2)
(set path1 (sqlite3-escape-strings path1))
(set path2 (sqlite3-escape-strings path2))
(set name <(sqlite3-exec _db
"SELECT name FROM projects WHERE path1='" path1
"' AND path2='" path2 "' LIMIT 1") 0 0> )
(if (stringp name)
then (set newname name)
(iup-edit-string self $"Rename project" $"Project name" newname)
(stringp newname)
(<> newname "")
(<> newname name)
(alt (sqlite3-exec _db undef
"UPDATE projects SET name='" (sqlite3-escape-strings newname)
"' WHERE name='" (sqlite3-escape-strings name) "'" )
(seq (iup-confirm60 self (+ $"Project `" newname $"' exists. Do you want to overwrite it?"))
(sqlite3-exec _db undef
"DELETE FROM projects WHERE name='" (sqlite3-escape-strings newname) "'")
(sqlite3-exec _db undef
"UPDATE projects SET name='" (sqlite3-escape-strings newname)
"' WHERE name='" (sqlite3-escape-strings name) "'" ))
(seq (sound-iup-error60 self "Database error")
(fail) ))
else (iup-edit-string self $"Save project" $"Project name" name)
(stringp name)
(<> name "")
(alt (sqlite3-exec _db undef
"INSERT INTO projects VALUES('" (sqlite3-escape-strings name)
"','" path1
"','" path2
"')" )
(seq (iup-confirm60 self (+ $"Project `" name $"' exists. Do you want to overwrite it?"))
(sqlite3-exec _db undef
"UPDATE projects SET path1='" path1
"',path2='" path2
"' WHERE name='" (sqlite3-escape-strings name) "'" ))
(seq (sound-iup-error60 self "Database error")
(fail) )))
(iup-info60 self $"Project successfully saved.") )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet project-delete-cb (self)
(opt (project-delete-low self)
(gui-update) ))
(defnet project-delete-low (self)
(deflocal av1 av2 path1 path2 name)
(set av1 <_kv "av1">)
(<> av1 undef)
(set av2 <_kv "av2">)
(<> av2 undef)
(set name <(sqlite3-exec _db
"SELECT name FROM projects WHERE path1='" (sqlite3-escape-strings <_kv "path1">)
"' AND path2='" (sqlite3-escape-strings <_kv "path2">) "' LIMIT 1") 0 0> )
(stringp name)
(iup-confirm60 self (+ $"Project `" name $"' will be deleted." ' ' $"Are you sure?"))
(sqlite3-exec _db undef
"DELETE FROM projects WHERE name='" (sqlite3-escape-strings name) "'")
(iup-info60 self $"Project successfully deleted.") )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet project-export-cb (self)
(opt (project-export-low self)) )
(defnet project-export-low (self)
(deflocal av1 av2 path1 path2 name1 name2 path db project-name)
(set av1 <_kv "av1">)
(<> av1 undef)
(set av2 <_kv "av2">)
(<> av2 undef)
(set path1 <_kv "path1">)
(set path2 <_kv "path2">)
(set name1 (fullpath->name path1))
(set name2 (fullpath->name path2))
(set path1 (sqlite3-escape-strings path1))
(set path2 (sqlite3-escape-strings path2))
(set project-name <(sqlite3-exec _db
"SELECT name FROM projects WHERE path1='" path1
"' AND path2='" path2 "' LIMIT 1") 0 0> )
(set path (cfg-get "save-path"))
(if (not (stringp path))
then (set path (cfg-get "path")) )
(set path (iup-choose-file-save self
$"Export project data as..."
path
(+ (if (stringp project-name) project-name "project-data") ".cfg")
true ))
(stringp path)
(cfg-set "save-path" path)
(opt (remove path))
(set db (sqlite3-open path))
(<> db undef)
(sqlite3-begin db)
(alt (iup-progress
(thread-create (netptr project-export-th) (thread-self) db av1 av2 path1 path2 name1 name2 project-name)
self "Exporting..." true false false false true )
(seq (sqlite3-rollback db)
(close db)
(remove path)
(sound-iup-error60 self "Error.")
(fail) ))
(sqlite3-end db)
(close db)
(iup-info60 self $"Project data successfully exported.") )
(defnet project-export-th (th db av1 av2 path1 path2 name1 name2 project-name)
(alt (seq (project-export-th-low th db av1 av2 path1 path2 name1 name2 project-name)
(send "q" to th) )
(send "a" to th) ))
(defnet project-export-th-low (th db av1 av2 path1 path2 name1 name2 project-name)
(deflocal key)
(sqlite3-exec db undef
"CREATE TABLE config(" \
"key char unique not null," \
"value char not null)" )
(sqlite3-exec db undef
"CREATE TABLE paths(" \
"path char unique not null," \
"name char not null)" )
(sqlite3-exec db undef
"CREATE TABLE projects(" \
"name char unique not null," \
"path1 char not null," \
"path2 char not null)" )
(sqlite3-exec db undef
"INSERT INTO paths VALUES('"
path1 "','"
(sqlite3-escape-strings name1) "')" )
(sqlite3-exec db undef
"INSERT INTO paths VALUES('"
path2 "','"
(sqlite3-escape-strings name2) "')" )
(if (stringp project-name)
then (sqlite3-exec db undef
"INSERT INTO projects VALUES('" (sqlite3-escape-strings project-name)
"','" path1
"','" path2
"')" ))
(set key (key-scd av1 name1))
(cfg-set-low db key (cfg-get key))
(set key (key-scd av2 name2))
(cfg-set-low db key (cfg-get key))
(set key (key-sck av1 av2 name1 name2))
(cfg-set-low db key (cfg-get key))
(set key (key-map av1 av2 name1 name2))
(cfg-set-low db key (cfg-get key))
(set key (key-prm av1 av2 name1 name2))
(cfg-set-low db key (cfg-get key))
(sqlite3-exec db undef
"CREATE INDEX paths_name ON paths(name)" )
(sqlite3-exec db undef
"CREATE INDEX projects_path1 ON projects(path1)" )
(sqlite3-exec db undef
"CREATE INDEX projects_path2 ON projects(path2)" ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;