Commit 328918cb authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

added configurable right margin with different background colour

parent 7e569570
......@@ -39,6 +39,7 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
, tabSize :: !TabSize // logical in #chars
// , tabWidth :: !NewTabSize // physical in #pixels
, charWidth :: !Int // physical in #pixels
, marginWidth :: !Int // logical in #chars
, autoTab :: !Bool
, showTabs :: !Bool
, showSyntax :: !Bool
......@@ -48,6 +49,7 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
:: SyntaxColours =
{ textColour :: !Colour
, backgroundColour :: !Colour
, marginColour :: !Colour
, tabColour :: !Colour
, commentColour :: !Colour
, stringColour :: !Colour
......@@ -87,7 +89,7 @@ instance toString UndoState
:: EditMonad env a :== StateM *(!EditState, env) a
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt .l) -> (EditState , *PSt .l)
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !Int !SyntaxColours !*(PSt .l) -> (EditState , *PSt .l)
appEnv :: (.env -> .env) -> EditMonad .env nothing
accEnv :: (.env -> (.a, .env)) -> EditMonad .env .a
noResult :: !(EditMonad .env a) *(EditState, .env) -> (EditState, .env)
......
......@@ -76,6 +76,7 @@ trace_n` _ s :== s
, tabSize :: !TabSize // logical tabsize
// , tabWidth :: !NewTabSize // physical tabsize
, charWidth :: !Int // physical in #pixels
, marginWidth :: !Int // logical in #chars
, autoTab :: !Bool
, showTabs :: !Bool
, showSyntax :: !Bool
......@@ -85,6 +86,7 @@ trace_n` _ s :== s
:: SyntaxColours =
{ textColour :: !Colour
, backgroundColour :: !Colour
, marginColour :: !Colour
, tabColour :: !Colour
, commentColour :: !Colour
, stringColour :: !Colour
......@@ -156,10 +158,10 @@ where
/* EXPORTED FUNCTIONS */
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt .l) -> (EditState, *PSt .l)
initEditState windowId eUndoId pathName font tabs=:(_,_,_,linenos,showSynCol) syncols pstate
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !Int !SyntaxColours !*(PSt .l) -> (EditState, *PSt .l)
initEditState windowId eUndoId pathName font tabs=:(_,_,_,linenos,showSynCol) margin syncols pstate
# (tId,pstate) = openId pstate // P4
# (fontInfo, pstate) = computeFontInfo font tabs syncols pstate
# (fontInfo, pstate) = computeFontInfo font tabs margin syncols pstate
= ( { text = newText
, pathName = pathName
, windowId = windowId
......@@ -349,14 +351,14 @@ setFont :: Font -> EditMonad (PSt .l) nothing
setFont font = monad
where
monad (editState,pState)
# ({tabSize,autoTab,showTabs,showSyntax,syntaxColours},(editState,pState))
# ({tabSize,autoTab,showTabs,showSyntax,marginWidth,syntaxColours},(editState,pState))
= getFontInfo (editState,pState)
# (linenos,(editState,pState))
= getLineNumbers (editState,pState)
# tabs
= (tabSize,autoTab,showTabs,linenos,showSyntax)
# (fontInfo,(editState,pState))
= accEnv (computeFontInfo font tabs syntaxColours) (editState,pState)
= accEnv (computeFontInfo font tabs marginWidth syntaxColours) (editState,pState)
# (_,(editState,pState))
= updateEditState (update fontInfo) (editState,pState)
# (_,(editState,pState))
......@@ -388,8 +390,8 @@ updateLook
// compute some properties of a font
computeFontInfo :: !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !(PSt .l) -> (FontInfo, PSt .l)
computeFontInfo font (tabSize,autoTab,showTabs,_,showSynCol) syncols pstate
computeFontInfo :: !Font !(Int,Bool,Bool,Bool,Bool) !Int !SyntaxColours !(PSt .l) -> (FontInfo, PSt .l)
computeFontInfo font (tabSize,autoTab,showTabs,_,showSynCol) marginWidth syncols pstate
# (metrics, pstate) = accPIO (accScreenPicture (getFontMetrics font)) pstate
lineHeight = metrics.fAscent + metrics.fDescent + metrics.fLeading
(charWidth,pstate) = accPIO (accScreenPicture (getFontStringWidth font "M")) pstate
......@@ -399,6 +401,7 @@ computeFontInfo font (tabSize,autoTab,showTabs,_,showSynCol) syncols pstate
, tabSize = tabSize
, autoTab = autoTab
, charWidth = charWidth
, marginWidth = marginWidth
, showTabs = showTabs
, showSyntax = showSynCol
, syntaxColours = syncols
......@@ -411,6 +414,7 @@ DefaultSyntaxColours =
{ textColour = Black
, tabColour = Red
, backgroundColour = White
, marginColour = White
, commentColour = Blue
, stringColour = Green
, charColour = Magenta
......
......@@ -252,11 +252,18 @@ vDrawCursor show end cursorHeight text fontInfo =
{ x=x, y=y+cursorHeight - 1 }
]))
(seq
[ setPenColour (fontInfo.syntaxColours.backgroundColour)
[ setPenColour (backcolour x fontInfo)
, drawLine { x=x, y=y }
{ x=x, y=y+cursorHeight - 1 }
])
)
where
backcolour :: Int FontInfo -> Colour
backcolour x {charWidth, marginWidth, syntaxColours}
| marginWidth > 0 && x >= charWidth * marginWidth
= syntaxColours.marginColour
// otherwise
= syntaxColours.backgroundColour
//--- Visual Selection Stuff
vUpdateSelection :: !Selection FontInfo Text ViewFrame [Rectangle] -> (*Picture -> *Picture)
......
......@@ -151,6 +151,10 @@ vRemoveText selection=:{ start=start=:{ col=col1,row=row1 }
// updating a rectangle is done by first erasing it and then redrawing
// the lines contained in that rectangle
// FIXME: this code assumes that corner1 of the rectangle is the upper left
// and corner2 the lower right corner, which is not garantueed by the ObjectIO
// (although in practice it is)
//vUpdateRectangle :: Text FontInfo Rectangle *Picture -> *Picture//-> EditMonad *Picture nothing
vUpdateRectangle text fontInfo=:{lineHeight,thefont,syntaxColours} rectangle=:{ corner1 = {x=x1,y=y1}, corner2 = {x=x2,y=y2} } //pict =
// compute which lines were affected and retrieve them
......@@ -163,12 +167,27 @@ where
# region` = toRegion rectangle`
# pict = appClipPicture region` (seq
[ setPenFont thefont
, setPenBack syntaxColours.backgroundColour
, unfill rectangle`
, drawBackground syntaxColours fontInfo rectangle`
, drawLines lineNr1 lineNr2 fontInfo text
]) pict
= pict
// drawBackground colours the background
drawBackground colours {charWidth, marginWidth} r=:{ corner1 = {x=x1,y=y1}, corner2 = {x=x2,y=y2} }
| marginWidth <= 0
= seq [ setPenBack colours.backgroundColour
, unfill r
]
// otherwise
= seq [ setPenBack colours.backgroundColour
, unfill {r & corner2.x = margin}
, setPenBack colours.marginColour
, unfill {r & corner1.x = margin}
]
where
margin
= marginWidth * charWidth
// drawLines draws the lines in the range indicated by
// the first two arguments, e.g. drawLines 0 3 draws the
// text lines 0, 1, 2, and 3.
......
......@@ -19,6 +19,7 @@ openEditWindow ::
Text // initial text
!Font // initial font
(Int,Bool,Bool,Bool,Bool) // tabs
Int // right margin (0 means no margin)
SyntaxColours // syntax colours
Id // window id
[.WindowAttribute *(EditState,*PSt *b)] // initial attributes
......
......@@ -9,14 +9,14 @@ import ioutil
//---
openEditWindow :: Id .Title String Text !Font (Int,Bool,Bool,Bool,Bool) SyntaxColours Id [.WindowAttribute *(EditState,*PSt *b)] !*(PSt *b) -> *PSt *b | Editor b
openEditWindow uId title pathName text font tabs syncols windowId atts ps
openEditWindow :: Id .Title String Text !Font (Int,Bool,Bool,Bool,Bool) Int SyntaxColours Id [.WindowAttribute *(EditState,*PSt *b)] !*(PSt *b) -> *PSt *b | Editor b
openEditWindow uId title pathName text font tabs margin syncols windowId atts ps
# (editorState,ps) = getEditorState ps
// generate a receiver identifier and store it in the editor state
# (editId, ps) = openEditId ps
editorState = addReceiver windowId editId editorState
// create the local state of the editor window
# (editState, ps) = initEditState windowId uId pathName font tabs syncols ps
# (editState, ps) = initEditState windowId uId pathName font tabs margin syncols ps
(_, (editState, ps)) = setText text (editState, ps)
(fontInfo, (editState, ps)) = getFontInfo (editState, ps)
// compute the view domain of the visual text
......
......@@ -29,6 +29,9 @@ msgGetFont :: EditAction .l Font
msgSetTabs :: !(Int,Bool,Bool) -> EditAction .l nothing
msgGetTabs :: EditAction .l (Int,Bool,Bool)
msgSetMargin :: !Int -> EditAction .l nothing
msgGetMargin :: EditAction .l Int
msgCopy :: EditAction .l nothing
msgCut :: EditAction General nothing
msgPaste :: EditAction General nothing
......
......@@ -68,6 +68,18 @@ msgGetTabs
= getFontInfo >>>= \{ tabSize,autoTab,showTabs } ->
result (tabSize,autoTab,showTabs)
msgSetMargin :: !Int -> EditAction .l nothing
msgSetMargin m =
getFontInfo >>>= \fontinfo ->
setFontInfo {fontinfo & marginWidth = m} >>>
setFont fontinfo.thefont >>>
skip
msgGetMargin :: EditAction .l Int
msgGetMargin
= getFontInfo >>>= \{ marginWidth } ->
result marginWidth
//--
msgUndo :: EditAction General nothing
......
......@@ -97,7 +97,7 @@ where
// change menu...
# ps = appPIO (setMenuElementTitles [(ci.clip_itemId,"Hide Clipboard")]) ps
# tbs = (4,False,False,False,False)
# ps = openEditWindow ci.clip_undoId "Clipboard" "" newText fnt tbs DefaultSyntaxColours ci.clip_clipId
# ps = openEditWindow ci.clip_undoId "Clipboard" "" newText fnt tbs 0 DefaultSyntaxColours ci.clip_clipId
[WindowActivate (noLS activate)
,WindowDeactivate (noLS deactivate)
,WindowClose (noLS showClip)
......
......@@ -124,7 +124,7 @@ openConsoleWindow cwi text atts ps
# pathName = "" // dummy pathname
# title = "Console"
# tabs = (4,True,False,False,True)
# (editState, ps) = initEditState windowId cwi.uId pathName cwi.tfnt tabs cwi.sync ps
# (editState, ps) = initEditState windowId cwi.uId pathName cwi.tfnt tabs 0 cwi.sync ps
# (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
......
......@@ -143,6 +143,7 @@ ed_open_cont pathName cont ps
# defaultFontdef= prefs.edwinfont
# fontdef = defaultFontdef
# tabs = prefs.edwintabs
# margin = prefs.edwinmargin
// open a font and then the edit window
# (font,ps) = accScreenPicture (safeOpenFixedFont defaultFontdef) ps
// error checking op font doen...?
......@@ -154,7 +155,7 @@ ed_open_cont pathName cont ps
# windowIcon = if isDefMod DefmodIcon (if isImpMod ImpmodIcon CleanIcon)
# syncols = if isDefMod (prefs.defcols) (if isImpMod (prefs.impcols) (prefs.syncols))
// # (boom, ps) = readFileInTree ps // P4
# ps = openEditWindow mn_und (if readOnly title` title) pathName text font tabs syncols windowId (
# ps = openEditWindow mn_und (if readOnly title` title) pathName text font tabs margin syncols windowId (
[ WindowClose (noLS (ed_close windowId))
, WindowKeyboard (\_ -> True) Able keyboardfun
, WindowActivate (ed_activate title)
......@@ -298,6 +299,7 @@ ed_new suffix ps
(prefs,ps) = getPrefs ps
defaultFontdef = prefs.edwinfont
defaultTabs = prefs.edwintabs
defaultMargin = prefs.edwinmargin
# isDefMod = IsDefPathname pathName
# isImpMod = IsImpPathname pathName
# defaultSync = if isDefMod (prefs.defcols) (if isImpMod (prefs.impcols) (prefs.syncols))
......@@ -305,7 +307,7 @@ ed_new suffix ps
((_, defaultFont), ps)
= accPIO (accScreenPicture (openFont defaultFontdef)) ps
// # (boom, ps) = readFileInTree ps // P4
# ps = openEditWindow mn_und title pathName text defaultFont defaultTabs defaultSync windowId
# ps = openEditWindow mn_und title pathName text defaultFont defaultTabs defaultMargin defaultSync windowId
[ WindowClose (noLS (ed_close windowId))
, WindowKeyboard (\_ -> True) Able (my_keyboard)
, WindowActivate (ed_activate title)
......@@ -508,6 +510,7 @@ where
, stringColour = cols.stringColour
, charColour = cols.charColour
, backgroundColour = cols.backgroundColour
, marginColour = cols.marginColour
, keywordColour = cols.keywordColour
}
}
......
......@@ -42,7 +42,7 @@ editColours ps
# (wId,ps) = openId ps
# (okId,ps) = openId ps
# (cancelId,ps) = openId ps
# (ids,ps) = openIds 27 ps
# (ids,ps) = openIds 30 ps
# cls =
[ prefs.syncols.textColour
, prefs.defcols.textColour
......@@ -62,6 +62,9 @@ editColours ps
, prefs.syncols.backgroundColour
, prefs.defcols.backgroundColour
, prefs.impcols.backgroundColour
, prefs.syncols.marginColour
, prefs.defcols.marginColour
, prefs.impcols.marginColour
, prefs.syncols.keywordColour
, prefs.defcols.keywordColour
, prefs.impcols.keywordColour
......@@ -146,16 +149,21 @@ editColours ps
:+: 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" []
:+: TextControl "Right Margin" []
:+: 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" []
:+: TextControl "Keywords" []
:+: ColourBoxControl`` rgbid lsid cls ids 24 (Just (Left,zero))
:+: ColourBoxControl`` rgbid lsid cls ids 25 Nothing
:+: ColourBoxControl`` rgbid lsid cls ids 26 Nothing
:+: TextControl "Typedefs" []
:+: ColourBoxControl`` rgbid lsid cls ids 27 (Just (Left,zero))
:+: ColourBoxControl`` rgbid lsid cls ids 28 Nothing
:+: ColourBoxControl`` rgbid lsid cls ids 29 Nothing
:+: TextControl "Typedecls" []
:+: Receiver lsid lsfun []
......@@ -271,9 +279,10 @@ where
, stringColour = cls!!9
, charColour = cls!!12
, backgroundColour = cls!!15
, keywordColour = cls!!18
, typedefColour = cls!!21
, typedeclColour = cls!!24
, marginColour = cls!!18
, keywordColour = cls!!21
, typedefColour = cls!!24
, typedeclColour = cls!!27
}
# defcols` =
{ prefs.defcols
......@@ -283,9 +292,10 @@ where
, stringColour = cls!!10
, charColour = cls!!13
, backgroundColour = cls!!16
, keywordColour = cls!!19
, typedefColour = cls!!22
, typedeclColour = cls!!25
, marginColour = cls!!19
, keywordColour = cls!!22
, typedefColour = cls!!25
, typedeclColour = cls!!28
}
# impcols` =
{ prefs.impcols
......@@ -295,9 +305,10 @@ where
, stringColour = cls!!11
, charColour = cls!!14
, backgroundColour = cls!!17
, keywordColour = cls!!20
, typedefColour = cls!!23
, typedeclColour = cls!!26
, marginColour = cls!!20
, keywordColour = cls!!23
, typedefColour = cls!!26
, typedeclColour = cls!!29
}
# prefs = {prefs & syncols = syncols`, defcols = defcols`, impcols = impcols`}
# ps = setPrefs prefs ps
......@@ -333,6 +344,7 @@ where
, stringColour = cols.stringColour
, charColour = cols.charColour
, backgroundColour = cols.backgroundColour
, marginColour = cols.marginColour
, keywordColour = cols.keywordColour
, typedefColour = cols.typedefColour
, typedeclColour = cols.typedeclColour
......@@ -352,9 +364,10 @@ defaultColours ps
3 -> prefs.syncols.stringColour
4 -> prefs.syncols.charColour
5 -> prefs.syncols.backgroundColour
6 -> prefs.syncols.keywordColour
7 -> prefs.syncols.typedefColour
8 -> prefs.syncols.typedeclColour
6 -> prefs.syncols.marginColour
7 -> prefs.syncols.keywordColour
8 -> prefs.syncols.typedefColour
9 -> prefs.syncols.typedeclColour
_ -> abort "edoptions[defaultColours]: unknown ls"
# (dback,ps) = GetDialogBackgroundColour ps
# wdef = Dialog "Pick a colour"
......@@ -391,9 +404,10 @@ where
3 -> prefs.syncols.stringColour
4 -> prefs.syncols.charColour
5 -> prefs.syncols.backgroundColour
6 -> prefs.syncols.keywordColour
7 -> prefs.syncols.typedefColour
8 -> prefs.syncols.typedeclColour
6 -> prefs.syncols.marginColour
7 -> prefs.syncols.keywordColour
8 -> prefs.syncols.typedefColour
9 -> prefs.syncols.typedeclColour
_ -> abort "edoptions[defaultColours]: also unknown ls"
# ps = setColourBoxColour rid col ps
= (i,ps)
......@@ -506,6 +520,11 @@ tabsAction window tabsChange ps
(_, ps) = message window (msgSetTabs newTabs) ps
= ps
marginFun :: Id .Int *(PSt *b) -> *PSt *b | Editor b;
marginFun window margin ps
# (_, ps) = message window (msgSetMargin margin) ps
= ps
//--
defaultFontAndTabs :: !*(PSt *General) -> *(PSt *General)
......@@ -518,13 +537,16 @@ defaultFontAndTabs ps
# (prefs,ps) = getPrefs ps
# fontdef = prefs.edwinfont
# (initabs,iniauto,inishow,iniline,inisync) = prefs.edwintabs
# inimargin = prefs.edwinmargin
# fontname = fontdef.fName
# fontsize = fontdef.fSize
# fontSizes = [7, 8, 9, 10, 12, 14, 18, 24 ]
# inistate = (initabs,iniauto,inishow,iniline,inisync)
// FIXME use a record for this state
# inistate = (initabs,inimargin,iniauto,inishow,iniline,inisync)
# (dialogId,ps) = openId ps
# (okId,ps) = openId ps
# (tabsId,ps) = openId ps
# (marginId,ps) = openId ps
# (cancelId,ps) = openId ps
# controls
= FontNameSizeControl fontname fontsize names fontSizes fontfun sizefun [ left ]
......@@ -535,6 +557,13 @@ defaultFontAndTabs ps
, ControlActivate (noLS (appPIO (setEditControlSelection tabsId 1 0)))
]
:+: TextControl "characters" []
:+: TextControl "Right margin" [ left ]
:+: EditControl (toString inimargin) (PixelWidth 30) 1
[ ControlKeyboard (const True) Able (\_ -> (marginfun dialogId marginId))
, ControlId marginId
, ControlActivate (noLS (appPIO (setEditControlSelection marginId 1 0)))
]
:+: TextControl "characters" []
:+: CheckControl
[("Auto Indent" ,Nothing,toMark iniauto,(autofun))
,("Show Tabs" ,Nothing,toMark inishow,(showfun))
......@@ -568,9 +597,9 @@ defaultFontAndTabs ps
# (_,ps) = openModalDialog inistate dialog ps
= ps
where
cancelfun dialogId inistate fontname fontsize (ls,ps)
cancelfun dialogId (t,m,a,s,l,c) fontname fontsize (ls,ps)
# (prefs,ps) = getPrefs ps
# ps = setPrefs {prefs & edwintabs = inistate, edwinfont = {prefs.edwinfont & fName = fontname, fSize = fontsize}} ps
# ps = setPrefs {prefs & edwintabs = (t,a,s,l,c), edwinmargin=m, edwinfont = {prefs.edwinfont & fName = fontname, fSize = fontsize}} ps
# (ls,ps) = apply (ls,ps)
= (ls, closeWindow dialogId ps)
applyfun (ls,ps)
......@@ -587,38 +616,50 @@ where
# (prefs,ps) = getPrefs ps
# ps = setPrefs {prefs & edwinfont = {prefs.edwinfont & fSize = size}} ps
= (ls,ps)
tabsfun dialogId tabsId ((t,a,s,l,c),ps)
tabsfun dialogId tabsId ((t,m,a,s,l,c),ps)
# (wstate,ps) = accPIO (getWindow dialogId) ps
| isNothing wstate = ((t,a,s,l,c),ps)
| isNothing wstate = ((t,m,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)
| not ok = ((t,m,a,s,l,c),ps)
| isNothing mt = ((t,m,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)
= ((t,m,a,s,l,c),ps)
autofun ((t,m,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)
= ((t,m,a,s,l,c),ps)
showfun ((t,m,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)
= ((t,m,a,s,l,c),ps)
linefun ((t,m,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)
= ((t,m,a,s,l,c),ps)
syncfun ((t,m,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)
= ((t,m,a,s,l,c),ps)
marginfun dialogId marginId ((t,m,a,s,l,c),ps)
# (wstate,ps) = accPIO (getWindow dialogId) ps
| isNothing wstate = ((t,m,a,s,l,c),ps)
# wstate = fromJust wstate
# [(ok,mt):_] = getControlTexts [marginId] wstate
| not ok = ((t,m,a,s,l,c),ps)
| isNothing mt = ((t,m,a,s,l,c),ps)
# m = fromJust mt
# m = toInt m
# (prefs,ps) = getPrefs ps
# ps = setPrefs {prefs & edwinmargin = m} ps
= ((t,m,a,s,l,c),ps)
apply (ls,ps)
# (prefs,ps) = getPrefs ps
# (windows,ps) = accPIO getWindowsStack ps
......@@ -639,6 +680,7 @@ where
| isNothing pn
= doall prefs rest ps
# (t,a,s,l,c) = prefs.edwintabs
# m = prefs.edwinmargin
# fontname = prefs.edwinfont.fName
# fontsize = prefs.edwinfont.fSize
# ps = formatTabs win t ps
......@@ -646,5 +688,6 @@ where
# ps = showTabs win s ps
# ps = lineFun win l ps
# ps = syncFun win c ps
# ps = marginFun win m ps
# ps = fontAction win (\fontdef->{fontdef & fName = fontname, fSize = fontsize}) ps
= doall prefs rest ps
......@@ -137,7 +137,7 @@ openTypeWindow twi text atts ps
# pathName = "" // dummy pathName
# title = "Types"
# tabs = (4,True,False,False,True)
# (editState, ps) = initEditState windowId twi.uId pathName twi.tfnt tabs twi.sync ps
# (editState, ps) = initEditState windowId twi.uId pathName twi.tfnt tabs 0 twi.sync ps
# (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
......
......@@ -69,7 +69,9 @@ PrefsFileName :== "IDEPrefs"
// want to set these per filetype...
, edwinfont :: !FontDef
// FIXME use a record for these options
, edwintabs :: !(Int,Bool,Bool,Bool,Bool) // tabsize, autotab, showtabs, showlinenos, showsyncol
, edwinmargin :: !Int // right margin (in #characters), 0: no margin
, compopts :: !CompilerOptions
, cgenopts :: !CodeGenOptions
......
......@@ -68,7 +68,10 @@ PrefsFileName :== "IDEPrefs"
, prj_prefs :: !PrjPrefs
, edwinfont :: !FontDef
// FIXME use a record for these options
, edwintabs :: !(Int,Bool,Bool,Bool,Bool) // tabsize, autotab, showtabs, showlinenos, showsyncol
, edwinmargin :: !Int // right margin (in #characters), 0: no margin
, compopts :: !CompilerOptions
, cgenopts :: !CodeGenOptions
, linkopts :: !LinkOptions
......@@ -116,6 +119,7 @@ emptyPrefs =
, prj_prefs = emptyPrjPrefs
, edwinfont = NonProportionalFontDef
, edwintabs = (4,True,False,False,True)
, edwinmargin = 0
, compopts = DefaultCompilerOptions
, cgenopts = DefCodeGenOptions
, linkopts = DefaultLinkOptions
......@@ -196,6 +200,7 @@ twSyntaxColours =
{ textColour = Black
, tabColour = twTabs
, backgroundColour = twBack
, marginColour = darkerColour twBack
, commentColour = twComm
, stringColour = twStri
, charColour = Magenta
......@@ -209,6 +214,7 @@ cwSyntaxColours =
{ textColour = Black
, tabColour = twTabs
, backgroundColour = cwBack
, marginColour = darkerColour cwBack
, commentColour = cwComm
, stringColour = cwStri
, charColour = Magenta
......@@ -222,6 +228,7 @@ ewSyntaxColours =
{ textColour = Black
, tabColour = twTabs
, backgroundColour = twBack
, marginColour = darkerColour twBack
, commentColour = twComm
, stringColour = twStri
, charColour = Magenta
......@@ -235,6 +242,7 @@ scSyntaxColours =
{ textColour = Black
, tabColour = scTabs
, backgroundColour = scBack
, marginColour = darkerColour scBack
, commentColour = scComm
, stringColour = scStri
, charColour = scChar
......@@ -248,6 +256,7 @@ dmSyntaxColours =
{ textColour = Black
, tabColour = scTabs
, backgroundColour = dmBack
, marginColour = darkerColour dmBack
, commentColour = scComm
, stringColour = scStri
, charColour = scChar
......@@ -261,6 +270,7 @@ imSyntaxColours =
{ textColour = Black
, tabColour = scTabs
, backgroundColour = imBack
, marginColour = darkerColour imBack
, commentColour = scComm
, stringColour = scStri
, charColour = scChar
......@@ -294,6 +304,15 @@ dmType = RGB {r = 195, g = 0, b = 0}
imType = RGB {r = 195, g = 0, b = 0}
dmDecl = RGB {r = 195, g = 0, b = 0}
imDecl = RGB {r = 195, g = 0, b = 0}
darkerColour :: Colour -> Colour
darkerColour (RGB rgb=:{r, g, b})
= RGB {rgb & r = darker r, g = darker g, b = darker b}
where
darker c
= c * 95 / 100
darkerColour colour
= colour
//--
openPrefs :: !String !*a -> *(!Prefs,!*a) | FileEnv a
......@@ -379,6 +398,7 @@ PrefsOptionsTable =
, SimpleOption "PWDcl" (\a->if a.prj_prefs.proj_shft "1" "0") (\v a->{a & prj_prefs.proj_shft=(if (v=="1") True False)})
, GroupedOption "EdFnt" FontOptionsTable (\a->a.edwinfont) (\v a->{a & edwinfont=v})
, SimpleOption "EdTab" (\a->a.edwintabs) (\v a->{a & edwintabs=v})
, SimpleOption "EdMargin" (\a->a.edwinmargin) (\v a->{a & edwinmargin=v})
, GroupedOption "ComOp" CompilerOptionsTable (\a->a.compopts) (\v a->{a & compopts=v})
, GroupedOption "GenOp" CodeGenOptionsTable (\a->a.cgenopts) (\v a->{a & cgenopts=v})
, GroupedOption "LnkOp" LinkOptionsTable (\a->a.linkopts) (\v a->{a & linkopts=v})
......@@ -536,6 +556,7 @@ SyncOptionsTable :: OptionsTable SyntaxColours
SyncOptionsTable =
{ SimpleOption "col_text" (\a->a.textColour) (\v a->{a & textColour=v})
, SimpleOption "col_back" (\a->a.backgroundColour) (\v a->{a & backgroundColour=v})
, SimpleOption "col_margin" (\a->a.marginColour) (\v a->{a & marginColour=v})
, SimpleOption "col_tabs" (\a->a.tabColour) (\v a->{a & tabColour=v})
, SimpleOption "col_comm" (\a->a.commentColour) (\v a->{a & commentColour=v})
, SimpleOption "col_stri" (\a->a.stringColour) (\v a->{a & stringColour=v})
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment