Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-ide
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
6
Issues
6
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-ide
Commits
2d206575
Commit
2d206575
authored
Feb 25, 2003
by
Diederik van Arkel
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
platform abstraction
parent
27759658
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
193 additions
and
9 deletions
+193
-9
Ed/EdMonad.icl
Ed/EdMonad.icl
+22
-3
Ed/syncol.dcl
Ed/syncol.dcl
+1
-1
Ed/syncol.icl
Ed/syncol.icl
+92
-1
HeapProfile/ShowHeapProfile.icl
HeapProfile/ShowHeapProfile.icl
+1
-1
Ide/IdeState.icl
Ide/IdeState.icl
+2
-2
Mac/Platform.dcl
Mac/Platform.dcl
+4
-0
Mac/Platform.icl
Mac/Platform.icl
+60
-0
Mac/UtilIO.dcl
Mac/UtilIO.dcl
+2
-0
Mac/UtilIO.icl
Mac/UtilIO.icl
+8
-0
Util/ExtListBox.icl
Util/ExtListBox.icl
+1
-1
No files found.
Ed/EdMonad.icl
View file @
2d206575
...
...
@@ -8,6 +8,9 @@ import UtilNewlinesFile, StateMonad
import
StdId
import
EdVisualText
,
EdSelection
,
EdLook
import
EdAction
import
Platform
//import dodebug
trace_n`
_
s
:==
s
::
ActionInfo
=
NoInfo
...
...
@@ -476,13 +479,28 @@ setNeedSave need =
getEditState
>>>=
\{
windowId
,
pathName
}
->
accEnv
(
accPIO
(
getWindowTitle
windowId
))
>>>=
\
oldTitle
->
let
windowName
=
(
if
readOnly
pathNameToWindowTitle`
pathNameToWindowTitle
)
pathName
windowTitle
=
if
need
(
"*"
+++
windowName
)
windowName
windowName
=
(
if
readOnly
pathNameToWindowTitle`
pathNameToWindowTitle
)
pathName
windowTitle
=
PlatformDependant
/*Win*/
(
if
need
(
"*"
+++
windowName
)
windowName
)
/*Mac*/
windowName
in
IF
(
needsetwin
oldTitle
windowTitle
)
THEN
(
appEnv
(
appPIO
(
setWindowTitle
windowId
windowTitle
)
)
>>>
appEnv
(
appPIO
(
setWindowTitle
windowId
windowTitle
))
)
ELSE
(
skip
)
>>>
accEnv
(
accPIO
(
getWindowModified
windowId
))
>>>=
\
wasModified
->
IF
(
isJust
wasModified
&&
fromJust
wasModified
<>
need
)
THEN
(
appEnv
(
appPIO
(
setWindowModified
windowId
windowName
need
))
>>>
updateEditState
update
)
ELSE
...
...
@@ -575,3 +593,4 @@ where
selectMode
=
state
.
mod
virtualX
=
state
.
vix
visible
=
state
.
vis
Ed/syncol.dcl
View file @
2d206575
...
...
@@ -10,8 +10,8 @@ import StrictList
// ,!Bool // in typedef at start of line
,!
Bool
// is typedef line
// ,!Bool // in typedecl at start of line
// ,!Int // typedecl offside level
,!
Bool
// is typedecl line
,!
Int
// context offside level
)
// pack bools into bitfield?
...
...
Ed/syncol.icl
View file @
2d206575
...
...
@@ -25,6 +25,10 @@ where
line4 = " -> fraps"
line5 = "global :== something"
*/
/*
parseLine: initial comment nesting level & textline -> new comment nesting level
*/
...
...
@@ -204,6 +208,10 @@ where
WhiteSpace
c
:==
c
==
' '
||
c
==
'\t'
||
c
==
'\n'
||
c
==
'\r'
||
c
==
'\f'
;
//slFromList` :: ![a] -> StrictList a
slFromList`
[]
r
=
r
slFromList`
[
x
:
xs
]
r
=
SCons
x
(
slFromList`
xs
r
)
/*
firstParse: textlines -> zip initial comment nesting level & textlines
*/
...
...
@@ -240,5 +248,88 @@ where
quickParse
::
!
Int
!
Int
!(
StrictList
(!
Info
,!
String
))
->
(
Int
,
Int
,
StrictList
(!
Info
,!
String
))
quickParse
fln
lln
text
=
(
0
,
slLength
text
-
1
,
firstParse
(
slMap
(\(_,
s
)->
s
)
text
))
#
(
beg
,
end
,
res
)
=
parseBefore
0
(
-1
,
0
,
False
,
False
,
0
)
id
[]
text
#
res
=
trace_n`
(
"quickParse"
,
beg
,
end
,
fln
,
lln
)
res
#
beg
=
if
(
beg
<
0
)
(
trace_n`
"FIX BEGIN"
0
)
beg
#
end
=
if
(
end
>=
slLength
res
)
(
trace_n`
"FIX END"
slLength
res
-
1
)
end
=
(
beg
,
end
,
res
)
where
join
[]
l
=
l
join
[
h
:
t
]
l
=
SCons
h
(
join
t
l
)
parseBefore
::
!
Int
!(!
Int
,!
Int
,!
Bool
,!
Bool
,!
Int
)
!((
StrictList
(!
Info
,!
String
))
->
StrictList
(!
Info
,!
String
))
![(!(!
Int
,!
Bool
,!
Bool
,!
Int
),!
String
)]
!(
StrictList
(!
Info
,!
String
))
->
(!
Int
,!
Int
,!
StrictList
(!
Info
,!
String
))
parseBefore
cln
(
begin
,
lev
,
def
,
tdec
,
off
)
res
acc
rest
=:
SNil
=
(
dec
cln
,
dec
cln
,
res
(
slFromList
acc
))
parseBefore
cln
s
=:(
begin
,
lev
,
def
,
tdec
,
off
)
res
acc
rest
=:(
SCons
h
=:((
lev`
,
def`
,
dec`
,
off`
),
l
)
t
)
|
cln
>=
fln
=
parseDuring
begin
begin
(
lev
,
def
,
tdec
,
off
)
res
[]
(
join
acc
rest
)
#
line_size
=
size
l
#
(
index
,
off``
,_)
=
scanFirst
lev`
0
0
l
#
non_empty
=
off``
>=
0
&&
index
<
line_size
#
not_double_colon
=
l
%(
index
,
dec
(
scanfunny
index
line_size
l
))
<>
"::"
#
has_content
=
non_empty
&&
if
(
index
>
0
)
not_double_colon
True
|
trace_n`
(
"parseBefore"
,
cln
,
has_content
,
s
,
h
)
False
=
undef
|
not
dec`
&&
has_content
// flush acc & continue...
=
parseBefore
(
inc
cln
)
(
cln
,
lev`
,
def`
,
dec`
,
off``
)
(\
r
->
res
(
slFromList`
acc
r
))
[
h
]
t
=
parseBefore
(
inc
cln
)
(
begin
,
lev
,
def
,
tdec
,
off
)
res
(
acc
++
[
h
])
t
parseDuring
::
!
Int
!
Int
!(!
Int
,!
Bool
,!
Bool
,!
Int
)
!((
StrictList
(!
Info
,!
String
))
->
StrictList
(!
Info
,!
String
))
![(!(!
Int
,!
Bool
,!
Bool
,!
Int
),!
String
)]
!(
StrictList
(!
Info
,!
String
))
->
(!
Int
,!
Int
,!
StrictList
(!
Info
,!
String
))
parseDuring
cln
begin
(
lev
,
def
,
tdec
,
off
)
res
acc
SNil
=
(
begin
,
dec
cln
,
res
(
slFromList
acc
))
parseDuring
cln
begin
i
=:(
lev
,
def
,
dec
,
off
)
res
acc
rest
=:(
SCons
h
=:(_,
l
)
t
)
|
cln
>
lln
=
parseAfter
cln
begin
i
res
acc
rest
|
trace_n`
(
"parseDuring"
,
cln
,
i
,
h
)
False
=
undef
#!
(
has_contents
,
j
=:(
level`
,
def`
,
dec`
,
off`
))
=
parseLine
i
l
new
=
(
lev
,
def`
,
dec`
,
off`
)
|
dec
==
False
&&
dec`
&&
off
<
off`
|
has_contents
=
parseDuring
(
inc
cln
)
begin
j
(\
r
->
res
(
slFromList`
acc
r
))
[(
new
,
l
)]
t
//@@@@
// should be identifier in acc...
#!
j`
=
(
lev
,
def
,
dec`
,
off
)
acc
=
[
fix
s
\\
s
<-
acc
]
res
=
(\
r
->
res
(
slFromList`
acc
r
))
=
parseDuring
cln
begin
j`
res
[]
rest
//@@@@
|
has_contents
#!
res
=
(\
r
->
res
(
slFromList`
acc
r
))
=
parseDuring
(
inc
cln
)
begin
j
res
[(
new
,
l
)]
t
//@@@@
#!
acc
=
acc
++
[(
new
,
l
)]
=
parseDuring
(
inc
cln
)
begin
j
res
acc
t
where
fix
::
!(!
Info
,!
String
)
->
(!
Info
,!
String
)
fix
((
c
,
t
,
d
,
o
),
l
)
=
((
c
,
False
,
True
,
o
),
l
)
parseAfter
::
!
Int
!
Int
!(!
Int
,!
Bool
,!
Bool
,!
Int
)
!((
StrictList
(!
Info
,!
String
))
->
StrictList
(!
Info
,!
String
))
![(!(!
Int
,!
Bool
,!
Bool
,!
Int
),!
String
)]
!(
StrictList
(!
Info
,!
String
))
->
(!
Int
,!
Int
,!
StrictList
(!
Info
,!
String
))
parseAfter
cln
begin
i
res
acc
SNil
=
(
begin
,
dec
cln
,
res
(
slFromList
acc
))
parseAfter
cln
begin
state
=:(
lev
,
def
,
dec
,
off
)
res
acc
rest
=:(
SCons
h
=:(
old
,
l
)
t
)
|
trace_n`
(
"parseAfter"
,
cln
,
state
,
h
)
False
=
undef
#!
(
has_contents
,
state`
=:(
level`
,
def`
,
dec`
,
off`
))
=
parseLine
state
l
new
=
(
lev
,
def`
,
dec`
,
off`
)
|
dec
==
False
&&
dec`
&&
off
<
off`
|
has_contents
#!
res
=
(\
r
->
res
(
slFromList`
acc
r
))
|
equal_state
new
old
#!
res
=
res
(
slFromList`
[(
new
,
l
)]
SNil
)
=
(
begin
,
cln
,
slAppend
res
t
)
=
parseDuring
(
inc
cln
)
begin
state`
res
[(
new
,
l
)]
t
#
j`
=
(
lev
,
def
,
dec`
,
off
)
=
parseDuring
cln
begin
j`
(\
r
->
res
(
slFromList`
[
fix
s
\\
s
<-
acc
]
r
))
[]
rest
|
has_contents
#!
res
=
(\
r
->
res
(
slFromList`
acc
r
))
|
equal_state
new
old
#!
res
=
res
(
slFromList`
[(
new
,
l
)]
SNil
)
=
(
begin
,
cln
,
slAppend
res
t
)
=
parseDuring
(
inc
cln
)
begin
state`
res
[(
new
,
l
)]
t
=
parseDuring
(
inc
cln
)
begin
state`
res
(
acc
++[(
new
,
l
)])
t
where
fix
::
(!
Info
,!
String
)
->
(!
Info
,!
String
)
fix
((
c
,
t
,
d
,
o
),
l
)
=
((
c
,
False
,
True
,
o
),
l
)
equal_state
::
!
Info
!
Info
->
Bool
equal_state
(
lev
,
def
,
dec
,
off
)
(
lev`
,
def`
,
dec`
,
off`
)
=
lev
==
lev`
&&
def
==
def`
&&
dec
==
dec`
&&
off
==
off`
HeapProfile/ShowHeapProfile.icl
View file @
2d206575
...
...
@@ -1398,7 +1398,7 @@ open_file_function file_name s=:{application_name,current_page,file_open} io
= (s, io);
*/
set_page_number :: !String !Int ->
!
String;
set_page_number :: !String !Int -> String;
set_page_number file_name new_page_number
= file_name := (size file_name-PageNumberOffsetFromEndInFileName,toChar (new_page_number + toInt '0'));
...
...
Ide/IdeState.icl
View file @
2d206575
...
...
@@ -484,7 +484,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps
//-- batch build support
from
StdProcess
import
closeProcess
from
StdPStClass
import
class
FileSystem
,
instance
FileSystem
PSt
import
logfile
,
set_return_code
import
logfile
,
Platform
getInteract
::
!*(
PSt
*
General
)
->
(!
Bool
,!*
PSt
*
General
)
getInteract
ps
=
accPLoc
(\
p
=:{
interact
}->(
interact
,
p
))
ps
...
...
@@ -506,7 +506,7 @@ abortLog flag message ps
#
(
ok
,
ps
)
=
closeLogfile
lf
ps
// | not ok ...
#
ps
=
case
flag
of
True
->
set_return_code_pst
(
-1
)
ps
True
->
pAbort
ps
_
->
ps
=
closeProcess
ps
...
...
Mac/Platform.dcl
View file @
2d206575
...
...
@@ -9,6 +9,9 @@ initPlatformCommandLine :: !*(PSt .l) -> (![String],!*PSt .l)
installPlatformEventHandlers
::
!*(
PSt
.
l
)
->
*(
PSt
.
l
)
openPlatformWindowMenu
::
!*(
PSt
.
l
)
->
*(
PSt
.
l
)
getWindowModified
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
Bool
,!
IOSt
.
l
)
setWindowModified
::
!
Id
!
String
!
Bool
!(
IOSt
.
l
)
->
IOSt
.
l
TempDir
::
String
EnvsDir
::
String
PrefsDir
::
String
...
...
@@ -16,3 +19,4 @@ BitmapDir :: String
batchOptions
::
!*
World
->
(!
Bool
,
Bool
,
String
,*
File
,!*
World
)
wAbort
::
!
String
!*
World
->
*
World
pAbort
::
!(
PSt
.
a
)
->
PSt
.
a
Mac/Platform.icl
View file @
2d206575
...
...
@@ -39,6 +39,9 @@ wAbort message world
#
(_,
world
)
=
fclose
stderr
world
=
world
pAbort
::
!(
PSt
.
a
)
->
PSt
.
a
pAbort
ps
=
ps
install_apple_event_handlers
::
Int
install_apple_event_handlers
=
code
()(
r
=
D0
)
{
...
...
@@ -56,3 +59,60 @@ PrefsDir = applicationpath "Config"
BitmapDir
::
String
BitmapDir
=
applicationpath
"Bitmaps"
//////////////
//import dodebug
trace_n`
_
f
:==
f
import
windowaccess
,
iostate
,
StdBool
,
menuwindowmenu
import
code
from
library
"winmod_library"
getWindowModified
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
Bool
,!
IOSt
.
l
)
getWindowModified
id
ioState
#
(
found
,
wDevice
,
ioState
)
=
ioStGetDevice
WindowDevice
ioState
|
not
found
=
(
Nothing
,
ioState
)
#
windows
=
windowSystemStateGetWindowHandles
wDevice
(
found
,
wsH
,
windows
)
=
getWindowHandlesWindow
(
toWID
id
)
windows
|
not
found
=
(
Nothing
,
ioStSetDevice
(
WindowSystemState
windows
)
ioState
)
|
otherwise
#
(
mod
,
wsH
,
ioState
)
=
getWindowModified
wsH
ioState
=
(
Just
mod
,
ioStSetDevice
(
WindowSystemState
(
setWindowHandlesWindow
wsH
windows
))
ioState
)
where
getWindowModified
wsH
=:{
wshIds
={
wPtr
}}
ioState
#
(
mod
,
ioState
)
=
accIOToolbox
(
IsWindowModified
wPtr
)
ioState
=
trace_n`
(
"getWindowModified"
,
wPtr
,
mod
)
(
mod
,
wsH
,
ioState
)
IsWindowModified
::
!
OSWindowPtr
!*
OSToolbox
->
(!
Bool
,!*
OSToolbox
)
IsWindowModified
wPtr
ioState
=
code {
ccall
IsWindowModified
"PI:I:I"
}
setWindowModified
::
!
Id
!
String
!
Bool
!(
IOSt
.
l
)
->
IOSt
.
l
setWindowModified
id
windowName
mod
ioState
#
windowTitle
=
if
mod
(
""
+++
windowName
)
windowName
#
ioState
=
changeWindowInWindowMenu
id
windowTitle
ioState
#
(
found
,
wDevice
,
ioState
)
=
ioStGetDevice
WindowDevice
ioState
|
not
found
=
ioState
#
windows
=
windowSystemStateGetWindowHandles
wDevice
(
found
,
wsH
,
windows
)
=
getWindowHandlesWindow
(
toWID
id
)
windows
|
not
found
=
ioStSetDevice
(
WindowSystemState
windows
)
ioState
|
otherwise
#
(
wsH
,
ioState
)
=
setWindowModified
wsH
mod
ioState
=
ioStSetDevice
(
WindowSystemState
(
setWindowHandlesWindow
wsH
windows
))
ioState
where
setWindowModified
wsH
=:{
wshIds
={
wPtr
}}
mod
ioState
#
(
err
,
ioState
)
=
accIOToolbox
(
SetWindowModified
wPtr
(
if
mod
(
1
<<
24
)
0
))
ioState
=
trace_n`
(
"setWindowModified"
,
wPtr
,
mod
,
err
)
(
wsH
,
ioState
)
SetWindowModified
::
!
OSWindowPtr
!
Int
!*
OSToolbox
->
(!
OSStatus
,!*
OSToolbox
)
SetWindowModified
wPtr
mod
ioState
=
code {
ccall
SetWindowModified
"PII:I:I"
}
::
OSStatus
:==
Int
Mac/UtilIO.dcl
View file @
2d206575
...
...
@@ -28,6 +28,8 @@ GetShortPathName :: !String -> (!Bool,!String);
import
StdPSt
,
StdMaybe
selectInputFile`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectOutputFile`
::
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectDirectory`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
ShellDefault
::
!{#
Char
}
!(
PSt
.
l
)
->
(!
Int
,!(
PSt
.
l
))
Mac/UtilIO.icl
View file @
2d206575
...
...
@@ -153,6 +153,14 @@ GetFName ioNamePtr t = code (ioNamePtr=R80O0D0SD1,t=U)(ioResult=D0,ioDate_and_Ti
import
StdFileSelect
,
StdPSt
,
StdPStClass
selectInputFile`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectInputFile`
ps
=
selectInputFile
ps
selectOutputFile`
::
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectOutputFile`
prompt
filename
ok
ps
=
selectOutputFile
prompt
filename
ps
selectDirectory`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectDirectory`
ps
#
(
ms
,
ps
)
=
selectDirectory
ps
...
...
Util/ExtListBox.icl
View file @
2d206575
...
...
@@ -588,7 +588,7 @@ applySelfun ls=:{newselfun,selection} ps
=
(
ls
,
ps
)
// The mouse either sets, adds, or removes items to the selection:
mouseFunction
::
!.
MouseState
*((.
ExtListBoxState
*(
PSt
.
a
),.
b
),*
PSt
.
a
)
->
*((
ExtListBoxState
*(
PSt
.
a
),.
b
),*
PSt
.
a
);
//
mouseFunction :: !.MouseState *((.ExtListBoxState *(PSt .a),.b),*PSt .a) -> *((ExtListBoxState *(PSt .a),.b),*PSt .a);
mouseFunction
(
MouseDown
pos
{
shiftDown
,
controlDown
}
1
)
((
listboxState
=:{
tMargin
,
items
,
selection
,
lineHeight
,
initHeight
},
ls
),
ps
)
#
listboxState
=
{
ExtListBoxState
|
listboxState
&
selection
=
okSelection
}
#
(
listboxState
,
ps
)
=
applySelfun
listboxState
ps
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment