projmen.icl 14.2 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
implementation module projmen

import StdArray,StdFunc,StdMisc, StdTuple
import StdFileSelect,StdMenu,StdMenuElement,StdPStClass,StdReceiver
import ExtNotice
import IdeState, EdClient, PmProject, UtilStrictLists, PmFiles, PmPath
import projwin, targetui, ioutil, edfiles
import UtilNewlinesFile
import ExtListBox

pm_menu_add :: .Pathname !*(PSt *General) -> *PSt *General;
pm_menu_add path ps
	# (mPrRecId,ps)					= getPMR ps
	# ((err,rep),ps)				= syncSend2 mPrRecId (Add path) ps
	| err <> SendOk || isNothing rep
		= ps
	| length (fromJust rep) <> 1
		= ps
	# ({projIds,mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est},ps)
		= getMenuIds ps
	// do Project menu...
	# (prefs,ps)					= getPrefs ps
Diederik van Arkel's avatar
Diederik van Arkel committed
23
	# projIds = removeAt 9 projIds	// Disable theorem prover module...
Diederik van Arkel's avatar
Diederik van Arkel committed
24
25
26
27
28
29
30
31
32
33
34
	# ps		= appPIO (enableMenuElements projIds) ps
	// do Module menu...
	# moduleIds = [mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est]
	# ps		= setModuleIds moduleIds ps
	// if project window or edit window active then enable moduleIds...
	# (wId,ps)	= accPIO getActiveWindow ps
	| isNothing wId
		= ps
	# wId			= fromJust wId
	# (pwId,ps)		= getPWW ps
	| pwId == wId
Diederik van Arkel's avatar
Diederik van Arkel committed
35
36
//		# projModuleIds = removeMembers moduleIds [md_cmp,md_chk,md_gen]
		# projModuleIds = moduleIds
Diederik van Arkel's avatar
Diederik van Arkel committed
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
		= appPIO (enableMenuElements projModuleIds) ps
	# (isEW,ps)		= isEditWin wId ps
	| isEW
		# (mpath,ps) = message wId getPathName ps
		| isNothing mpath = ps
		# mpath = fromJust mpath
		| ismodule mpath
			= appPIO (enableMenuElements moduleIds) ps
		= ps
	= ps
where
	ismodule s
		| lengths < 4
			= False
		| s%(firsts,lasts) == ".icl"
			= True
//		| s%(firsts,lasts) == ".dcl"
//			= True
		= False
	where
		lengths = size s
		firsts = lengths - 4
		lasts = dec lengths

pm_menu_rem :: !*(PSt *General) -> *PSt *General;
pm_menu_rem ps
	/*
	Show dialog with listbox of projects ---> remove...
	*/
	# (mPrRecId,ps)	= getPMR ps
	# ((err,projs),ps)	= syncSend2 mPrRecId (Get) ps
	| err <> SendOk || isNothing projs
		= ps
	# projs			= fromJust projs
	# (dlogId,ps)	= openId ps
	# (okId,ps)		= openId ps
	# (cancelId,ps)	= openId ps
	# (lbId,ps)		= openExtListBoxId ps
	# (_,ps)		= openModalDialog dloc (ddef dlogId okId cancelId lbId projs) ps
	= ps
where
	buttonWidth	= ContentWidth "Cancel"
	dloc = undef
	do_remove lbId ps
		# ((ok,sel),ps)	= getExtListBoxSelection lbId ps 
		| not ok = ps
		# (sels,seli)	= unzip sel
		# ps			= closeExtListBoxItems lbId seli ps
		# (mPrRecId,ps)	= getPMR ps
		# (_,ps)		= seqList (map (\p->syncSend2 mPrRecId (Rem p)) sels) ps
		# ((err,rep),ps)= syncSend2 mPrRecId Get ps
		| err <> SendOk || isNothing rep
			= ps
		| isEmpty (fromJust rep)
			# ({projIds},ps)	= getMenuIds ps
			# (prefs,ps)		= getPrefs ps
Diederik van Arkel's avatar
Diederik van Arkel committed
93
			# projIds			= removeAt 9 projIds	// disable module theorem proving...
Diederik van Arkel's avatar
Diederik van Arkel committed
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
			// if projwin or editwin active disable moduleIds...
			// not necessary here because only called from active dialog...
			# ps = setModuleIds [] ps
			= appPIO (disableMenuElements projIds) ps
		= ps
		
	ddef dlogId okId cancelId lbId projs =
			Dialog "Remove..."
			(	TextControl "Remove project from project list" []
			:+: ExtListBoxControl [(p,id,id)\\ p <- projs] [] (\_ ps -> ps) lbId
				[ ControlPos (Left,zero)
				, ControlViewSize {w=300,h=200}
				]
			:+: ButtonControl "Remove"
				[ ControlFunction (noLS (do_remove lbId))
				, ControlPos (Left,zero)
				, ControlWidth buttonWidth
				]
			:+:	ButtonControl "Cancel"	// doesn't cancel...
				[ ControlId cancelId
				, ControlFunction (noLS (closeWindow dlogId))
				, ControlWidth buttonWidth
				]
			:+:	ButtonControl "Ok"
				[ ControlId okId
				, ControlFunction (noLS (closeWindow dlogId))
				, ControlWidth buttonWidth
				]
			)
			[ WindowId dlogId
			, WindowOk okId
			, WindowCancel cancelId
			, WindowClose (noLS (closeWindow dlogId))
			, WindowInitActive okId
			]

130
ProjListMenu :: Id Id (R2Id PLMMessage PLMReply) -> NewLS (:+: RadioMenu (Receiver2 PLMMessage PLMReply)) .a *(PSt *General)
Diederik van Arkel's avatar
Diederik van Arkel committed
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
ProjListMenu mProjectId mPrListId mPrRecId =
	{newDef =
	(	RadioMenu [] 0 [MenuId mPrListId]
	:+: Receiver2 mPrRecId pm_menu_set []
	)
	,newLS = []
	}
where
	findIndex s l = findIndex` 1 l
	where
		findIndex` _ [] = 0
		findIndex` i [h:t]
			| s == h = i
			= findIndex` (inc i) t

	projectListItem fs =
		(RemovePath fs,Nothing,Nothing,(snd o pm_switch fs))

	pm_menu_set (Add path) (ls,ps)
		# idx = findIndex path ls
		| idx <> 0
			// activate...
			# ps = appPIO (selectRadioMenuIndexItem mPrListId idx) ps
			= (ls,(ls,ps))
		# (err,ps) = accPIO (openRadioMenuItems mPrListId 0 [projectListItem path]) ps
		| err <> NoError
			# ps	= openNotice (Notice ["Unable to update project menu."] (NoticeButton "OK" id) []) ps
			= (ls,(ls,ps))
		# ps = appPIO (selectRadioMenuIndexItem mPrListId 1) ps
		# res = [path:ls]
		= (res,(res,ps))
	pm_menu_set (Rem path) (ls,ps)
		# idx = findIndex path ls
		| idx == 0
			= (ls,(ls,ps))
		# (mnu,ps)	= accPIO (getMenu mProjectId) ps
		| isNothing mnu
			= (ls,(ls,ps))
		# mnu = fromJust mnu
		# (mix,_)	= getSelectedRadioMenuItem mPrListId mnu
		| idx == mix
			// Disallow removing currently active project...
			//# ps = appPIO (selectRadioMenuIndexItem mPrListId 0) ps
			//# ps = appPIO (closeRadioMenuIndexElements mPrListId [idx]) ps
			= (ls,(ls,ps))
		# ps = appPIO (closeRadioMenuIndexElements mPrListId [idx]) ps
		= (ls,(ls,ps))
	pm_menu_set Get (ls,ps)
		= (ls,(ls,ps))

