edoptions.icl 20.9 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
implementation module edoptions

import StdTuple, StdEnum, StdList, StdFunc, StdMisc
import StdMenu, StdWindow, StdId, StdPSt, StdControl
import StdClipboard, StdControlReceiver
import EdKeyMapping, EdState, EdClient, EdKeyboard
7
import IDE, IdeState, ExtNotice, UtilIO
Diederik van Arkel's avatar
Diederik van Arkel committed
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
import colorpickcontrol
import ioutil, morecontrols
import typewin, colourclip
import PmPath

//-- public

optionsKeyMapping :: !*(PSt *b) -> *PSt *b | Editor b;
optionsKeyMapping ps
	#	(ed,ps)			= getEditorState ps
		keyMapping		= getKeyMapping ed
		ps				= configureKeyMapping keyMapping myset ps
	= ps  
where
	myset keymap ps
		#	(ed,ps)			= getEditorState ps
			ed				= setKeyMapping keymap ed
			ps				= setEditorState ed ps
		= ps

//--

:: ECLS = {ids::[Id],act::Int,cls::[Colour],mfs::EditMenuLS General}

froot txt ps
	# (id,ps) = accPIO openId ps
	# (_,ps) = openModalDialog 0 (Dialog txt NilLS [WindowClose (noLS (closeWindow id)),WindowId id]) ps
	= ps

editColours :: !*(PSt *General) -> *(PSt *General)
editColours ps
	# (prefs,ps)		= getPrefs ps
	# (rgbid,ps)		= openRGBId  ps
	# (lsid,ps)			= openRId ps
	# (wId,ps)			= openId ps
	# (okId,ps)			= openId ps
	# (cancelId,ps)		= openId ps
45
	# (ids,ps)			= openIds 27 ps
Diederik van Arkel's avatar
Diederik van Arkel committed
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
	# cls =
							[ prefs.syncols.textColour
							, prefs.defcols.textColour
							, prefs.impcols.textColour
							, prefs.syncols.tabColour
							, prefs.defcols.tabColour
							, prefs.impcols.tabColour
							, prefs.syncols.commentColour
							, prefs.defcols.commentColour
							, prefs.impcols.commentColour
							, prefs.syncols.stringColour
							, prefs.defcols.stringColour
							, prefs.impcols.stringColour
							, prefs.syncols.charColour
							, prefs.defcols.charColour
							, prefs.impcols.charColour
							, prefs.syncols.backgroundColour
							, prefs.defcols.backgroundColour
							, prefs.impcols.backgroundColour
							, prefs.syncols.keywordColour
							, prefs.defcols.keywordColour
							, prefs.impcols.keywordColour
Diederik van Arkel's avatar
Diederik van Arkel committed
68
69
70
							, prefs.syncols.typedefColour
							, prefs.defcols.typedefColour
							, prefs.impcols.typedefColour
71
72
73
							, prefs.syncols.typedeclColour
							, prefs.defcols.typedeclColour
							, prefs.impcols.typedeclColour
Diederik van Arkel's avatar
Diederik van Arkel committed
74
75
76
77
78
79
80
81
							]
	# wloc				= {act=0,ids=ids,cls=cls,mfs={zfun=froot "options - Z",xfun=froot "options - X",cfun=id,vfun=id}}
	# (siz,ps)			= controlSize
							(ColourBoxControl`` rgbid lsid cls ids 1 Nothing)
							False
							(Just (0,0))
							(Just (0,0))
							(Just (0,0)) ps
82
83
	# buttonWidth		= ContentWidth "Cancel"
	# (ilook,wloc)		= idslook wloc
Diederik van Arkel's avatar
Diederik van Arkel committed
84
	# (dback,ps)		= GetDialogBackgroundColour ps
Diederik van Arkel's avatar
Diederik van Arkel committed
85
	# wdef				= Dialog "Editor Colours"
