Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
328918cb
Commit
328918cb
authored
Mar 27, 2003
by
Ronny Wichers Schreur
🏘
Browse files
added configurable right margin with different background colour
parent
7e569570
Changes
15
Hide whitespace changes
Inline
Side-by-side
Ed/EdMonad.dcl
View file @
328918cb
...
...
@@ -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
)
...
...
Ed/EdMonad.icl
View file @
328918cb
...
...
@@ -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
...
...
Ed/EdVisualCursor.icl
View file @
328918cb
...
...
@@ -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
)
...
...
Ed/EdVisualText.icl
View file @
328918cb
...
...
@@ -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.
...
...
Ed/EdWindow.dcl
View file @
328918cb
...
...
@@ -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
...
...
Ed/EdWindow.icl
View file @
328918cb
...
...
@@ -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
...
...
Ide/EdClient.dcl
View file @
328918cb
...
...
@@ -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
...
...
Ide/EdClient.icl
View file @
328918cb
...
...
@@ -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
...
...
Ide/clipboard.icl
View file @
328918cb
...
...
@@ -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
)
...
...
Ide/conswin.icl
View file @
328918cb
...
...
@@ -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
)
...
...
Ide/edfiles.icl
View file @
328918cb
...
...
@@ -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
}
}
...
...
Ide/edoptions.icl
View file @
328918cb
...
...
@@ -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
"
Typedef
s"
[]
:+:
TextControl
"
Keyword
s"
[]
:+:
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
Ide/typewin.icl
View file @
328918cb
...
...
@@ -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
)
...
...
Pm/PmPrefs.dcl
View file @
328918cb
...
...
@@ -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
...
...
Pm/PmPrefs.icl
View file @
328918cb
...
...
@@ -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 =