pm_new :: !*(PSt *General) -> *PSt *General;
pm_new ps
	#	(path,ps)		= sendToActiveWindow msgGetPathName ps
	| isNothing path
		// error message no new project without active main module
		= okNotice ["Unable to create new project.","There is no active module window."] ps
	# path				= fromJust path
	# projectpath		= MakeProjectPathname path
	# (mpath,ps)		= selectOutputFile "New Project..." projectpath ps
	| isNothing mpath
		= ps
	# projectpath		= fromJust mpath
	# (_,ps)			= close_all_project_windows (pm_new` path projectpath) ps
	= ps

196
pm_new` :: !String !String !*(PSt *General) -> (!Bool,!*PSt *General);
Diederik van Arkel's avatar
Diederik van Arkel committed
197
198
pm_new` path projectpath ps
	# ps				= pm_shut ps	// just in case
199
200
201
	#	({compopts,cgenopts,linkopts,applopts},ps) = getPrefs ps
		eo				= {eo = {newlines=HostNativeNewlineConvention}, pos_size = NoWindowPosAndSize}
		project			= PR_NewProject path eo compopts cgenopts applopts Nil linkopts
202
		ps				= setProjectFilePath projectpath ps
203
		project			= PR_SetRoot path eo compopts project		// ensure correct root path in project
204
		ps				= appProject (const project) ps
205
206
207
208
209
	= show_new_project projectpath ps

show_new_project :: !String !*(PSt *General) -> (!Bool,!*PSt *General);
show_new_project projectpath ps
	#	ps				= pm_set_window_title projectpath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
210
211
212
213
214
215
216
217
		(tg,ps)			= getTargetName ps
		ps				= setProjectTarget tg ps
		ps				= pm_update_project_window ps
		ps				= pm_save ps
	# ps				= pm_open_path projectpath ps
//	# ps				= pm_menu_add projectpath ps
	= (True,ps)

218
219
220
221
222
223
224
225
226
227
228
229
230
231
pm_new_project_using_template :: !*(PSt *General) -> *PSt *General;
pm_new_project_using_template ps
	# (path,ps) = sendToActiveWindow msgGetPathName ps
	= case path of
		Nothing
			-> okNotice ["Unable to create new project.","There is no active module window."] ps
		Just path
			# (prt_s,ps) = selectInputFile ps
			-> case prt_s of
				Nothing
					-> ps
				Just prt_path_name
					| not (equal_suffix ".prt" (RemovePath prt_path_name))
						-> okNotice ["The file \"" +++ prt_path_name +++ "\" is not a project template file (.prt)."] ps
232
233
234
235
236
237
238
239
240
241
242
					# (startupdir,ps) = getStup ps
					  ((ok,project,err),ps)	= accFiles (read_project_template_file prt_path_name startupdir) ps
					| not ok
						-> okNotice [err] ps
					# (mpath,ps) = selectOutputFile "New Project..." (MakeProjectPathname path) ps
					-> case mpath of
						Nothing
							-> ps
						Just project_file_path
							# (_, ps) = close_all_project_windows (setup_new_project_using_template path project_file_path project) ps
							-> ps
243

244
245
setup_new_project_using_template :: !String !String !Project !*(PSt *General) -> *(!Bool, !*PSt *General);
setup_new_project_using_template path project_file_path project ps
246
247
248
	# ps = pm_shut ps	// just in case
	  ({compopts,cgenopts,linkopts,applopts},ps) = getPrefs ps
	  eo = {eo = {newlines=HostNativeNewlineConvention}, pos_size = NoWindowPosAndSize}
249
	  ps = setProjectFilePath project_file_path ps
250
251
252
253
	# ((ok, project), ps) = accFiles (create_new_project_using_template path project_file_path compopts eo project) ps
	| not ok
		= (False, okNotice ["Unable to create project", "Error setting up project from the given project template"] ps)
	# ps = appProject (const project) ps
254
255
256
	  ps = selectProjectTarget getTargets ps
	= show_new_project project_file_path ps

Diederik van Arkel's avatar
Diederik van Arkel committed
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
pm_open :: !*(PSt *General) -> *PSt *General;
pm_open ps
	# (fs,ps)			= selectInputFile ps
	| isNothing fs
		= ps
	# pathname			= fromJust fs
	# name				= RemovePath pathname
	# projectfile		= IsPrjPathname pathname
	| not projectfile
		= okNotice ["The file \"" +++  name +++ "\" is not a project file."] ps
	# ps				= pm_open_path pathname ps
	= ps

pm_open_path :: !.String !*(PSt *General) -> *PSt *General;
pm_open_path pathName ps
	# (ok,ps)		= pm_switch pathName ps
	| not ok
		= ps
	# (mPHrecId,ps)	= getPHI ps
	# (_,ps)		= syncSend2 mPHrecId pathName ps
	= ps
/*
pm_open_cont :: !.Pathname !*(PSt *General) -> *PSt *General;
pm_open_cont file ps
	# ps = pm_switch file ps
	= pm_menu_add file ps
*/
pm_switch :: !.Pathname !*(PSt *General) -> (!Bool,!*PSt *General);
pm_switch pathname ps
286
	# (oldpath,ps)	= getProjectFilePath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
	# (ok,ps)		= close_all_project_windows (pm_switch` pathname) ps
	| not ok && oldpath <> ""
		# (_,ps)	= pm_actual_open oldpath ps
		# ps		= pm_menu_add oldpath ps
		= (ok,ps)
	# ps			= pm_menu_add pathname ps
	= (ok,ps)

pm_switch` pathname ps
	# ps = pm_shut ps
	= pm_actual_open pathname ps

pm_actual_open :: .Pathname !*(PSt *General) -> (!Bool,!*PSt *General);
pm_actual_open pathname ps
	# (startupdir,ps)		= getStup ps
	# ((project,ok,err),ps)	= accFiles (ReadProjectFile pathname startupdir) ps
	| not ok
		= (ok,okNotice [err] ps)
	# ps					= appProject (const project) ps
306
	# ps					= setProjectFilePath pathname ps
Diederik van Arkel's avatar
Diederik van Arkel committed
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
//	# name					= RemovePath pathname
	# ps					= pm_set_window_title pathname ps
	# ps					= selectProjectTarget getTargets ps
	# ps					= pm_update_project_window ps
	# (prefs,ps)			= getPrefs ps
	| not prefs.switch_close
		= (ok,ps)
	// loop through modules and open those that need to be opened...
	# paths					= PR_GetOpenModulenames project
	# ps					= tryopen paths ps
	// fixup menus
	= (ok,ps)
where
	tryopen Nil ps = ps
	tryopen (h :! t) ps
		# ps	= ed_open_path h ps
		= tryopen t ps
324

Diederik van Arkel's avatar
Diederik van Arkel committed
325
326
327
328
329
330
pm_shut :: !*(PSt *General) -> *PSt *General;
pm_shut ps
	# (lbId,ps)	= getPWI ps
	# ps		= pm_save ps
	# ps		= appProject (const PR_InitProject) ps
	# ps		= closeAllExtListBoxItems lbId ps
331
	# ps		= setProjectFilePath "" ps
Diederik van Arkel's avatar
Diederik van Arkel committed
332
333
334
335
336
337
338
339
340
341
342
	// fixup menus
	= ps

:: AskReply = Yes | No | Cancel
:: ErrorReply = ECancel | EClose | ELeave

close_all_project_windows cont ps
	# (prefs,ps)	= getPrefs ps
	| not prefs.switch_close
		= cont ps
	# (windows,ps)	= accPIO getWindowsStack ps
343
	# (project,ps)	= getFromProject (\l->l) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
	# modules		= PR_GetModuleStuff project
	# modules		= massage (StrictListToList modules)
	= doall windows modules ps
where
	massage [] = []
	massage [(dm,dp,im,ip):r] = [MakeFullPathname dp dm, MakeFullPathname ip im: massage r]
	
	doall [] _ ps
		= cont ps
	doall [win:res] modules ps
		# (ns,ps)		= message win msgGetNeedSave ps
		| isNothing ns
			= doall res modules ps
		# needsave		= fromJust ns
		# (mr,ps)		= message win msgGetPathName ps
		| isNothing mr
			= doall res modules ps
		# pathname		= fromJust mr
		| not (isMember pathname modules)
			= doall res modules ps
		| not needsave
			= doall res modules (ed_common_close False win ps)
		# texts			= ["Save changes to","\""+++RemovePath pathname+++"\"","before closing?"]
		= ask texts win res ps
	where
		save_cont win sId res modules ps
			# (reply,ps)= message win msgSave ps		//=> ADD ERROR CHECKING HERE!
			| isNothing reply
				= doall res modules ps					// shouldn't be possible...
			# error = fromJust reply
			| isJust error
				# (sId,ps)	= openId ps
				# (okId,ps)	= openId ps
				# (cnId,ps)	= openId ps
				# (ret,ps) = openModalDialog ECancel (edef ["Save failed:",fromJust error] sId okId cnId) ps
			= case ret of
				(NoError,Just ret) -> case ret of
					ECancel	-> (False,ps)
					EClose	-> doall res modules (ed_common_close False win ps)
					ELeave	-> doall res modules ps
				_ -> (False,ps)
			# ps		= ed_common_close False win ps
			= doall res modules ps
		buttonWidth = ContentWidth "Cancel"

		ask :: [String] !Id [Id] !*(PSt *General) -> (!Bool,!*PSt *General);
		ask texts win res ps
			# (sId,ps)	= openId ps
			# (okId,ps)	= openId ps
			# (cnId,ps)	= openId ps
			# (ret,ps)	= openModalDialog Cancel (sdef sId okId cnId) ps
			= case ret of
				(NoError,Just ret) -> case ret of
					Cancel	-> (False,ps)
					No		-> doall res modules (ed_common_close False win ps)
					Yes		-> save_cont win sId res modules ps
				_ -> (False,ps)
				
		where
			sdef sId okId cnId = Dialog ""
					(	ListLS [TextControl txt [ControlPos (Left,zero)]
						\\ txt <- texts
						]
					:+: ButtonControl "Cancel"
						[ ControlPos (Left,zero)
						, ControlFunction (\(ls,ps)->(Cancel,closeWindow sId ps))
						, ControlWidth buttonWidth
						, ControlId cnId
						]	// no more
					:+: ButtonControl "No"
						[ ControlFunction (\(ls,ps)->(No,closeWindow sId ps))
						, ControlWidth buttonWidth
						]	// not this one but continue with rest
					:+: ButtonControl "Yes"
						[ ControlId okId
419
						, ControlFunction (\(ls,ps)->(Yes,closeWindow sId ps))
Diederik van Arkel's avatar
Diederik van Arkel committed
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
						, ControlWidth buttonWidth
						]	// do this one and continue
					)
					[ WindowOk okId
					, WindowCancel cnId
					, WindowId sId
					]
		edef texts sId okId cnId = Dialog ""
			(	ListLS [TextControl txt [ControlPos (Left,zero)]
				\\ txt <- texts
				]
			:+: ButtonControl "Cancel"
				[ ControlPos (Left,zero)
				, ControlFunction (\(ls,ps)->(ECancel,closeWindow sId ps))
				, ControlWidth buttonWidth
				, ControlId cnId
				]	// no more
			:+: ButtonControl "Close"
				[ ControlFunction (\(ls,ps)->(EClose,closeWindow sId ps))
				, ControlWidth buttonWidth
				]	// not this one but continue with rest
			:+: ButtonControl "Leave"
				[ ControlId okId
				, ControlFunction (\(ls,ps)->(ELeave,closeWindow sId ps))
				, ControlWidth buttonWidth
				]	// do this one and continue
			)
			[ WindowOk okId
			, WindowCancel cnId
			, WindowId sId
			]