86
							(	RGBColourPickControl` rgbid (prefs.syncols.textColour) ilook Nothing
Diederik van Arkel's avatar
Diederik van Arkel committed
87
							:+: ButtonControl "&Copy"
Diederik van Arkel's avatar
Diederik van Arkel committed
88
								[ ControlFunction (copyFun wId rgbid)
Diederik van Arkel's avatar
Diederik van Arkel committed
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
								, ControlWidth buttonWidth
								]
							:+: ButtonControl "&Paste"
								[ ControlFunction (pasteFun wId rgbid)
								, ControlPos (BelowPrev,zero)
								, ControlWidth buttonWidth
								]
							:+: ButtonControl "&Apply"
								[ ControlFunction (applyFun rgbid lsid)
								, ControlPos (BelowPrev,zero)
								, ControlWidth buttonWidth
								]
							:+: ButtonControl "Ca&ncel"
								[ ControlFunction (cancelFun wloc wId)
								, ControlId cancelId
								, ControlPos (BelowPrev,zero)
								, ControlWidth buttonWidth
								]
							:+: ButtonControl "&OK"
								[ ControlFunction (okFun rgbid lsid wId)
								, ControlId okId
								, ControlPos (BelowPrev,zero)
								, ControlWidth buttonWidth
								]
							:+: TextControl ".xxx" [ControlWidth (PixelWidth siz.w),ControlPos (Left,zero)]
							:+: TextControl ".dcl" [ControlWidth (PixelWidth siz.w)]
							:+: TextControl ".icl" [ControlWidth (PixelWidth siz.w)]
							:+: ColourBoxControl`` rgbid lsid cls ids 0 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 1 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 2 Nothing
							:+: TextControl "Text" []

							:+: ColourBoxControl`` rgbid lsid cls ids 3 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 4 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 5 Nothing
							:+: TextControl "Tabs" []

							:+: ColourBoxControl`` rgbid lsid cls ids 6 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 7 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 8 Nothing
							:+: TextControl "Comments" []

							:+: ColourBoxControl`` rgbid lsid cls ids 9 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 10 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 11 Nothing
							:+: TextControl "Strings" []

							:+: ColourBoxControl`` rgbid lsid cls ids 12 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 13 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 14 Nothing
							:+: TextControl "Chars" []

							:+: ColourBoxControl`` rgbid lsid cls ids 15 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 16 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 17 Nothing
144
							:+: TextControl "Background" []
Diederik van Arkel's avatar
Diederik van Arkel committed
145
146
147
148
149

							:+: ColourBoxControl`` rgbid lsid cls ids 18 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 19 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 20 Nothing
							:+: TextControl "Keywords" []
Diederik van Arkel's avatar
Diederik van Arkel committed
150
151
152
153
154
155

							:+: ColourBoxControl`` rgbid lsid cls ids 21 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 22 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 23 Nothing
							:+: TextControl "Typedefs" []

156
157
158
159
160
							:+: ColourBoxControl`` rgbid lsid cls ids 24 (Just (Left,zero))
							:+: ColourBoxControl`` rgbid lsid cls ids 25 Nothing
							:+: ColourBoxControl`` rgbid lsid cls ids 26 Nothing
							:+: TextControl "Typedecls" []

Diederik van Arkel's avatar
Diederik van Arkel committed
161
162
							:+: Receiver lsid lsfun []
							)
163
							[ WindowPen [PenBack dback]
Diederik van Arkel's avatar
Diederik van Arkel committed
164
165
166
167
168
169
170
171
172
							, WindowClose 	(cancelFun wloc wId)
							, WindowId wId
							, WindowInit (setBoxCol)
							, WindowOk okId
							, WindowCancel cancelId
							]
	# (_,ps) = openModalDialog wloc wdef ps
	= ps
where
Diederik van Arkel's avatar
Diederik van Arkel committed
173
	copyFun wId rId (ls=:{cls,act},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
174
175
		// get active colour control
		// and put in clipboard
Diederik van Arkel's avatar
Diederik van Arkel committed
176
177
178
179
//		# cur	= cls!!act
//		# ps	= setClipboard [toClipboard (toString cur)] ps
//		= (ls,ps)
		# ps	= getColourBoxColour rId cont ps
Diederik van Arkel's avatar
Diederik van Arkel committed
180
		= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
181
182
183
184
185
186
	where
		cont col ps
				| isNothing col = ps
				# col	= fromJust col
				# ps	= setClipboard [toClipboard (toString col)] ps
				= ps
187
	pasteFun wId rId (ls=:{cls,act},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
188
189
190
191
192
193
194
195
196
197
198
199
		// 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)
200
		# ls		= {ls & cls = updateAt act (fromString it) cls}
Diederik van Arkel's avatar
Diederik van Arkel committed
201
		# (ls,ps)	= setBoxCol (ls,ps)
202
203
		# (clook,ls)= clslook ls
		# ps		= setColourBoxColour` rId clook ps
Diederik van Arkel's avatar
Diederik van Arkel committed
204
205
206
207
208
209
210
211
212
213
214
		= (ls,ps)
	ColourBoxControl`` rgbid lsid cls ids x p
		= ColourBoxControl` (toRGBColour (cls!!x)) (ids!!x) (mstuff rgbid lsid x) p
	where
		mstuff rgbid lsid x = (mfilter,mfunction rgbid lsid x)
		mfilter (MouseDown _ _ _) = True
		mfilter _ = False
		mfunction rgbid lsid x _ (ls,ps)
			= updateActiveInLS rgbid lsid cont (ls,ps)
		where
			cont (ls,ps)
215
216
217
				# (ilook,ls)	= idslook ls
				# (clook,ls)	= clslook ls
				# ps	= appPIO (SetColourBox ilook (toRGBColour clook)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
218
				# ls	= {ls & act = x}
219
220
221
222
223
				# (ilook,ls)	= idslook ls
				# (clook,ls)	= clslook ls
				# ps	= appPIO (SetColourBox` ilook (toRGBColour clook)) ps
				# ps	= setColourBoxId rgbid ilook ps
				# ps	= setColourBoxColour` rgbid clook ps
