We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

projwin.icl 29 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2 3
implementation module projwin

import StdArray, StdFunc, StdMisc, StdOrdList, StdTuple
4
import StdClipboard,StdControlReceiver,StdFileSelect,StdMenu,StdMenuElement,StdPStClass,StdSystem
Diederik van Arkel's avatar
Diederik van Arkel committed
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
import ExtListBox, ExtNotice
import EdClient
import PmProject, PmFiles, UtilStrictLists, PmPath
import edfiles, messwin, errwin
import PmDialogues, PmDriver
import PmCleanSystem
import flextextcontrol
import ioutil, morecontrols, colorpickcontrol
import projmen, menubar, colourclip
from IDE import OpenModule
import Platform, IdePlatform

//-- Project Window Options...

:: PWO =
	{ fn	:: !String		// font name
	, fs	:: !Int			// font size
	, fc	:: !Colour		// foreground colour
	, bc	:: !Colour		// background colour
	, hc	:: !Colour		// header colour
	, cr	:: !AC			// active colour control in PWO dialogue
	, shift	:: !Bool		// open dcl/icl on dbl-click
	}

:: AC = HC | FC | BC

instance == AC
where
	(==) HC HC = True
	(==) FC FC = True
	(==) BC BC = True
	(==) _ _ = False
	
projwinOptions :: !*(PSt *General) -> *PSt *General;
projwinOptions ps
    # (dialogId,ps)	= openId ps
    # (okId,ps)		= openId ps
    # (cancelId,ps)	= openId ps
	# (hcid,ps)		= openId ps
	# (fcid,ps)		= openId ps
	# (bcid,ps)		= openId ps
	# (rgbid,ps)	= openRGBId ps
	# (lsid,ps)		= openRId ps
	# (fontNames, ps) = accPIO (accScreenPicture getFontNames) ps
	# fontSizes		= [7,8,9,10,11,12]
	# (lbId,ps)		= getPWI ps
	# (pen,ps)		= getExtListBoxPen lbId ps
	| isNothing pen
		= ps
	# pen			= fromJust pen
	# fdef			= getPenAttributeFont pen
	# inifn			= fdef.fName
	# inifs			= fdef.fSize
	# (prefs,ps)	= getPrefs ps
	# inihc			= prefs.prj_prefs.proj_topc
	# inifc			= prefs.prj_prefs.proj_forc
	# inibc			= prefs.prj_prefs.proj_bacc
	# inishift		= prefs.prj_prefs.proj_shft
	# inistate		= {fn = inifn, fs = inifs, fc = inifc, bc = inibc, hc = inihc, cr = HC, shift = inishift}
    # controls		=
    	(	LayoutControl
		(	FontNameSizeControl inifn inifs fontNames fontSizes fontfun sizefun [ left ]
		:+: RGBColourPickControl` rgbid inihc hcid (Just (Left,zero))
		) []

		:+: LayoutControl
		(	TextControl "Header:" [ left , ControlWidth (ContentWidth "Background: ")]
		:+: ColourBoxControl` (toRGBColour inihc) hcid (mfilter,mfun rgbid lsid hcid fcid bcid HC) Nothing
		:+:	TextControl "Text:" [ left , ControlWidth (ContentWidth "Background: ")]
		:+: ColourBoxControl` (toRGBColour inifc) fcid (mfilter,mfun rgbid lsid hcid fcid bcid FC) Nothing
		:+:	TextControl "Background:" [ left , ControlWidth (ContentWidth "Background: ")]
		:+: ColourBoxControl` (toRGBColour inibc) bcid (mfilter,mfun rgbid lsid hcid fcid bcid BC) Nothing
		) []

	   	:+: RadioControl
	   		[("Open .dcl on double-click",Nothing,\(ls,ps)->({ls & shift = True},ps))
	   		,("Open .icl on double-click",Nothing,\(ls,ps)->({ls & shift = False},ps))
	   		] (Columns 1) (if inishift 1 2)
	   		[ControlPos (Left,zero)
	   		]
	   	:+:	ButtonControl "Ok"
  			[ ControlId okId
  			, ControlFunction (okFun rgbid lsid dialogId) 
  			, ControlPos (Right, zero)
  			, ControlWidth (ContentWidth "Cancel")
  			]
    	:+:	ButtonControl "Cancel"
  			[ ControlPos (LeftOfPrev, zero) 
  			, ControlFunction (cancelFun inistate dialogId)
  			, ControlId cancelId
  			] 
		:+: ButtonControl "Apply"
			[ ControlPos (LeftOfPrev,zero)
			, ControlFunction (applyFun rgbid lsid)
			]
  		:+: ButtonControl "Paste"
  			[ ControlPos (LeftOfPrev,zero)
  			, ControlFunction (pasteFun rgbid hcid fcid bcid)
  			]
  		:+: ButtonControl "Copy"
  			[ ControlPos (LeftOfPrev,zero)
  			, ControlFunction (copyFun rgbid)
  			]

  		:+: Receiver lsid lsfun []
		)
	# dialog		=
		Dialog "Project Window..." controls 
  		[ WindowId dialogId 
  		, WindowOk okId
  		, WindowCancel cancelId
  		, WindowClose (cancelFun inistate dialogId)
  		, WindowInit (setBoxCol hcid fcid bcid)
  		]
	# (_,ps) = openModalDialog inistate dialog ps
	= ps
