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
3c886916
Commit
3c886916
authored
Feb 13, 2002
by
Diederik van Arkel
Browse files
Mac specific
Move keymapping to platform module
parent
9222b57d
Changes
9
Hide whitespace changes
Inline
Side-by-side
Ed/EdKeyMapping.dcl
View file @
3c886916
...
...
@@ -9,6 +9,8 @@ from StdMaybe import :: Maybe
from
StdOverloaded
import
class
==,
class
toString
,
class
fromString
from
EdActionType
import
::
Action
KeyMapFileName
:==
"default.km"
::
KeyMapping
// The first two arguments are there to circumvent the
...
...
Ed/EdKeyMapping.icl
View file @
3c886916
...
...
@@ -9,6 +9,8 @@ import StrictList, ioutil
import
EdActionType
import
Platform
KeyMapFileName
:==
"default.km"
//--
MAX_KEY_BINDINGS
:==
4
...
...
Ide/IDE.icl
View file @
3c886916
...
...
@@ -9,7 +9,7 @@ import PmDialogues
import
PmParse
import
PmPath
from
EdKeyMapping
import
macKeyMapping
,
ReadKeyMapFile
from
EdKeyMapping
import
macKeyMapping
,
ReadKeyMapFile
,
KeyMapFileName
from
finder
import
sr_find
,
sr_find_next
,
sr_find_sel
,
sr_rep_find
,
sr_goto_cursor
from
finder
import
sr_goto_line
,
sr_goto_selection
from
edoptions
import
defaultFontAndTabs
,
optionsKeyMapping
,
editColours
...
...
@@ -110,7 +110,8 @@ Start world
=
Batch
stup
force_update
proj_path
pub
world
where
setupKeyMap
world
#
((
km
,
ok
,_),
world
)
=
accFiles
(
ReadKeyMapFile
(
applicationpath
"Config
\\
default.km"
))
world
#
keymappath
=
MakeFullPathname
PrefsDir
KeyMapFileName
#
((
km
,
ok
,_),
world
)
=
accFiles
(
ReadKeyMapFile
keymappath
)
world
#
keymap
=
if
ok
km
macKeyMapping
=
(
keymap
,
world
)
setupToolBar
show
world
// need to conditionalise for Mac...
...
...
Mac/IdePlatform.dcl
View file @
3c886916
...
...
@@ -4,8 +4,9 @@ import StdPSt, StdString
import
StdIOCommon
from
IdeState
import
::
General
PlatformProcessAttributes
::
[
ProcessAttribute
*(
PSt
General
)]
RunProgram
::
!.
String
!*(
PSt
General
)
->
*
PSt
General
PlatformInteractiveInit
::
!*(
PSt
General
)
->
*
PSt
General
PlatformProcessAttributes
::
[
ProcessAttribute
*(
PSt
General
)]
RunProgram
::
!.
String
!*(
PSt
General
)
->
*
PSt
General
SetWindowIcon
::
!
Id
!
Int
!(
PSt
.
l
)
->
PSt
.
l
SetProcessIcon
::
!
Int
!(
PSt
.
l
)
->
PSt
.
l
...
...
@@ -16,3 +17,15 @@ ImpmodIcon :== 32516
DefmodIcon
:==
32515
CleanIcon
:==
32512
AbcmodIcon
:==
32514
toolIconFun
::
!
String
!(
Maybe
String
)
!(
IdFun
.
st
)
![(
ToolbarItem
.
st
)]
!*
env
->
(![(
ToolbarItem
.
st
)],!*
env
)
|
FileSystem
env
AboutBitmap
:==
""
findBM
:==
"findBM.bmp"
newfBM
:==
"newfBM.bmp"
openBM
:==
"openBM.bmp"
prntBM
:==
"prntBM.bmp"
saveBM
:==
"saveBM.bmp"
srchBM
:==
"srchBM.bmp"
updtBM
:==
"updtBM.bmp"
urunBM
:==
"urunBM.bmp"
Mac/IdePlatform.icl
View file @
3c886916
...
...
@@ -6,10 +6,24 @@ import StdFunc
import
PmCleanSystem
import
errwin
from
IdeState
import
::
General
import
Platform
toolIconFun
::
!
String
!(
Maybe
String
)
!(
IdFun
.
st
)
![(
ToolbarItem
.
st
)]
!*
env
->
(![(
ToolbarItem
.
st
)],!*
env
)
|
FileSystem
env
toolIconFun
bitmapname
tooltip
toolfun
itemlist
world
#
bitmappath
=
MakeFullPathname
BitmapDir
bitmapname
#
(
bmp
,
world
)
=
openBitmap
bitmappath
world
#
itemlist
=
case
bmp
of
Nothing
->
itemlist
Just
bmp
->
[
ToolbarItem
bmp
tooltip
toolfun
:
itemlist
]
=
(
itemlist
,
world
)
PlatformInteractiveInit
::
!*(
PSt
General
)
->
*
PSt
General
PlatformInteractiveInit
ps
=
ps
GetDialogBackgroundColour
::
!(
PSt
.
l
)
->
(!
Colour
,!
PSt
.
l
)
GetDialogBackgroundColour
ps
=
(
LightGrey
,
ps
)
=
(
White
/*
LightGrey
*/
,
ps
)
// Mac Appearance dependant!
PlatformProcessAttributes
::
[
ProcessAttribute
*(
PSt
General
)]
PlatformProcessAttributes
=
[]
...
...
@@ -34,3 +48,13 @@ ImpmodIcon :== 32516
DefmodIcon
:==
32515
CleanIcon
:==
32512
AbcmodIcon
:==
32514
AboutBitmap
:==
""
findBM
:==
"findBM.bmp"
newfBM
:==
"newfBM.bmp"
openBM
:==
"openBM.bmp"
prntBM
:==
"prntBM.bmp"
saveBM
:==
"saveBM.bmp"
srchBM
:==
"srchBM.bmp"
updtBM
:==
"updtBM.bmp"
urunBM
:==
"urunBM.bmp"
Mac/Platform.dcl
View file @
3c886916
...
...
@@ -12,6 +12,7 @@ openPlatformWindowMenu :: !*(PSt .l) -> *(PSt .l)
TooltempDir
::
String
EnvsDir
::
String
PrefsDir
::
String
BitmapDir
::
String
batchOptions
::
!*
World
->
(!
Bool
,
Bool
,
String
,*
File
,!*
World
)
wAbort
::
!
String
!*
World
->
*
World
Mac/Platform.icl
View file @
3c886916
...
...
@@ -53,3 +53,6 @@ EnvsDir = applicationpath "Config"
PrefsDir
::
String
PrefsDir
=
applicationpath
"Config"
BitmapDir
::
String
BitmapDir
=
applicationpath
"Bitmaps"
Mac/dodebug.dcl
0 → 100755
View file @
3c886916
definition
module
dodebug
from
StdOverloaded
import
class
toString
from
StdPictureDef
import
::
Colour
import
StdMaybe
import
ostoolbox
,
ostypes
from
deviceevents
import
::
DeviceEvent
,
::
SchedulerEvent
,
::
MsgEvent
,
::
ControlUpdateInfo
abort`
::
!
a
->
.
b
|
toString
a
// stop reduction and print argument
abort``
::
!.
a
!
b
->
.
a
|
toString
b
trace_n`
::
!
msg
.
a
->
.
a
|
toString
msg
// write toString msg and newline to stderr
// before evaluating a
trace_l
::
![
a
]
.
b
->
.
b
|
toString
a
assert
::
{#.
Char
}
!.(.
a
->
(.
Bool
,.
b
))
.
a
->
.
b
trace_rgn
::
!{#.
Char
}
!
Int
->
Int
trace_col
::
!{#.
Char
}
!
Colour
->
Colour
assertPort
::
!
Int
!*
OSToolbox
->
(!
Bool
,!*
OSToolbox
)
// # tb = assert "updateScroll: wrong port" (assertPort wPtr) tb
instance
toString
OSRect
instance
toString
(
l
,
r
)
|
toString
l
&
toString
r
instance
toString
(
a
,
b
,
c
)
|
toString
a
&
toString
b
&
toString
c
instance
toString
(
a
,
b
,
c
,
d
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
instance
toString
(
a
,
b
,
c
,
d
,
e
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
&
toString
e
instance
toString
(
a
,
b
,
c
,
d
,
e
,
f
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
&
toString
e
&
toString
f
//instance toString Colour
//instance toString RGBColour
instance
toString
(
Maybe
a
)
|
toString
a
pretty
::
![
a
]
->
String
|
toString
a
instance
toString
DeviceEvent
instance
toString
SchedulerEvent
instance
toString
MsgEvent
instance
toString
ControlUpdateInfo
DebugStr
::
!
String
!.
a
->
.
a
DebugStr`
::
!
msg
!.
a
->
.
a
|
toString
msg
Mac/dodebug.icl
0 → 100755
View file @
3c886916
implementation
module
dodebug
import
StdEnv
,
StdPictureDef
from
quickdraw
import
QGetPort
,
::
GrafPtr
assert
::
{#.
Char
}
!.(.
a
->
(.
Bool
,.
b
))
.
a
->
.
b
assert
txt
test
env
#
(
ok
,
env
)
=
test
env
|
ok
=
env
=
abort
txt
import
osrgn
,
StdDebug
abort`
::
!
a
->
.
b
|
toString
a
// stop reduction and print argument
abort`
a
=
abort
(
toString
a
)
abort``
::
!.
a
!
b
->
.
a
|
toString
b
abort``
a
b
=
abort
(
toString
b
)
trace_l
::
![
a
]
.
b
->
.
b
|
toString
a
trace_l
[]
e
=
e
trace_l
[
h
:
t
]
e
#!
e
=
trace_n
h
e
=
trace_l
t
e
trace_rgn
::
!{#.
Char
}
!
Int
->
Int
trace_rgn
txt
rgn
#
(
isRect
,
rct
,_)=
osgetrgnbox
rgn
OSNewToolbox
#
rgn
=
trace_n
(
txt
+++
xxx
rct
isRect
)
rgn
=
rgn
where
xxx
{
rleft
,
rtop
,
rright
,
rbottom
}
isRect
=
"[("
+++
toString
rleft
+++
","
+++
toString
rtop
+++
"),("
+++
toString
rright
+++
","
+++
toString
rbottom
+++
")] "
+++
toString
isRect
trace_col
::
!{#.
Char
}
!
Colour
->
Colour
trace_col
txt
col
=
trace_n
(
txt
+++
xxx
col
)
col
where
xxx
colour
=
case
colour
of
Black
->
"BlackColor"
White
->
"WhiteColor"
Red
->
"RedColor"
Green
->
"GreenColor"
Blue
->
"BlueColor"
Cyan
->
"CyanColor"
Magenta
->
"MagentaColor"
Yellow
->
"YellowColor"
RGB
rgb
->
"rgb"
DarkGrey
->
"DarkGrey"
Grey
->
"Grey"
LightGrey
->
"LightGrey"
assertPort
::
!
Int
!*
OSToolbox
->
(!
Bool
,!*
OSToolbox
)
assertPort
p
tb
#
(
q
,
tb
)
=
QGetPort
tb
=
(
p
==
q
,
tb
)
instance
toString
OSRect
where
toString
{
rleft
,
rtop
,
rright
,
rbottom
}
=
"{("
+++
toString
rleft
+++
","
+++
toString
rtop
+++
"),("
+++
toString
rright
+++
","
+++
toString
rbottom
+++
")}"
instance
toString
(
l
,
r
)
|
toString
l
&
toString
r
where
toString
(
l
,
r
)
=
"("
+++
toString
l
+++
","
+++
toString
r
+++
")"
instance
toString
(
a
,
b
,
c
)
|
toString
a
&
toString
b
&
toString
c
where
toString
(
a
,
b
,
c
)
=
"("
+++
toString
a
+++
","
+++
toString
b
+++
","
+++
toString
c
+++
")"
instance
toString
(
a
,
b
,
c
,
d
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
where
toString
(
a
,
b
,
c
,
d
)
=
"("
+++
toString
a
+++
","
+++
toString
b
+++
","
+++
toString
c
+++
","
+++
toString
d
+++
")"
instance
toString
(
a
,
b
,
c
,
d
,
e
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
&
toString
e
where
toString
(
a
,
b
,
c
,
d
,
e
)
=
"("
+++
toString
a
+++
","
+++
toString
b
+++
","
+++
toString
c
+++
","
+++
toString
d
+++
","
+++
toString
e
+++
")"
instance
toString
(
a
,
b
,
c
,
d
,
e
,
f
)
|
toString
a
&
toString
b
&
toString
c
&
toString
d
&
toString
e
&
toString
f
where
toString
(
a
,
b
,
c
,
d
,
e
,
f
)
=
"("
+++
toString
a
+++
","
+++
toString
b
+++
","
+++
toString
c
+++
","
+++
toString
d
+++
","
+++
toString
e
+++
","
+++
toString
f
+++
")"
instance
toString
Colour
where
toString
(
RGB
rgb
)
=
"(RGB "
+++
toString
rgb
+++
")"
toString
Black
=
"Black"
toString
White
=
"White"
toString
DarkGrey
=
"DarkGrey"
toString
Grey
=
"Grey"
toString
LightGrey
=
"LightGrey"
toString
Red
=
"Red"
toString
Green
=
"Green"
toString
Blue
=
"Blue"
toString
Cyan
=
"Cyan"
toString
Magenta
=
"Magenta"
toString
Yellow
=
"Yellow"
instance
toString
RGBColour
where
toString
{
r
,
g
,
b
}
=
"{"
+++
(
itemsList
","
(
map
recordFieldtoString
[(
"r"
,
r
),(
"g"
,
g
),(
"b"
,
b
)]))+++
"}"
itemsList
::
!
String
![
String
]
->
String
itemsList
separator
[
x
:
xs
]
=
x
+++
itemsList`
xs
where
itemsList`
[
x
:
xs
]
=
separator
+++
x
+++
itemsList`
xs
itemsList`
_
=
""
itemsList
_
_
=
""
curlify
x
=
"{"
+++
x
+++
"}"
brackify
x
=
"("
+++
x
+++
")"
squarify
x
=
"["
+++
x
+++
"]"
recordFieldtoString
::
(
String
,
a
)
->
String
|
toString
a
recordFieldtoString
(
field
,
value
)
=
field
+++
"="
+++
toString
value
pretty
::
![
a
]
->
String
|
toString
a
pretty
l
=
brackify
(
itemsList
","
(
map
toString
l
))
import
StdMaybe
instance
toString
(
Maybe
a
)
|
toString
a
where
toString
Nothing
=
"Nothing"
toString
(
Just
a
)
=
"Just "
+++.
toString
a
import
deviceevents
instance
toString
MsgEvent
where
toString
(
QASyncMessage
msg
)
=
"QASyncMessage"
toString
(
ASyncMessage
msg
)
=
"ASyncMessage"
toString
(
SyncMessage
msg
)
=
"SyncMessage"
instance
toString
ControlUpdateInfo
where
toString
{
cuItemNr
//:: !Int // The wItemNr of the control
,
cuItemPtr
//:: !OSWindowPtr // The wItemPtr to the control (can be OSNoWindowPtr)
,
cuArea
//:: !OSRect // The update area of the control (in window coordinates)
}
=
"{"
+++
toString
cuItemNr
+:+
toString
cuItemPtr
+:+
toString
cuArea
+++
"}"
(+:+)
infixr
5
::
String
String
->
String
(+:+)
l
r
=
l
+++
","
+++
r
instance
toString
DeviceEvent
where
toString
(
MenuTraceEvent
_)
=
"MenuTraceEvent"
toString
(
ToolbarSelection
_)
=
"ToolbarSelection"
toString
(
ReceiverEvent
_)
=
"ReceiverEvent"
toString
(
InternetEvent
_)
=
"InternetEvent"
toString
(
TimerEvent
_)
=
"TimerEvent"
toString
(
CompoundScrollAction
_)
=
"CompoundScrollAction"
toString
(
ControlGetKeyFocus
_)
=
"ControlGetKeyFocus"
toString
(
ControlKeyboardAction
_)
=
"ControlKeyboardAction"
toString
(
ControlLooseKeyFocus
_)
=
"ControlLooseKeyFocus"
toString
(
ControlMouseAction
_)
=
"ControlMouseAction"
toString
(
ControlSelection
_)
=
"ControlSelection"
toString
(
ControlSliderAction
_)
=
"ControlSliderAction"
toString
(
WindowActivation
_)
=
"WindowActivation"
toString
(
WindowCANCEL
_)
=
"WindowCANCEL"
toString
(
WindowDeactivation
_)
=
"WindowDeactivation"
toString
(
WindowInitialise
_)
=
"WindowInitialise"
toString
(
WindowKeyboardAction
_)
=
"WindowKeyboardAction"
toString
(
WindowMouseAction
_)
=
"WindowMouseAction"
toString
(
WindowOK
_)
=
"WindowOK"
toString
(
WindowRequestClose
_)
=
"WindowRequestClose"
toString
(
WindowScrollAction
_)
=
"WindowScrollAction"
toString
(
WindowSizeAction
_)
=
"WindowSizeAction"
toString
(
WindowUpdate
_)
=
"WindowUpdate"
toString
ProcessRequestClose
=
"ProcessRequestClose"
toString
(
ProcessRequestOpenFiles
_)=
"ProcessRequestOpenFiles"
toString
ProcessRequestClipboardChanged
=
"ProcessRequestClipboardChanged"
instance
toString
SchedulerEvent
where
toString
(
ScheduleOSEvent
event
=:(
a
,
b
,
c
,
d
,
e
,
f
,
g
)
list
)
=
"ScheduleOSEvent: "
+++
toString
(
a
,
b
,
c
)
+++
toString
(
d
,
e
,
f
,
g
)
toString
(
ScheduleMsgEvent
event
)
=
"ScheduleMsgEvent"
toString
(
ScheduleTimerEvent
event
)
=
"ScheduleTimerEvent"
DebugStr
::
!
String
!.
a
->
.
a
DebugStr
s
a
|
onOSX
#
s
=
{
toChar
(
size
s
)}
+++
s
|
42
==
DebugStr
s
42
=
a
=
a
=
trace_n
s
a
where
DebugStr
::
!
String
!*
Int
->
*
Int
DebugStr
_
_
=
code {
ccall
DebugStr
"Ps:V:I"
}
trace_n`
::
!
msg
.
a
->
.
a
|
toString
msg
// write toString msg and newline to stderr
// before evaluating a
trace_n`
m
a
=
DebugStr
(
toString
m
)
a
// = trace_n m a
DebugStr`
::
!
msg
!.
a
->
.
a
|
toString
msg
DebugStr`
msg
a
=
DebugStr
(
toString
msg
)
a
onOSX
=:
fst
(
runningCarbonOSX
OSNewToolbox
)
runningCarbonOSX
tb
#
(
err
,
res
,
tb
)
=
Gestalt
"sysv"
tb
|
err
<>
0
=
abort
"Gestalt failed.
\n
"
=
(
res
>=
0x01000
,
tb
)
Gestalt
::
!
String
!*
Int
->
(!
Int
,!
Int
,!*
Int
)
Gestalt
sSel
tb
|
size
sSel
<>
4
=
abort
"Gestalt not called with four-char selector.
\n
"
#
iSel
=
((
toInt
sSel
.[
0
])
<<
24
)
bitor
((
toInt
sSel
.[
1
])
<<
16
)
bitor
((
toInt
sSel
.[
2
])
<<
8
)
bitor
((
toInt
sSel
.[
3
])
<<
0
)
=
Gestalt
iSel
tb
where
Gestalt
::
!
Int
!*
Int
->
(!
Int
,!
Int
,!*
Int
)
Gestalt
_
_
=
code {
ccall
Gestalt
"PI:II:I"
}
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