Diederik van Arkel's avatar
Diederik van Arkel committed
224
225
226
				= (ls,ps)

	setBoxCol (ls,ps)
227
228
229
		# (ilook,ls)	= idslook ls
		# (clook,ls)	= clslook ls
		# ps = appPIO (SetColourBox` ilook (toRGBColour clook)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
230
		= (ls,ps)
231
232
	idslook ls=:{ids,act} = (ids!!act, ls)
	clslook ls=:{cls,act} = (cls!!act, ls)
Diederik van Arkel's avatar
Diederik van Arkel committed
233
234
235
236
237
238
239
240
241
242
243
244
245
	toStringC :: !Colour -> String
	toStringC c = toString c
	lsfun f (ls,ps) = f (ls,ps)

	updateActiveInLS rgbid lsid cont3 (ls,ps)
		# ps = getColourBoxColour rgbid cont ps
		= (ls,ps)
	where
		cont col ps
				| isNothing col = ps
				# col = fromJust col
				# (_,ps) = asyncSend lsid (cont2 col) ps
				= ps
246
247
		cont2 col (ls=:{act,cls},ps)
				# ls	= {ls & cls = updateAt act col cls}
Diederik van Arkel's avatar
Diederik van Arkel committed
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
				= cont3 (ls,ps)

	okFun rgbid lsid wId (ls,ps)
		= updateActiveInLS rgbid lsid cont (ls,ps)
	where
		cont (ls,ps)
			# (ls,ps) = apply (ls,ps)
			= (ls, closeWindow wId ps)
	
	cancelFun inils wId (_,ps)
		# (ls,ps) = apply (inils,ps)
		= (ls, closeWindow wId ps)
	
	applyFun rgbid lsid (ls,ps)
		= updateActiveInLS rgbid lsid apply (ls,ps)