where
	toStringC :: !Colour -> String
	toStringC c = toString c
	copyFun rgbid (ls,ps)
		# ps = getColourBoxColour rgbid cont ps
		= (ls,ps)
	where
		cont col ps
			| isNothing col
				= ps
			# col = fromJust col
			# ps	= setClipboard [toClipboard (toString col)] ps
			= ps
	pasteFun rgbId hcId fcId bcId (ls=:{cr},ps)
		// get clipboard
		// and put in active colour control
		# (its,ps)	= getClipboard ps
		| isEmpty its
			= (ls,ps)
		# its		= map fromClipboard its
		# its		= filter isJust its
		| isEmpty its
			= (ls,ps)
		# it		= fromJust (hd its)
		| it <> toStringC (fromString it)
			= (ls,ps)
		# col		= fromString it
		# ls		= case cr of
						HC -> {ls & hc = col}
						FC -> {ls & fc = col}
						BC -> {ls & bc = col}
		# (ls,ps)	= setBoxCol hcId fcId bcId (ls,ps)
		# ps		= setColourBoxColour` rgbId col ps
		= (ls,ps)
	mfilter (MouseDown _ _ _) = True
	mfilter _ = False
	mfun rgbid lsid hcId fcId bcId ac _ (ls=:{fc,bc,hc,cr},ps)
		| cr == ac = (ls,ps)
		# ps = getColourBoxColour rgbid cont ps
		= (ls,ps)
	where
		cont col ps
			| isNothing col = ps
			# col = fromJust col
			# ps	= appPIO (case ac of
								HC	-> SetColourBox` hcId (case cr of
									HC	-> toRGBColour col
									_	-> toRGBColour hc
									)
								_	-> SetColourBox hcId (case cr of
									HC	-> toRGBColour col
									_	-> toRGBColour hc
									)
							) ps
			# ps	= appPIO (case ac of
								FC	-> SetColourBox` fcId (case cr of
									FC	-> toRGBColour col
									_	-> toRGBColour fc
									)
								_	-> SetColourBox fcId (case cr of
									FC	-> toRGBColour col
									_	-> toRGBColour fc
									)
							) ps
			# ps	= appPIO (case ac of
								BC	-> SetColourBox` bcId (case cr of
									BC	-> toRGBColour col
									_	-> toRGBColour bc
									)
								_	-> SetColourBox bcId (case cr of
									BC	-> toRGBColour col
									_	-> toRGBColour bc
									)
							) ps
			# cId = case ac of
						HC -> hcId
						FC -> fcId
						BC -> bcId
			# col` = case ac of
						HC -> hc
						FC -> fc
						BC -> bc
			# ps	= setColourBoxId rgbid cId ps
			# ps	= setColourBoxColour` rgbid col` ps
			# (_,ps) = asyncSend lsid (cont2 col) ps
			= ps
		cont2 col (ls=:{cr},ps)
			# ls	= case cr of
						HC -> {ls & hc = col, cr = ac}
						FC -> {ls & fc = col, cr = ac}
						BC -> {ls & bc = col, cr = ac}
			= (ls,ps)
213
	setBoxCol hcId fcId bcId (ls=:{cr,hc,fc,bc},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
214
		# (cId,col) = case cr of
215 216 217
						HC	-> (hcId,hc)
						FC	-> (fcId,fc)
						BC	-> (bcId,bc)
Diederik van Arkel's avatar
Diederik van Arkel committed
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
		# ps = appPIO (SetColourBox` cId (toRGBColour col)) ps
		= (ls,ps)
	applyFun rgbid lsid (ls,ps)
		= cset rgbid lsid id (ls,ps)
	okFun rgbid lsid dialogId (ls,ps)
		= cset rgbid lsid (noLS (closeWindow dialogId)) (ls,ps)
	cancelFun inils dialogId (ls,ps)
		# ls = inils
		# (ls,ps) = apply (ls,ps)
		= (ls,closeWindow dialogId ps)
	lsfun f (ls,ps)
		= f (ls,ps)
	cset rgbid lsid finish (ls=:{cr},ps)
		# ps = getColourBoxColour rgbid cont1 ps
		= (ls,ps)
	where
		cont1 col ps
			| isNothing col = ps
			# col = fromJust col
			# (_,ps) = asyncSend lsid (cont4 col) ps
			= ps
		cont4 col (ls,ps)
			# ls		= case cr of
							HC -> {ls & hc = col}
							FC -> {ls & fc = col}
							BC -> {ls & bc = col}
			# (ls,ps) = apply (ls,ps)
			= finish (ls,ps)
246
	apply (ls=:{fn,fs,fc,bc,hc,shift},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
247
		# (lbId,ps)	= getPWI ps
248
		# ((fnt_ok,fnt),ps)	= accScreenPicture (openFont {fName = fn, fSize = fs, fStyles = []}) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
249
		# pen2		= if fnt_ok [PenFont fnt] []
250
		# pen		= [PenColour fc, PenBack bc:pen2] 
Diederik van Arkel's avatar
Diederik van Arkel committed
251 252 253 254 255

		# ps			= closeAllExtListBoxItems lbId ps

		# ps		= setExtListBoxPen lbId pen ps
		# (wId,ps)	= getPWW ps
256
		# ps		= appPIO (setWindowLook wId True (True,(\_ {newFrame} -> fill newFrame o setPenColour hc))) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
257 258
		# (prefs,ps) = getPrefs ps
		# prefs		=	{ prefs
259 260 261 262 263
						& prj_prefs.proj_forc = fc
						, prj_prefs.proj_bacc = bc
						, prj_prefs.proj_topc = hc
						, prj_prefs.proj_font = {prefs.prj_prefs.proj_font & fName = fn, fSize = fs}
						, prj_prefs.proj_shft = shift
Diederik van Arkel's avatar
Diederik van Arkel committed
264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331
						}
		# ps		= setPrefs prefs ps
		| not fnt_ok
			= (ls,ps)
		// set FlexBar pens...
		# (xId,ps)	= getPWX ps
		# (mId,ps)	= getPWM ps
		# ps = addFlexPens [(xId,pen2),(mId,pen2)] ps

		# ps = pm_update_project_window ps
		
		= (ls,ps)

    left = ControlPos (Left, zero)
	fontfun name (ls,ps)
		# ls		= {PWO | ls & fn = name}
		= (ls,ps)
	sizefun size (ls,ps)
		# ls		= {PWO | ls & fs = size}
		= (ls,ps)


//--

pm_open_project_window :: !*(PSt *General) -> *(PSt *General)
pm_open_project_window ps
	# (menuIds,ps)		= getMenuIds ps
	# (prefs,ps)		= getPrefs ps
	# pw_xvec			= prefs.prj_prefs.proj_pos
	# pw_xsiz			= prefs.prj_prefs.proj_siz
	# (wId,ps)			= getPWW ps
	# (lbId,ps)			= getPWI ps
	# (xxId,ps)			= getPWX ps
	# (mmId,ps)			= getPWM ps
	# (lcId,ps)			= openId ps
	# (lc2Id,ps)		= openId ps
	# (lc3Id,ps)		= openId ps
	# pw_main			= ""
	# pw_exec			= ""
	# (fnt,ps)			= accScreenPicture (getFont prefs.prj_prefs.proj_font) ps
	# pen				= [PenBack prefs.prj_prefs.proj_bacc, PenColour prefs.prj_prefs.proj_forc, PenFont fnt]
	# topc				= \butw -> top_controls lbId.controlId lcId lc2Id lc3Id xxId mmId pw_main pw_exec butw fnt
	# (pw_min_size,ps)	= controlSize (topc 0) True Nothing Nothing Nothing ps
	# lbox				= \ini siz -> PWListBox ini lbId lc2Id
							(PlatformDependant
							 (/* Win */ pw_min_size.Size.h+4)
							 (/* Mac */ pw_min_size.Size.h)
							 )siz pen
	# pw_xpos			= (LeftTop,OffsetVector pw_xvec)
	# butwidth			= pw_xsiz.w
	# (err,ps)			= openWindow Void (
							ProjectWindow "project"
							(lbox False {Size | pw_xsiz & h = pw_xsiz.Size.h - 
								PlatformDependant
								(/* Win */ pw_min_size.Size.h+4)
								(/* Mac */ pw_min_size.Size.h)
								})
							lbId.controlId
							(topc butwidth)
							wId
							pw_xsiz
							pw_xpos
							prefs.prj_prefs.proj_topc
							menuIds
							) ps
	| err <> NoError = abort "unable to open Project window"
	= ps
where
Diederik van Arkel's avatar
Diederik van Arkel committed
332
	proj_activate cId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
333 334 335 336 337 338
		# ({mn_clo,mn_sav,mn_sva,mn_und,md_cmp,md_chk,md_gen,md_cst,md_est,mn_cut,mn_cpy,mn_pst,mn_clr,mg_edt,searchIds,moduleIds},ps=:{io})
			= getMenuIds ps
		# io = setMenuElementTitles
				[(mn_sav,"Save Project")
				,(mn_und,"&Undo")						// shouldn't be here...
				] io
Diederik van Arkel's avatar
Diederik van Arkel committed
339
		# mg_edt = removeAt 3 mg_edt					// hack to avoid disabling "Select All"
Diederik van Arkel's avatar
Diederik van Arkel committed
340 341 342 343
		# l1 = [mn_und,mn_clo,mn_cut,mn_cpy,mn_pst,mn_clr:mg_edt]
		# io = disableMenuElements l1 io
		# io = disableMenuElements searchIds.findIds io
		# io = disableMenuElements searchIds.gotoIds io
Diederik van Arkel's avatar
Diederik van Arkel committed
344 345
//		# projModuleIds = removeMembers moduleIds [md_cmp,md_chk,md_gen]
		# projModuleIds = moduleIds
Diederik van Arkel's avatar
Diederik van Arkel committed
346 347 348
		# io = enableMenuElements projModuleIds io
		# l2 = removeMembers [mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est] projModuleIds
		# io = disableMenuElements l2 io
Diederik van Arkel's avatar
Diederik van Arkel committed
349
		# ps = {ps & io = io}
350
//		# ps = setActiveControl cId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
351
		= ps
Diederik van Arkel's avatar
Diederik van Arkel committed
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

	proj_deactivate ps
		# ({mn_clo,mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est,mn_cut,mn_cpy,mn_pst,mn_clr,mg_edt,searchIds},ps=:{io})
			= getMenuIds ps
		# io = setMenuElementTitles [(mn_sav,"Save")] io
		# io = disableMenuElements [mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est] io
		# io = enableMenuElements [mn_clo,mn_cut,mn_cpy,mn_pst,mn_clr:mg_edt] io
		# io = enableMenuElements searchIds.findIds io
		# io = enableMenuElements searchIds.gotoIds io
		= {ps & io = io}

	getFont fd pic
		# ((ok,fnt),pic) = openFont fd pic
		| not ok
			= openDialogFont pic
		= (fnt,pic)

	ProjectWindow title lb lbId tc wId pw_xsiz pw_xpos topc menuIds
		= Window title
			(	tc
			:+:	lb
			)
			[ WindowId			wId
			, WindowViewSize	pw_xsiz
			, WindowPos			pw_xpos
			, WindowPen			[PenBack topc]
			, WindowLook		True (\_ {newFrame,updArea} -> seq (map unfill updArea))
Diederik van Arkel's avatar
Diederik van Arkel committed
379
			, WindowInit		(noLS ((proj_activate lbId) o SetWindowIcon wId ProjectIcon))
Diederik van Arkel's avatar
Diederik van Arkel committed
380 381
			// setWindowViewSize forces resize of listbox... actually forces proper init...
			, WindowInitActive	lbId
Diederik van Arkel's avatar
Diederik van Arkel committed
382
			, WindowActivate	(noLS (proj_activate lbId))
Diederik van Arkel's avatar
Diederik van Arkel committed
383 384 385 386 387 388 389 390 391 392 393 394 395 396 397
			, WindowDeactivate	(noLS proj_deactivate)
			]

	PWListBox ini lbId lc2Id minh size pen
		= ExtListBoxControl
						[]	// contents
						[]	// initial selection
						(\_ ps -> ps)
						lbId
						[ ControlOuterSize size
						, ControlResize (\_ _ nw -> {Size | nw & h = nw.Size.h - minh})
						, ControlPos (if ini (Left,zero) (Below lc2Id,OffsetVector {zero & vx = ~10, vy = 10}))
						, ControlPen pen
						, ControlHMargin 10 10
						, ControlVMargin 3 3
Diederik van Arkel's avatar
Diederik van Arkel committed
398
						, extKeyboard
399
//						, ControlMouse mouseFilter Able mouseFunction
Diederik van Arkel's avatar
Diederik van Arkel committed
400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421
						]

	top_controls lbId localId local2Id local3Id xxId mmId pw_main pw_exec butw fnt =
			(
				FlexText pw_exec xxId
					[ ControlPen [PenColour Black,PenBack LightGrey, PenFont fnt]
					, ControlResize (\cc _ nw -> {cc & w = nw.w - 20})
					, ControlId local3Id
					, ControlPos (Fix,OffsetVector {vx=10,vy=10})
					, ControlWidth (PixelWidth (butw-20))
					]
			:+:	FlexText pw_main mmId
					[ ControlPen [PenColour Black,PenBack LightGrey, PenFont fnt]
					, ControlResize (\cc _ nw -> {cc & w = nw.w - 20})
					, ControlPos (Below local3Id,OffsetVector {zero & vy = 5})
					, ControlId local2Id
					, ControlWidth (PixelWidth (butw-20))
					]
			)
	
pm_update_project_window :: !*(PSt *General) -> *PSt *General
pm_update_project_window ps
422 423 424 425 426 427
	# (interact, ps) = getInteract ps
	| not interact
		=	ps
	// interact
		=	pm_update_project_window_interactive ps

Diederik van Arkel's avatar
Diederik van Arkel committed
428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
getProjwinPaths ps
	# (prjpaths,ps)	= accProject (\l->(PR_GetPaths l,l)) ps
	# (syspaths,ps)	= getCurrentPaths ps
	# (fstate,ps)	= getFstate ps
	# srcpaths		= Map (\d -> lookup d fstate) (AppendLists prjpaths syspaths)
	= (srcpaths,ps)
where
	lookup d [] = (False,d)
	lookup d [(u,d`):ds]
		| d == d` = (u,d)
		= lookup d ds

updFstate d u ps
	# (fstate,ps)	= getFstate ps
	# fstate		= update d u fstate
	# ps			= setFstate fstate ps
	= ps
where
	update d u [] = [(u,d)]
	update d u [e=:(_,d`):fs]
		| d == d` = [(u,d):fs]
		= [e:update d u fs]
//import dodebug
451 452
pm_update_project_window_interactive :: !*(PSt *General) -> *PSt *General
pm_update_project_window_interactive ps
Diederik van Arkel's avatar
Diederik van Arkel committed
453 454 455 456 457 458 459 460 461 462 463 464 465
	# (lbId,ps)		= getPWI ps
	# (xxId,ps)		= getPWX ps
	# (mmId,ps)		= getPWM ps
	# (prefs,ps)	= getPrefs ps

	# (modules,ps)	= accProject (\l->(PR_GetModuleStuff l,l)) ps
	# (xp,ps)		= accProject (\l->(PR_GetExecPath l,l)) ps
	# (mm,ps)		= accProject (\l->(PR_GetRootModuleName l,l)) ps
	# (wId,ps)		= getPWW ps
	# (ws,ps)		= accPIO (getWindow wId) ps
	# (ok,mframe)	= case ws of
						Nothing		-> (False,Nothing)
						Just ws		-> getControlViewFrame lbId.controlId ws
Diederik van Arkel's avatar
Diederik van Arkel committed
466 467 468 469 470
//	# ps = trace_n` ("mframe",ok,mframe) ps
	# (ok,mdomain)	= case ws of
						Nothing		-> (False,Nothing)
						Just ws		-> getControlViewDomain lbId.controlId ws
//	# ps = trace_n` ("mdomain",ok,mdomain) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
471
	# ps			= closeAllExtListBoxItems lbId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
472 473 474 475 476 477 478 479 480
	# (ok,mframe`)	= case ws of
						Nothing		-> (False,Nothing)
						Just ws		-> getControlViewFrame lbId.controlId ws
//	# ps = trace_n` ("mframe`",ok,mframe`) ps
	# (ok,mdomain`)	= case ws of
						Nothing		-> (False,Nothing)
						Just ws		-> getControlViewDomain lbId.controlId ws
//	# ps = trace_n` ("mdomain`",ok,mdomain`) ps
	# (srcpaths,ps)	= getProjwinPaths ps
Diederik van Arkel's avatar
Diederik van Arkel committed
481 482 483 484 485 486
	# (appPath,ps)	= getStup ps
	# (prjPath,ps)	= getPath ps
	# prjPath		= RemoveFilename prjPath
	# lbItems		= items srcpaths appPath prjPath modules prefs.prj_prefs.proj_shft
	# ps			= appendExtListBoxItems lbId lbItems ps
	# ps			= case mframe of
Diederik van Arkel's avatar
Diederik van Arkel committed
487 488 489 490 491 492
						Nothing
							-> ps
						(Just jframe)
							# ps	= appPIO (moveControlViewFrame lbId.controlId (toVector jframe.corner1)) ps
//							# ps	= updateControl	// useless for now since moveviewframe & setviewdomain both already trigger updates...
							-> ps
Diederik van Arkel's avatar
Diederik van Arkel committed
493 494 495 496 497 498 499 500 501 502 503
	# xp			= symPath appPath prjPath xp
	# mm			= symPath appPath prjPath mm
	# ps			= setFlexTexts [(xxId,xp),(mmId,mm)] ps
	= ps
where
	items srcpaths appPath prjPath modules shift
		# mods			= StrictListToList modules
		| isEmpty mods
			= []
		# [(root,_,_,_):mods]	= mods
		# mods					= sortBy (\(a,b,_,_) (c,d,_,_) -> less a b c d) mods
Diederik van Arkel's avatar
Diederik van Arkel committed
504 505
		# moditems				= makenice True "" mods
		# rootitem				= (GetModuleName root, OpenModule (MakeImpPathname root) emptySelection, openif root)
Diederik van Arkel's avatar
Diederik van Arkel committed
506 507
		= [rootitem:moditems]
	where
Diederik van Arkel's avatar
Diederik van Arkel committed
508 509 510 511 512
		openif root ps
			# defpath		= MakeDefPathname root
			# (exists,ps)	= accFiles (FExists defpath) ps
			| exists
				= OpenModule defpath emptySelection ps
513
			# imppath		= MakeImpPathname root
Diederik van Arkel's avatar
Diederik van Arkel committed
514
			= OpenModule imppath emptySelection ps
Diederik van Arkel's avatar
Diederik van Arkel committed
515 516 517 518 519 520 521 522
		less a b c d
			| before b d = True		// use < -ordening of searchpaths...
			| b == d
				= a < c
			= False
		before x y = bf srcpaths
		where
			bf Nil = False
Diederik van Arkel's avatar
Diederik van Arkel committed
523
			bf ((_,p):!r)
Diederik van Arkel's avatar
Diederik van Arkel committed
524 525 526
				| p == y = False
				| p == x = True
				= bf r
Diederik van Arkel's avatar
Diederik van Arkel committed
527 528
		makenice _ _ [] = []
		makenice u s l=:[(a,b,_,_):r]
Diederik van Arkel's avatar
Diederik van Arkel committed
529
			| s <> b	// new directory
Diederik van Arkel's avatar
Diederik van Arkel committed
530 531 532 533 534 535 536 537 538
				# u`			= isUnfoldedDir b srcpaths
				  dir			= symPath appPath prjPath b
				  pw_separator	= if u`
				  					("\\\\--- "+++dir,pm_update_project_window_interactive o updFstate b False,id)
				  					("//--- "+++dir,pm_update_project_window_interactive o updFstate b True,id)
				= [pw_separator : makenice u` b l]
			| u
				= [(GetModuleName a,f a, f` a):makenice u s r]	// add seperators...
				= makenice u s r
Diederik van Arkel's avatar
Diederik van Arkel committed
539 540 541 542 543 544 545
		where
			f mod	= if shift
						(OpenModule (MakeDefPathname mod) emptySelection)
						(OpenModule (MakeImpPathname mod) emptySelection)
			f` mod	= if shift
						(OpenModule (MakeImpPathname mod) emptySelection)
						(OpenModule (MakeDefPathname mod) emptySelection)
Diederik van Arkel's avatar
Diederik van Arkel committed
546 547 548 549
			isUnfoldedDir d Nil = False
			isUnfoldedDir d ((u,d`):!ds)
				| d == d` = u
				= isUnfoldedDir d ds
Diederik van Arkel's avatar
Diederik van Arkel committed
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592
	
// pm_set: set main module
pm_set :: !*(PSt *General) -> *PSt *General
pm_set ps
	# (win,ps)	= accPIO getActiveWindow ps
	| isNothing win
		= okNotice ["Unable to set main module.","There is no active module window."] ps
	# win		= fromJust win
	# (path,ps)	= message win msgGetPathName ps
	| isNothing path
		= okNotice ["Unable to set main module.","There is no active module window."] ps
	# path			= fromJust path
	# (project,ps)	= accProject (\l->(l,l)) ps
	// check if mod in project already has settings...
	# info			= PR_GetModuleInfo (GetModuleName path) project
	| isJust info
		# info	= fromJust info
		# eo	= info.impeo
		# co	= info.compilerOptions
		# project = PR_SetRoot path eo co project
		# ps	= appProject (const project) ps
		# ps	= pm_update_project_window ps
		= ps
	# (pos,ps)	= accPIO (getWindowPos win) ps
	| isNothing pos
		= ps	// this should not occur
	# pos		= fromJust pos
	# (siz,ps)	= accPIO (getWindowViewSize win) ps
	# (nlc,ps)	= sendToActiveWindow getNewlineConvention ps
	| isNothing nlc
		= ps	// this should not occur
	# nlc		= fromJust nlc
	# pos_size	= {posx = pos.vx,posy=pos.vy,sizex=siz.w,sizey=siz.Size.h}
	# eo		= {newlines = nlc}
	# weo		= {eo = eo,pos_size = pos_size}
	#	wco				= DefaultCompilerOptions
		project`		= PR_SetRoot path weo wco project
		ps				= appProject (const project`) ps
		ps = pm_update_project_window ps
	= ps
		
pm_compile :: !*(PSt *General) -> *PSt *General;
pm_compile ps
Diederik van Arkel's avatar
Diederik van Arkel committed
593 594 595 596 597 598 599 600
	| True
		= DoProcess "compiling"  (CompileProjectModule Compilation) (\_ _ _ _-> id) ps
	// timed variant
	# (stick,ps)	= getCurrentTick ps
	# ps = DoProcess "compiling"  (CompileProjectModule Compilation) (\_ _ _ _-> id) ps
	# (etick,ps)	= getCurrentTick ps
	# ps = updateErrorWindow ["Compiler Timing: " +++ toString ((tickDifference etick stick) / ticksPerSecond)] ps
	= ps
Diederik van Arkel's avatar
Diederik van Arkel committed
601 602 603 604 605 606 607 608 609 610
	
pm_check :: !*(PSt *General) -> *PSt *General;
pm_check ps
	= DoProcess "checking"  (CompileProjectModule SyntaxCheck) (\_ _ _ _-> id) ps

pm_gen_asm :: !*(PSt *General) -> *PSt *General;
pm_gen_asm ps
	= DoProcess "generating"  GenAsmProjectModule open_gen_asm ps
where
	open_gen_asm winpath modname ok newpaths ps
611
		| not (ok && newpaths)
Diederik van Arkel's avatar
Diederik van Arkel committed
612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631
			= ps
		# apath			= MakeAssemblySystemPathname winpath
		= ed_open_assembly apath ps
	ed_open_assembly pathName ps
		# (mFHrecId,ps)	= getFHI ps
		# (_,ps)		= syncSend2 mFHrecId pathName ps
		= ed_open_cont pathName cont ps
	where
		cont wasopen win ps
			| wasopen
				= ed_revert_win win ps
			# (_,ps) = message win mess ps
			= ps
		mess es
			# ((_,b,c),es) = msgGetTabs es
			= msgSetTabs (8,b,c) es
			

pm_upto :: !Bool !*(PSt *General) -> *PSt *General;
pm_upto force ps
632
	# ps = ed_ask_save_all False True (enableProjectMenu o BringProjectUptoDate force cont o disableProjectMenu) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
633 634 635 636 637 638 639 640 641
	= mb_update_undoinfo ps
where
	cont path linked ok ps
		| linked || not ok
			= closeInfo ps
		= showInfo (Level1 "Project is up to date") ps

pm_exec :: !*(PSt *General) -> *PSt *General;
pm_exec ps
642
	# ps = ed_ask_save_all False True (enableProjectMenu o BringProjectUptoDate False cont o disableProjectMenu) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
643 644 645 646 647 648 649 650 651 652 653
	= mb_update_undoinfo ps
where
	cont execpath linked ok ps
		# ps		= closeInfo ps
		| not ok
			= ps
		# (lo,ps)	= accProject (\project->(PR_GetLinkOptions project,project)) ps
		# (prj_path,ps)				= getPath ps
		# (app_path,ps)				= getStup ps
		# prj_path`					= RemoveFilename prj_path
		# execpath					= fulPath app_path prj_path` execpath
654 655 656
		| lo.method == LM_Dynamic
			# execpath				= (RemoveSuffix` execpath) +++. ".bat"
			= RunProgram execpath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
657 658 659 660 661 662 663 664 665 666 667
		= RunProgram execpath ps

pm_run :: !*(PSt *General) -> *PSt *General;
pm_run ps
	# (app_path,ps)				= getStup ps
	# (prj_path,ps)				= getPath ps
	# (execpath,ps)				= accProject (\l->(PR_GetExecPath l,l)) ps
	# prj_path`					= RemoveFilename prj_path
	# execpath					= fulPath app_path prj_path` execpath
	# (lo,ps)					= accProject (\project->(PR_GetLinkOptions project,project)) ps
	| lo.method == LM_Dynamic
668 669
		# execpath				= (RemoveSuffix` execpath) +++. ".bat"
		= RunProgram execpath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
670 671 672 673
	= RunProgram execpath ps

//--

674 675 676 677 678 679 680 681 682 683
disableProjectMenu ps
	# (mIds,ps)	= getMenuIds ps
	# ps		= appPIO (disableMenus [mIds.pm_menuid]) ps
	= ps
enableProjectMenu ps
	# (mIds,ps)	= getMenuIds ps
	# ps		= appPIO (enableMenus [mIds.pm_menuid]) ps
	= ps
//--

Diederik van Arkel's avatar
Diederik van Arkel committed
684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709
pm_build :: !.a -> .a;
pm_build ps			// rebuild project from scratch
	= ps

pm_link :: !.a -> .a;
pm_link ps			// relink project
	// fake it by deleting exe
	= ps

pm_copt :: !*(PSt *General) -> *PSt *General
pm_copt ps
	//-> only for module + ide, now added cursel in projwin
	// current active added... (need to check if active is part of project...)
	# (lbId,ps)			= getPWI ps
	# (project,ps)		= accProject (\l->(l,l)) ps
	# (path,ps)			= sendToActiveWindow msgGetPathName ps
	| isJust path
		# path			= fromJust path
		# mod			= GetModuleName path
		# minf			= PR_GetModuleInfo mod project
		| isNothing minf
			// module not found in project...
			// currently do nothing (could add to proj, but disappears when not in deps...)
			= okNotice ["This module is not part of the current project."] ps
		# minf			= fromJust minf
		# projco		= minf.compilerOptions
710
		# setco			= \co -> appProject (\l->PR_UpdateModule mod (\mi->{mi & compilerOptions = co}) l)
Diederik van Arkel's avatar
Diederik van Arkel committed
711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727
		= doCompilerOptionsDialog "Module Options" projco setco ps
	// should check if project window is active...
	// otherwise this behaviour is unintuitive
	# (pwId,ps)			= getPWW ps
	# (awId,ps)			= accPIO getActiveWindow ps
	| isNothing awId || pwId <> fromJust awId
		= ps
	# ((hassel,sel),ps)	= getExtListBoxSelection lbId ps
	| hassel && notEmpty sel
		// work on sel ...
		# sel			= map fst sel
		# mod			= hd sel
		# minf			= PR_GetModuleInfo mod project
		| isNothing minf
			= ps
		# minf			= fromJust minf
		# projco		= minf.compilerOptions
728
		# setco			= \co -> appProject (\l->PR_UpdateModules sel (\mi->{mi & compilerOptions = co}) l)
Diederik van Arkel's avatar
Diederik van Arkel committed
729 730 731 732 733 734 735 736 737 738
		= doCompilerOptionsDialog "Module Options" projco setco ps
	// work op nothing... ?!
	= ps

pm_coprefs :: !*(PSt *General) -> *PSt *General;
pm_coprefs ps
	# (prefs=:{compopts},ps) = getPrefs ps
	# setco = \co -> setPrefs {prefs & compopts = co}
	= doCompilerOptionsDialog "Module Defaults" compopts setco ps

Diederik van Arkel's avatar
Diederik van Arkel committed
739
getActiveModules ps
Diederik van Arkel's avatar
Diederik van Arkel committed
740 741
	#	(winpath,ps)		= sendToActiveWindow msgGetPathName ps
	| isNothing winpath
Diederik van Arkel's avatar
Diederik van Arkel committed
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
		# (winId,ps)		= accPIO getActiveWindow ps
		| isNothing winId
			= ([],ps)
		# winId				= fromJust winId
		# (pw,ps)			= isProjWin winId ps
		| not pw
			= ([],ps)
		# (lbId,ps)			= getPWI ps
		# ((hassel,sel),ps)	= getExtListBoxSelection lbId ps
		| hassel && notEmpty sel
			# sel			= map (MakeImpPathname o fst) sel
			# (sel,ps)		= seqList (map findModule sel) ps
			# sel			= [fromJust m \\ m <- sel | isJust m]
//			# ps = trace_n` ("Sel",listToString sel) ps
			= (sel,ps)
		= ([],ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
758
	#	winpath 			= fromJust winpath
Diederik van Arkel's avatar
Diederik van Arkel committed
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787
	| IsImpPathname winpath
		= ([winpath],ps)
	| IsDefPathname winpath
		= ([MakeImpPathname winpath],ps)
//	= trace_n` ("Regular",winpath) ([winpath],ps)
	= ([],ps)
import PmDirCache, UtilIO
//import dodebug
findModule :: !.Modulename !*(PSt General) -> (!Maybe Pathname,!*PSt General)
findModule pathname ps
	# (syspaths,ps)			= getCurrentPaths ps
	# (prj,ps)				= getProject ps
	# prjpaths				= PR_GetPaths prj
	# srcpaths				= AppendLists prjpaths syspaths
	# srcpaths				= case IsABCPathname pathname of
		True	-> Map MakeSystemPathname srcpaths
		_		-> srcpaths
	# ((ok,fullpath),ps)	= accFiles (SearchDisk False pathname srcpaths) ps
	| not ok
//		= trace_n` ("NotFound",pathname,fullpath) (Nothing, ps)
		= (Nothing, ps)
	# fullpath`				= GetLongPathName fullpath
//	= trace_n` ("Found",fullpath`) (Just fullpath`, ps)
	= (Just fullpath`, ps)

DoProcess msg compile cont ps
	# (paths,ps)			= getActiveModules ps
	# ps					= ed_ask_save_all False True (init paths) ps
	# ps					= mb_update_undoinfo ps
Diederik van Arkel's avatar
Diederik van Arkel committed
788 789
	= ps
where
Diederik van Arkel's avatar
Diederik van Arkel committed
790
	init paths ps
Diederik van Arkel's avatar
Diederik van Arkel committed
791 792 793
		#	(project,ps)		= accProject (\l->(l,l)) ps
			ps					= ew_safe_close ps
			ps					= tw_safe_close ps
Diederik van Arkel's avatar
Diederik van Arkel committed
794 795 796 797 798 799 800 801 802 803 804
		= okcont paths project ps	

	okcont [] project ps
		= final project ps
	okcont [path:paths] project ps	
		= compile path project (setproject path paths) ps
	
	setproject winpath paths ok newpaths newproject ps
		# modname				= GetModuleName winpath
		# ps					= cont winpath modname ok newpaths ps
		= okcont paths newproject ps
Diederik van Arkel's avatar
Diederik van Arkel committed
805
	
Diederik van Arkel's avatar
Diederik van Arkel committed
806 807
	final newproject ps
		# ps = closeInfo ps
Diederik van Arkel's avatar
Diederik van Arkel committed
808 809 810
		# ps = appProject (const newproject) ps
		# ps = pm_save ps
		# ps = pm_update_project_window ps
Diederik van Arkel's avatar
Diederik van Arkel committed
811
		= ps
Diederik van Arkel's avatar
Diederik van Arkel committed
812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887

pm_save_as :: !*(PSt *General) -> *PSt *General
pm_save_as ps
	# (pn,ps)	= selectOutputFile "Save Project as:" "*.prj" ps
	| isNothing pn
		= ps
	# pn		= fromJust pn
	# ps		= setPath pn ps
	# ps		= pm_save ps
	# (recId,ps) = getPHI ps
	# (_,ps)	= syncSend2 recId pn ps
	# ps		= pm_set_window_title pn ps
	= pm_menu_add pn ps

pm_save_copy_as :: !*(PSt *General) -> *PSt *General
pm_save_copy_as ps
	# (pn,ps)	= selectOutputFile "Save copy of Project as:" "*.prj" ps
	| isNothing pn
		= ps
	# pn		= fromJust pn
	#	(project,ps)	= accProject (\l->(l,l)) ps
	# (project,ps)		= pm_save_common pn project ps
	#	ps				= appProject (const project) ps
	= ps

pm_save :: !*(PSt *General) -> *PSt *General
pm_save ps
	#	(project,ps)	= accProject (\l->(l,l)) ps
		(pathname,ps)	= getPath ps
	# (project,ps) = pm_save_common pathname project ps
	#	project			= PR_SetSaved project
		ps				= appProject (const project) ps
	= ps

pm_save_common pathname project ps
	| pathname == ""
		= (project,ps)	// don't save dummy project...

	#	(startupdir,ps)	= getStup ps
		prjpath			= MakeProjectPathname pathname
		(ok,ps)			= accFiles (SaveProjectFile prjpath project startupdir) ps
	| not ok
		#	ps			= okNotice
							[ "The file "+++RemovePath prjpath+++" could not be saved because"
							, "of a file I/O error."
							] ps
		= (project,ps)
	# (prefs,ps)		= getPrefs ps
	= (project,ps)

pm_maybe_save :: !Id !*(PSt *General) -> (Bool,*PSt *General)
pm_maybe_save win ps
	// if win is project window -> save project
	# (wId,ps) = getPWW ps
	| wId == win
		= (True,pm_save ps)
	= (False,ps)

pm_set_window_title :: .Title !*(PSt *General) -> *PSt *General;
pm_set_window_title pathname ps
	# (wId,ps) = getPWW ps
	# name = RemovePath pathname
	= appPIO (setWindowTitle wId (name+++" - "+++pathname)) ps

pm_get_projwin_possiz :: *(PSt *General) -> *(.(Vector2,Size),*PSt *General);
pm_get_projwin_possiz ps
	# (wId,ps)	= getPWW ps
	# (siz,ps)	= accPIO (getWindowViewSize wId) ps
	# (vec,ps)	= accPIO (getWindowPos wId) ps
	# vec		= fromJust vec
	= ((vec,siz),ps)

isProjWin :: !Id !*(PSt *General) -> (!Bool,!*PSt *General)
isProjWin win ps
	# (wId,ps) = getPWW ps
	= (wId == win,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943

//////////////////////////////////////

extKeyboard = ControlKeyboard keyFilter Able keyboard

keyFilter :: KeyboardState -> Bool
keyFilter (CharKey '+' _)  = True
keyFilter (CharKey '-' _)  = True
keyFilter _  = False

updFstate` l ps
	# (fstate,ps)	= getFstate ps
	# fstate		= foldl update fstate l
	# ps			= setFstate fstate ps
	= ps
where
	update [] (d, u)
		= [(u,d)]
	update [e=:(_,d`):fs] (d, u)
		| d == d` = [(u,d):fs]
		= [e:update fs (d, u)]

keyboard (CharKey '+' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,items,lineHeight,funs,shiftfuns},ls),ps)
		| not hasSelection
			= ((lbState,ls),ps)
		# (appPath,ps)	= getStup ps
		# (prjPath,ps)	= getPath ps
		# ps = updFstate` (map (\(p,b)-> (fulPath appPath prjPath p,b)) selItems) ps
		# ps = pm_update_project_window_interactive ps
		= ((lbState,ls),ps)
where
	nrItems		= length items
	customId	= listboxId.controlId
	hasSelection
		| isEmpty selection = False
		= True
	lastSelection = hd selection
	selItems = [(items!!(x-1)%(6,256),True) \\ x <- selection | items!!(x-1)%(0,5) == "//--- " || items!!(x-1)%(0,5) == "\\\\--- "]
keyboard (CharKey '-' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,items,lineHeight,funs,shiftfuns},ls),ps)
		| not hasSelection
			= ((lbState,ls),ps)
		# (appPath,ps)	= getStup ps
		# (prjPath,ps)	= getPath ps
		# ps = updFstate` (map (\(p,b)-> (fulPath appPath prjPath p,b)) selItems) ps
		# ps = pm_update_project_window_interactive ps
		= ((lbState,ls),ps)
where
	nrItems		= length items
	customId	= listboxId.controlId
	hasSelection
		| isEmpty selection = False
		= True
	lastSelection = hd selection
	selItems = [(items!!(x-1)%(6,256),False) \\ x <- selection | items!!(x-1)%(0,5) == "//--- " || items!!(x-1)%(0,5) == "\\\\--- "]
keyboard _ state
	= state