264
	apply (ls=:{cls},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
265
266
267
		# (prefs,ps)	= getPrefs ps
		# syncols` =
							{ prefs.syncols
268
269
270
271
272
273
274
							& textColour		= cls!!0
							, tabColour			= cls!!3
							, commentColour		= cls!!6
							, stringColour		= cls!!9
							, charColour		= cls!!12
							, backgroundColour	= cls!!15
							, keywordColour		= cls!!18
Diederik van Arkel's avatar
Diederik van Arkel committed
275
							, typedefColour		= cls!!21
276
							, typedeclColour	= cls!!24
Diederik van Arkel's avatar
Diederik van Arkel committed
277
278
279
							}
		# defcols` =
							{ prefs.defcols
280
281
282
283
284
285
286
							& textColour		= cls!!1
							, tabColour			= cls!!4
							, commentColour		= cls!!7
							, stringColour		= cls!!10
							, charColour		= cls!!13
							, backgroundColour	= cls!!16
							, keywordColour		= cls!!19
Diederik van Arkel's avatar
Diederik van Arkel committed
287
							, typedefColour		= cls!!22
288
							, typedeclColour	= cls!!25
Diederik van Arkel's avatar
Diederik van Arkel committed
289
290
291
							}
		# impcols` =
							{ prefs.impcols
292
293
294
295
296
297
298
							& textColour		= cls!!2
							, tabColour			= cls!!5
							, commentColour		= cls!!8
							, stringColour		= cls!!11
							, charColour		= cls!!14
							, backgroundColour	= cls!!17
							, keywordColour		= cls!!20
Diederik van Arkel's avatar
Diederik van Arkel committed
299
							, typedefColour		= cls!!23
300
							, typedeclColour	= cls!!26
Diederik van Arkel's avatar
Diederik van Arkel committed
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
332
333
334
335
336
							}
		# prefs				= {prefs & syncols = syncols`, defcols = defcols`, impcols = impcols`}
		# ps				= setPrefs prefs ps
		# (windows,ps)		= accPIO getWindowsStack ps
		# ps				= doall prefs windows ps
		= (ls,ps)
	where
		doall prefs [] ps
			= ps
		doall prefs [win:rest] ps
			// need to ignore special edit windows, ie clipboard & types window...
			# (isclip,ps) = isClipboardWindow win ps
			| isclip
				= doall prefs rest ps
			# (twi,ps) = accPLoc getTypeWinInfo ps
			| isTypeWindow win twi
				= doall prefs rest ps
			# (pn,ps)		= message win (getPathName) ps
			| isNothing pn
				= doall prefs rest ps
			# pn			= fromJust pn
			# cols			= if (IsDefPathname pn) (prefs.defcols) (if (IsImpPathname pn) (prefs.impcols) (prefs.syncols))
			# (_,ps)		= message win (appFontInfo (fi_update cols)) ps
			# ps			= appPIO (updateWindow win Nothing) ps
			= doall prefs rest ps
		fi_update cols fi =
			{ fi
			& syntaxColours =
				{ fi.syntaxColours
				& textColour		= cols.textColour
				, tabColour			= cols.tabColour
				, commentColour		= cols.commentColour
				, stringColour		= cols.stringColour
				, charColour		= cols.charColour
				, backgroundColour	= cols.backgroundColour
				, keywordColour		= cols.keywordColour
Diederik van Arkel's avatar
Diederik van Arkel committed
337
				, typedefColour		= cols.typedefColour
338
				, typedeclColour	= cols.typedeclColour
Diederik van Arkel's avatar
Diederik van Arkel committed
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
				}
			}

defaultColours :: !*(PSt *General) -> *(PSt *General)
defaultColours ps
	# (prefs,ps)		= getPrefs ps
	# (rgbid,ps)		= openRGBId  ps
	# (wId,ps)			= openId ps
	# wloc				= 0
	# col				= case wloc of
								0 -> prefs.syncols.textColour
								1 -> prefs.syncols.tabColour
								2 -> prefs.syncols.commentColour
								3 -> prefs.syncols.stringColour
								4 -> prefs.syncols.charColour
								5 -> prefs.syncols.backgroundColour
								6 -> prefs.syncols.keywordColour
Diederik van Arkel's avatar
Diederik van Arkel committed
356
								7 -> prefs.syncols.typedefColour
357
								8 -> prefs.syncols.typedeclColour
Diederik van Arkel's avatar
Diederik van Arkel committed
358
								_ -> abort "edoptions[defaultColours]: unknown ls"
359
	# (dback,ps) = GetDialogBackgroundColour ps
Diederik van Arkel's avatar
Diederik van Arkel committed
360
361
362
363
364
365
366
367
368
369
	# wdef				= Dialog "Pick a colour"
							(	RGBColourPickControl rgbid col Nothing
							:+: PopUpControl
									[("Text"		,psel rgbid 0)
									,("Tabs"		,psel rgbid 1)
									,("Comments"	,psel rgbid 2)
									,("Strings"		,psel rgbid 3)
									,("Chars"		,psel rgbid 4)
									,("Background"	,psel rgbid 5)
									,("Keywords"	,psel rgbid 6)
Diederik van Arkel's avatar
Diederik van Arkel committed
370
									,("Typedefs"	,psel rgbid 7)
371
									,("Typedecls"	,psel rgbid 8)
Diederik van Arkel's avatar
Diederik van Arkel committed
372
373
374
									] wloc []
							:+: ButtonControl "Set" [ControlFunction (cset rgbid)]
							)
375
							[	WindowPen [PenBack dback]
Diederik van Arkel's avatar
Diederik van Arkel committed
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
							,	WindowClose 	(dlogClose wId)
							,	WindowId wId
							]
	# (_,ps) = openModalDialog wloc wdef ps
	= ps
where
	dlogClose wId (ls,ps)
		# ps				= closeWindow wId ps
		= (ls,ps)
	psel rid i (ls,ps)
		# (prefs,ps)	= getPrefs ps
		# col			= case i of
								0 -> prefs.syncols.textColour
								1 -> prefs.syncols.tabColour
								2 -> prefs.syncols.commentColour
								3 -> prefs.syncols.stringColour
								4 -> prefs.syncols.charColour
								5 -> prefs.syncols.backgroundColour
								6 -> prefs.syncols.keywordColour
Diederik van Arkel's avatar
Diederik van Arkel committed
395
								7 -> prefs.syncols.typedefColour
396
								8 -> prefs.syncols.typedeclColour
Diederik van Arkel's avatar
Diederik van Arkel committed
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
								_ -> abort "edoptions[defaultColours]: also unknown ls"
		# ps = setColourBoxColour rid col ps
		= (i,ps)
	cset rid (ls,ps)
		# ps = getColourBoxColour rid cont ps
		= (ls,ps)
	where
		cont col ps
			| isNothing col = ps
			# col = fromJust col
			# (prefs,ps)		= getPrefs ps
			# prefs				= {prefs & syncols = sc_update ls prefs.syncols col}
			# ps				= setPrefs prefs ps
			# (windows,ps)		= accPIO getWindowsStack ps
			= doall prefs windows ps

		sc_update 0 sc col = {sc & textColour		= col}
		sc_update 1 sc col = {sc & tabColour		= col}
		sc_update 2 sc col = {sc & commentColour	= col}
		sc_update 3 sc col = {sc & stringColour		= col}
		sc_update 4 sc col = {sc & charColour		= col}
		sc_update 5 sc col = {sc & backgroundColour	= col}
		sc_update 6 sc col = {sc & keywordColour	= col}
Diederik van Arkel's avatar
Diederik van Arkel committed
420
		sc_update 7 sc col = {sc & typedefColour	= col}
421
		sc_update 8 sc col = {sc & typedeclColour	= col}
Diederik van Arkel's avatar
Diederik van Arkel committed
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
		sc_update _ sc col = abort "edoptions[defaultColours:sc_update]: unknown ls"

		doall prefs [] ps
			= ps
		doall prefs [win:rest] ps
			# (pn,ps)		= message win (getPathName) ps
			| isNothing pn
				= doall prefs rest ps
			# pn			= fromJust pn
			| IsDefPathname pn || IsImpPathname pn
				= doall prefs rest ps
			# (_,ps)		= message win (appFontInfo (fi_update prefs)) ps
			# ps = appPIO (updateWindow win Nothing) ps
			= doall prefs rest ps
		fi_update prefs fi =
			{ fi
			& syntaxColours =
				{ fi.syntaxColours
				& textColour		= prefs.syncols.textColour
				, tabColour			= prefs.syncols.tabColour
				, commentColour		= prefs.syncols.commentColour
				, stringColour		= prefs.syncols.stringColour
				, charColour		= prefs.syncols.charColour
				, backgroundColour	= prefs.syncols.backgroundColour
				, keywordColour		= prefs.syncols.keywordColour
Diederik van Arkel's avatar
Diederik van Arkel committed
447
				, typedefColour		= prefs.syncols.typedefColour
448
				, typedeclColour	= prefs.syncols.typedeclColour
Diederik van Arkel's avatar
Diederik van Arkel committed
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
				}
			}

lineFun :: Id .Bool *(PSt *b) -> *PSt *b | Editor b;
lineFun window linenumbers ps 
	#	(_, ps)				= message window (setLineNumbers linenumbers) ps
	= ps

syncFun :: Id .Bool *(PSt *b) -> *PSt *b | Editor b;
syncFun window syntaxcolor ps 
	#	(_, ps)				= message window (appFontInfo (\fi->{fi & showSyntax = syntaxcolor})) ps
	# ps = appPIO (updateWindow window Nothing) ps
	= ps

// perform an operation on the font of the given window

fontAction :: Id .(FontDef -> .FontDef) *(PSt *c )-> *(PSt *c) | Editor c;
fontAction window fontChange ps 
	# (font, ps)			= message window msgGetFont ps
	| isNothing font
		= ps
	# font					= fromJust font
	# fontDef				= getFontDef font
	# newFontDef			= fontChange fontDef
473
	# (newFont, ps)			= safeOpenFont newFontDef ps
Diederik van Arkel's avatar
Diederik van Arkel committed
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
	# (r, ps)				= message window (msgSetFont newFont) ps
	| isNothing r
		= ps
	= ps

// perform an operation on the tabs of the given window

formatTabs :: Id .Int *(PSt *b) -> *PSt *b | Editor b;
formatTabs window tabSize pstate
	= tabsAction window changeTabs pstate
where
	changeTabs (t,a,s) = (tabSize,a,s)

autoTabs :: Id .Bool *(PSt *b) -> *PSt *b | Editor b;
autoTabs  window autoTab pstate
	= tabsAction window changeAuto pstate
where
	changeAuto (t,a,s) = (t,autoTab,s)

showTabs :: Id .Bool *(PSt *b) -> *PSt *b | Editor b;
showTabs window showTab pstate
	= tabsAction window changeShow pstate
where
	changeShow (t,a,s) = (t,a,showTab)

tabsAction :: Id .((Int,Bool,Bool) -> (.Int,.Bool,.Bool)) *(PSt *b) -> *PSt *b | Editor b;
tabsAction window tabsChange ps 
	#	(tabs, ps)				= message window msgGetTabs ps
	| isNothing tabs
		= ps
	#	tabs					= fromJust tabs
		newTabs					= tabsChange tabs
		(_, ps)					= message window (msgSetTabs newTabs) ps
	= ps

//--

defaultFontAndTabs :: !*(PSt *General) -> *(PSt *General)
defaultFontAndTabs ps
	# (names, ps) = accPIO (accScreenPicture getFontNames) ps
	// filter fixed width fonts....
515
516
//	# (fixed,ps) = seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) names) ps
	# (fixed,ps) = accPIO (accScreenPicture (seqList (map lisFixedWidth names))) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
	# names = lfilter fixed names
	# (prefs,ps) = getPrefs ps
	# fontdef = prefs.edwinfont
	# (initabs,iniauto,inishow,iniline,inisync) = prefs.edwintabs
	# fontname = fontdef.fName
	# fontsize = fontdef.fSize
	# fontSizes = [7, 8, 9, 10, 12, 14, 18, 24 ]
	# inistate = (initabs,iniauto,inishow,iniline,inisync)
	# (dialogId,ps)		= openId ps
	# (okId,ps)		= openId ps
	# (tabsId,ps)		= openId ps
	# (cancelId,ps)		= openId ps
	# controls
		=	FontNameSizeControl fontname fontsize names fontSizes fontfun sizefun [ left ]
		:+:	TextControl "Tabs every" [ left ]
532
533
534
535
536
		:+:	EditControl (toString initabs) (PixelWidth 30) 1
			[ ControlKeyboard (const True) Able (\_ -> (tabsfun dialogId tabsId))
			, ControlId tabsId
			, ControlActivate (noLS (appPIO (setEditControlSelection tabsId 1 0)))
			] 
Diederik van Arkel's avatar
Diederik van Arkel committed
537
538
539
540
541
542
543
544
545
546
547
548
549
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
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
		:+:	TextControl "characters" []
		:+: CheckControl
			[("Auto Indent"		,Nothing,toMark iniauto,(autofun))
			,("Show Tabs"		,Nothing,toMark inishow,(showfun))
			,("Show LineNrs"	,Nothing, toMark iniline, (linefun))
			,("Syntax Colouring"		,Nothing, toMark inisync, (syncfun))
			]
			(Columns 1)
			[left]
    	:+:	ButtonControl "OK"
			[ ControlId okId
			, ControlFunction (okfun dialogId) 
			, ControlPos (Right, zero)
			, ControlWidth (ContentWidth "Cancel")
			]
    	:+:	ButtonControl "Cancel"
			[ ControlPos (LeftOfPrev, zero) 
			, ControlFunction (cancelfun dialogId inistate fontname fontsize)
			, ControlId cancelId
			] 
    	:+:	ButtonControl "Apply"
			[ ControlPos (LeftOfPrev, zero) 
			, ControlFunction (applyfun)
			] 
	# dialog
		= Dialog "Editor Settings" controls 
	  		[ WindowId dialogId 
	  		, WindowOk okId
	  		, WindowCancel cancelId
	  		, WindowClose (cancelfun dialogId inistate fontname fontsize)
	  		]
	# (_,ps) = openModalDialog inistate dialog ps
	= ps
where
    cancelfun dialogId inistate fontname fontsize (ls,ps)
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = inistate, edwinfont = {prefs.edwinfont & fName = fontname, fSize = fontsize}} ps
     	# (ls,ps) = apply (ls,ps)
     	= (ls, closeWindow dialogId ps)
    applyfun (ls,ps)
    	= apply (ls,ps)
    okfun dialogId (ls,ps)
    	# (ls,ps) = apply (ls,ps)
    	= (ls, closeWindow dialogId ps)
    left = ControlPos (Left, zero)
    fontfun name (ls,ps)
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwinfont = {prefs.edwinfont & fName = name}} ps
    	= (ls,ps)
    sizefun size (ls,ps)
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwinfont = {prefs.edwinfont & fSize = size}} ps
    	= (ls,ps)
    tabsfun dialogId tabsId ((t,a,s,l,c),ps)
    	# (wstate,ps)	= accPIO (getWindow dialogId) ps
    	| isNothing wstate = ((t,a,s,l,c),ps)
    	# wstate		= fromJust wstate
    	# [(ok,mt):_]	= getControlTexts [tabsId] wstate
    	| not ok = ((t,a,s,l,c),ps)
    	| isNothing mt = ((t,a,s,l,c),ps)
    	# t				= fromJust mt
    	# t				= toInt t
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c)} ps
    	= ((t,a,s,l,c),ps)
    autofun ((t,a,s,l,c),ps)
    	# a = not a
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c)} ps
    	= ((t,a,s,l,c),ps)
    showfun ((t,a,s,l,c),ps)
    	# s = not s
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c)} ps
    	= ((t,a,s,l,c),ps)	
    linefun ((t,a,s,l,c),ps)
    	# l = not l
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c)} ps
    	= ((t,a,s,l,c),ps)
    syncfun ((t,a,s,l,c),ps)
    	# c = not c
     	# (prefs,ps) = getPrefs ps
    	# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c)} ps
    	= ((t,a,s,l,c),ps)
	apply (ls,ps)
		# (prefs,ps)		= getPrefs ps
		# (windows,ps)		= accPIO getWindowsStack ps
		# ps				= doall prefs windows ps
		= (ls,ps)
	where
		doall prefs [] ps
			= ps
		doall prefs [win:rest] ps
			// need to ignore special edit windows, ie clipboard & types window...
			# (isclip,ps) = isClipboardWindow win ps
			| isclip
				= doall prefs rest ps
			# (twi,ps) = accPLoc getTypeWinInfo ps
			| isTypeWindow win twi
				= doall prefs rest ps
			# (pn,ps)		= message win (getPathName) ps
			| isNothing pn
				= doall prefs rest ps
			# (t,a,s,l,c)	= prefs.edwintabs
			# fontname		= prefs.edwinfont.fName
			# fontsize		= prefs.edwinfont.fSize
	    	# ps			= formatTabs win t ps
			# ps			= autoTabs win a ps
	    	# ps			= showTabs win s ps
		   	# ps			= lineFun win l ps
	    	# ps			= syncFun win c ps
	    	# ps			= fontAction win (\fontdef->{fontdef & fName = fontname, fSize = fontsize}) ps
			= doall prefs rest ps