Skip to content
GitLab
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
d55051c5
Commit
d55051c5
authored
Jan 21, 2009
by
John van Groningen
Browse files
move functions that depend on ObjectIO to UtilObjectIO
parent
b3ccf9c8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Win/UtilIO.dcl
View file @
d55051c5
definition
module
UtilIO
import
StdString
,
StdFile
import
StdPSt
,
StdMaybe
,
StdPictureDef
,
StdId
import
UtilDate
LaunchApplication
::
!{#
Char
}
!{#
Char
}
!
Bool
!
Files
->
(
!
Bool
,
!
Files
)
...
...
@@ -25,11 +24,3 @@ GetLongPathName :: !String -> String;
GetShortPathName
::
!
String
->
(!
Bool
,!
String
);
GetCurrentDirectory
::
(!
Bool
,!
String
)
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
))
GetDialogBackgroundColour
::
!(
PSt
.
l
)
->
(!
Colour
,
!
PSt
.
l
)
isWindow
::
!
Id
*(
PSt
.
l
)
->
(
Bool
,*(
PSt
.
l
))
Win/UtilIO.icl
View file @
d55051c5
implementation
module
UtilIO
/*
modify to use 'clCCall_12' functions instead of redefining them here...
*/
import
StdArray
,
StdBool
,
StdClass
,
StdFile
,
StdList
import
UtilDate
import
StdSystem
,
StdWindow
import
code
from
library
"util_io_kernel_lib"
import
code
from
library
"util_io_shell_lib"
//--
CcRqSHELLDEFAULT
:==
1476
osIgnoreCallback
::
!
CrossCallInfo
!*
OSToolbox
->
(!
CrossCallInfo
,!*
OSToolbox
)
osIgnoreCallback
_
tb
=
(
return0Cci
,
tb
)
osShellDefault
::
!{#
Char
}
!*
OSToolbox
->
(!
Int
,!*
OSToolbox
)
osShellDefault
file
tb
// # tb = winInitialiseTooltips tb
#
(
cstr
,
tb
)
=
winMakeCString
file
tb
#
(
ret
,
tb
)
=
(
issueCleanRequest2
osIgnoreCallback
(
Rq2Cci
CcRqSHELLDEFAULT
0
cstr
)
tb
)
#
tb
=
winReleaseCString
cstr
tb
=
(
ret
.
p1
,
tb
)
//---
SW_SHOWNORMAL
:==
1
ShellDefault
::
!{#
Char
}
!(
PSt
.
l
)
->
(!
Int
,!(
PSt
.
l
))
ShellDefault
file
ps
=
accPIO
(
accIOToolbox
(
osShellDefault
file
))
ps
// = accPIO (accIOToolbox (ShellExecute 0 0 file 0 0 SW_SHOWNORMAL)) ps
ShellExecute
::
!
Int
!
Int
!{#
Char
}
!
Int
!
Int
!
Int
!*
OSToolbox
->
(!
Int
,!*
OSToolbox
)
ShellExecute
_
_
_
_
_
_
_
=
code {
ccall
ShellExecuteA@24
"IIsIII:I:I"
}
//---
import
code
from
library
"util_io_kernel_lib"
// GetShortPathNameA@12
import
StdArray
,
StdBool
,
StdClass
,
StdFile
,
StdList
,
StdTuple
,
StdString
import
UtilDate
import
StdPathname
,
Directory
from
Platform
import
DirSeparator
FReadOnly
::
!{#
Char
}
!*
env
->
(!
Bool
,
!*
env
)
|
FileSystem
env
FReadOnly
path
files
...
...
@@ -84,52 +47,41 @@ FFileSize path files
//--
//:: OSToolbox
// :== Int
::
OSToolbox
:==
Int
WinLaunchApp
::
!{#
Char
}
!
Bool
!*
OSToolbox
->
(
!
Bool
,
!*
OSToolbox
)
WinLaunchApp
_
_
_
=
code
=
code
inline
{
.inline
WinLaunchApp
ccall
WinLaunchApp
"SII-II"
.end
ccall
WinLaunchApp
"SII-II"
}
WinLaunchApp2
::
!{#
Char
}
!{#
Char
}
!
Bool
!*
OSToolbox
->
(
!
Bool
,
!*
OSToolbox
)
WinLaunchApp2
_
_
_
_
=
code
=
code
inline
{
.inline
WinLaunchApp2
ccall
WinLaunchApp2
"SSII-II"
.end
ccall
WinLaunchApp2
"SSII-II"
}
WinGetModulePath
::
{#
Char
}
WinGetModulePath
=
code
=
code
inline
{
.inline
WinGetModulePath
ccall
WinGetModulePath
"-S"
.end
ccall
WinGetModulePath
"-S"
}
WinFileModifiedDate
::
!{#
Char
}
->
(
!
Bool
,
!
Int
,
!
Int
,
!
Int
,
!
Int
,
!
Int
,
!
Int
)
WinFileModifiedDate
_
=
code
=
code
inline
{
.inline
WinFileModifiedDate
ccall
WinFileModifiedDate
"S-IIIIIII"
.end
ccall
WinFileModifiedDate
"S-IIIIIII"
}
WinFileExists
::
!{#
Char
}
->
Bool
WinFileExists
_
=
code
=
code
inline
{
.inline
WinFileExists
ccall
WinFileExists
"S-I"
.end
ccall
WinFileExists
"S-I"
}
//--
...
...
@@ -188,7 +140,7 @@ LastColon :: !String !Int -> (!Bool, !Int);
LastColon
s
i
|
i
<=
0
=
(
False
,
0
);
|
d
ir
s
eparator
==
s
.[
i
]
|
D
ir
S
eparator
==
s
.[
i
]
=
(
True
,
i
);
=
LastColon
s
(
dec
i
);
...
...
@@ -259,7 +211,7 @@ GetLongPathName short_path = expand_8_3_names_in_path short_path;
GetShortPathName
::
!
String
->
(!
Bool
,!
String
);
GetShortPathName
long_path
#!
long_path
=
if
null_terminated
long_path
(
long_path
+++
.
"
\0
"
)
#!
long_path
=
if
null_terminated
long_path
(
long_path
+++
"
\0
"
)
#!
(
result
,
short_path
)
=
Helper
long_path
#!
short_path
=
if
null_terminated
short_path
(
short_path
%(
0
,
size
short_path
-
2
))
=
(
result
<>
0
,
short_path
);
...
...
@@ -315,216 +267,3 @@ where
ccall GetModuleFileNameA@12 "PIsI:I"
}
*/
//====
import
StdTuple
,
clCCall_12
,
clCrossCall_12
import
StdPSt
,
StdMaybe
,
iostate
from
deviceevents
import
::
SchedulerEvent
from
osfileselect
import
osInitialiseFileSelectors
from
scheduler
import
handleOneEventForDevices
from
commondef
import
fatalError
CcRqALTDIRECTORYDIALOG
:==
1475
CcRqALTFILEOPENDIALOG
:==
1478
CcRqALTFILESAVEDIALOG
:==
1479
selectInputFile`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectInputFile`
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectinputfile
handleOSEvent
pState
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectOutputFile`
::
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectOutputFile`
prompt
filename
ok
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectoutputfile
handleOSEvent
pState
prompt
filename
ok
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectDirectory`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectDirectory`
env
// = selectDirectory Nothing env
#
initial
=
global
.[
0
]
#
(
result
,
env
)
=
selectDirectory
initial
env
#
(
result
,_)
=
case
result
of
Nothing
->
(
result
,
global
)
(
Just
_)
->
update_maybe_string
result
global
=
(
result
,
env
)
where
selectDirectory
::
!(
Maybe
String
)
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectDirectory
initial
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectdirectory
handleOSEvent
pState
initial
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
// handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile.
handleOSEvent
::
!
OSEvent
!*(
PSt
.
l
)
->
*
PSt
.
l
handleOSEvent
osEvent
pState
=
thd3
(
handleOneEventForDevices
(
ScheduleOSEvent
osEvent
[])
pState
)
osSelectinputfile
::
!(
OSEvent
->.
s
->.
s
)
!.
s
!*
OSToolbox
->
(!
Bool
,!
String
,!.
s
,!*
OSToolbox
)
osSelectinputfile
handleOSEvent
state
tb
#
(
rcci
,
state
,
tb
)
=
issueCleanRequest
(
callback
handleOSEvent
)
(
Rq0Cci
CcRqALTFILEOPENDIALOG
)
state
tb
#
(
ok
,
name
,
tb
)
=
getinputfilename
rcci
tb
=
(
ok
,
name
,
state
,
tb
)
where
getinputfilename
::
!
CrossCallInfo
!*
OSToolbox
->
(!
Bool
,!
String
,!*
OSToolbox
)
getinputfilename
{
ccMsg
=
CcRETURN2
,
p1
=
ok
,
p2
=
ptr
}
tb
|
ok
==
0
=
(
False
,
""
,
tb
)
|
otherwise
#
(
pathname
,
tb
)
=
winGetCStringAndFree
ptr
tb
=
(
True
,
pathname
,
tb
)
getinputfilename
{
ccMsg
=
CcWASQUIT
}
tb
=
(
False
,
""
,
tb
)
getinputfilename
{
ccMsg
}
_
=
osfileselectFatalError
"osSelectinputfile"
(
"unexpected ccMsg field of return CrossCallInfo ("
+++
toString
ccMsg
+++
")"
)
osSelectoutputfile
::
!(
OSEvent
->.
s
->.
s
)
!.
s
!
String
!
String
!
String
!*
OSToolbox
->
(!
Bool
,!
String
,!.
s
,!*
OSToolbox
)
osSelectoutputfile
handleOSEvent
state
prompt
filename
ok
tb
#
(
promptptr
,
tb
)
=
winMakeCString
prompt
tb
#
(
filenameptr
,
tb
)
=
winMakeCString
filename
tb
#
(
okptr
,
tb
)
=
winMakeCString
ok
tb
#
(
rcci
,
state
,
tb
)
=
issueCleanRequest
(
callback
handleOSEvent
)
(
Rq3Cci
CcRqALTFILESAVEDIALOG
promptptr
filenameptr
okptr
)
state
tb
#
tb
=
winReleaseCString
promptptr
tb
#
tb
=
winReleaseCString
filenameptr
tb
#
tb
=
winReleaseCString
okptr
tb
#
(
ok
,
name
,
tb
)
=
getoutputfilename
rcci
tb
=
(
ok
,
name
,
state
,
tb
)
where
getoutputfilename
::
!
CrossCallInfo
!*
OSToolbox
->
(!
Bool
,!
String
,!*
OSToolbox
)
getoutputfilename
{
ccMsg
=
CcRETURN2
,
p1
=
ok
,
p2
=
ptr
}
tb
|
ok
==
0
=
(
False
,
""
,
tb
)
|
otherwise
#
(
path
,
tb
)
=
winGetCStringAndFree
ptr
tb
=
(
True
,
path
,
tb
)
getoutputfilename
{
ccMsg
=
CcWASQUIT
}
tb
=
(
False
,
""
,
tb
)
getoutputfilename
{
ccMsg
}
_
=
osfileselectFatalError
"osSelectoutputfile"
(
"unexpected ccMsg field of return CrossCallInfo ("
+++
toString
ccMsg
+++
")"
)
osSelectdirectory
::
!(
OSEvent
->.
s
->.
s
)
!.
s
!(
Maybe
String
)
!*
OSToolbox
->
(!
Bool
,!
String
,!.
s
,!*
OSToolbox
)
osSelectdirectory
handleOSEvent
state
initial
tb
#
(
initialptr
,
tb
)
=
case
initial
of
Just
initial
->
winMakeCString
initial
tb
Nothing
->
(
0
,
tb
)
#
(
rcci
,
state
,
tb
)
=
issueCleanRequest
(
callback
handleOSEvent
)
(
Rq1Cci
CcRqALTDIRECTORYDIALOG
initialptr
)
state
tb
#
tb
=
case
initialptr
of
0
->
tb
_
->
winReleaseCString
initialptr
tb
#
(
ok
,
name
,
tb
)
=
getinputfilename
rcci
tb
=
(
ok
,
name
,
state
,
tb
)
where
getinputfilename
::
!
CrossCallInfo
!*
OSToolbox
->
(!
Bool
,!
String
,!*
OSToolbox
)
getinputfilename
{
ccMsg
=
CcRETURN2
,
p1
=
ok
,
p2
=
ptr
}
tb
|
ok
==
0
=
(
False
,
""
,
tb
)
|
otherwise
#
(
pathname
,
tb
)
=
winGetCStringAndFree
ptr
tb
=
(
True
,
pathname
,
tb
)
getinputfilename
{
ccMsg
=
CcWASQUIT
}
tb
=
(
False
,
""
,
tb
)
getinputfilename
{
ccMsg
}
_
=
osfileselectFatalError
"osSelectdirectory"
(
"unexpected ccMsg field of return CrossCallInfo ("
+++
toString
ccMsg
+++
")"
)
// callback lifts a function::(OSEvent -> .s -> .s) to
// a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox))
callback
::
!(
OSEvent
->.
s
->.
s
)
!
CrossCallInfo
!.
s
!*
OSToolbox
->
(!
CrossCallInfo
,!.
s
,!*
OSToolbox
)
callback
handleOSEvent
cci
state
tb
=
(
return0Cci
,
handleOSEvent
cci
state
,
tb
)
osfileselectFatalError
::
String
String
->
.
x
osfileselectFatalError
function
error
=
fatalError
function
"osaltfileselect"
error
//== UNSAFE HACK...
import
StdArray
global
::
{
Maybe
String
}
global
#!
path_name
=
expand_8_3_names_in_path
(
RemoveFileName
WinGetModulePath
);
=:
{
Just
path_name
};
//update_maybe_string :: !(Maybe String) !*{(Maybe String)} -> (!(Maybe String),!*{(Maybe String)})
update_maybe_string
::
!(
Maybe
String
)
!{(
Maybe
String
)}
->
(!(
Maybe
String
),!{(
Maybe
String
)})
update_maybe_string
ms
ar
// = (ms,{ar & [0] = ms})
=
code {
push_a
0
pushI
0
push_a
2
update_a
2
3
update_a
1
2
updatepop_a
0
1
update
_
1
0
push_a
1
update_a
1
2
updatepop_a
0
1
}
//===
COLOR_SCROLLBAR
:==
0
COLOR_BACKGROUND
:==
1
COLOR_ACTIVECAPTION
:==
2
COLOR_INACTIVECAPTION
:==
3
COLOR_MENU
:==
4
COLOR_WINDOW
:==
5
COLOR_WINDOWFRAME
:==
6
COLOR_MENUTEXT
:==
7
COLOR_WINDOWTEXT
:==
8
COLOR_CAPTIONTEXT
:==
9
COLOR_ACTIVEBORDER
:==
10
COLOR_INACTIVEBORDER
:==
11
COLOR_APPWORKSPACE
:==
12
COLOR_HIGHLIGHT
:==
13
COLOR_HIGHLIGHTTEXT
:==
14
COLOR_BTNFACE
:==
15
COLOR_BTNSHADOW
:==
16
COLOR_GRAYTEXT
:==
17
COLOR_BTNTEXT
:==
18
COLOR_INACTIVECAPTIONTEXT
:==
19
COLOR_BTNHIGHLIGHT
:==
20
COLOR_3DDKSHADOW
:==
21
COLOR_3DLIGHT
:==
22
COLOR_INFOTEXT
:==
23
COLOR_INFOBK
:==
24
COLOR_HOTLIGHT
:==
26
COLOR_GRADIENTACTIVECAPTION
:==
27
COLOR_GRADIENTINACTIVECAPTION
:==
28
COLOR_DESKTOP
:==
COLOR_BACKGROUND
COLOR_3DFACE
:==
COLOR_BTNFACE
COLOR_3DSHADOW
:==
COLOR_BTNSHADOW
COLOR_3DHIGHLIGHT
:==
COLOR_BTNHIGHLIGHT
COLOR_3DHILIGHT
:==
COLOR_BTNHIGHLIGHT
COLOR_BTNHILIGHT
:==
COLOR_BTNHIGHLIGHT
GetSysColor
::
!
Int
->
Int
GetSysColor
nIndex
=
code {
ccall
GetSysColor@4
"PI:I"
}
GetDialogBackgroundColour
::
!(
PSt
.
l
)
->
(!
Colour
,
!
PSt
.
l
)
GetDialogBackgroundColour
ps
=
(
RGB
{
r
=
rcol
,
g
=
gcol
,
b
=
bcol
},
ps
)
where
col
=
GetSysColor
COLOR_BTNFACE
rcol
=
(
col
bitand
0x000000FF
)
gcol
=
(
col
bitand
0x0000FF00
)
>>
8
bcol
=
(
col
bitand
0x00FF0000
)
>>
16
isWindow
::
!
Id
*(
PSt
.
l
)
->
(
Bool
,*(
PSt
.
l
))
isWindow
wId
ps
#
(
s
,
ps
)
=
accPIO
getWindowsStack
ps
=
(
isMember
wId
s
,
ps
)
Win/UtilObjectIO.dcl
0 → 100644
View file @
d55051c5
definition
module
UtilObjectIO
import
StdString
,
StdFile
import
StdPSt
,
StdMaybe
,
StdPictureDef
,
StdId
import
UtilDate
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
))
GetDialogBackgroundColour
::
!(
PSt
.
l
)
->
(!
Colour
,
!
PSt
.
l
)
isWindow
::
!
Id
*(
PSt
.
l
)
->
(
Bool
,*(
PSt
.
l
))
Win/UtilObjectIO.icl
0 → 100644
View file @
d55051c5
implementation
module
UtilObjectIO
import
code
from
library
"util_io_shell_lib"
/*
modify to use 'clCCall_12' functions instead of redefining them here...
*/
import
StdArray
,
StdBool
,
StdClass
,
StdFile
,
StdList
import
UtilDate
import
StdSystem
,
StdWindow
import
StdPathname
,
Directory
import
StdTuple
,
clCCall_12
,
clCrossCall_12
import
StdPSt
,
StdMaybe
,
iostate
from
deviceevents
import
::
SchedulerEvent
from
osfileselect
import
osInitialiseFileSelectors
from
scheduler
import
handleOneEventForDevices
from
commondef
import
fatalError
//--
CcRqSHELLDEFAULT
:==
1476
osIgnoreCallback
::
!
CrossCallInfo
!*
OSToolbox
->
(!
CrossCallInfo
,!*
OSToolbox
)
osIgnoreCallback
_
tb
=
(
return0Cci
,
tb
)
osShellDefault
::
!{#
Char
}
!*
OSToolbox
->
(!
Int
,!*
OSToolbox
)
osShellDefault
file
tb
// # tb = winInitialiseTooltips tb
#
(
cstr
,
tb
)
=
winMakeCString
file
tb
#
(
ret
,
tb
)
=
(
issueCleanRequest2
osIgnoreCallback
(
Rq2Cci
CcRqSHELLDEFAULT
0
cstr
)
tb
)
#
tb
=
winReleaseCString
cstr
tb
=
(
ret
.
p1
,
tb
)
//---
SW_SHOWNORMAL
:==
1
ShellDefault
::
!{#
Char
}
!(
PSt
.
l
)
->
(!
Int
,!(
PSt
.
l
))
ShellDefault
file
ps
=
accPIO
(
accIOToolbox
(
osShellDefault
file
))
ps
// = accPIO (accIOToolbox (ShellExecute 0 0 file 0 0 SW_SHOWNORMAL)) ps
ShellExecute
::
!
Int
!
Int
!{#
Char
}
!
Int
!
Int
!
Int
!*
OSToolbox
->
(!
Int
,!*
OSToolbox
)
ShellExecute
_
_
_
_
_
_
_
=
code {
ccall
ShellExecuteA@24
"IIsIII:I:I"
}
WinGetModulePath
::
{#
Char
}
WinGetModulePath
=
code inline
{
ccall
WinGetModulePath
"-S"
}
RemoveFileName
::
!
String
->
String
;
RemoveFileName
path
|
found
=
(
path
%
(
0
,
dec
position
));
=
path
;
where
(
found
,
position
)
=
LastColon
path
last
;
last
=
dec
(
size
path
);
LastColon
::
!
String
!
Int
->
(!
Bool
,
!
Int
);
LastColon
s
i
|
i
<=
0
=
(
False
,
0
);
|
dirseparator
==
s
.[
i
]
=
(
True
,
i
);
=
LastColon
s
(
dec
i
);
//-- expand_8_3_names_in_path
FindFirstFile
::
!
String
->
(!
Int
,!
String
);
FindFirstFile
file_name
#
find_data
=
createArray
318
'\0'
;
#
handle
=
FindFirstFile_
file_name
find_data
;
=
(
handle
,
find_data
);
FindFirstFile_
::
!
String
!
String
->
Int
;
FindFirstFile_
file_name
find_data
=
code {
ccall
FindFirstFileA@8
"Pss:I"
}
FindClose
::
!
Int
->
Int
;
FindClose
handle
=
code {
ccall
FindClose@4
"PI:I"
}
find_null_char_in_string
::
!
Int
!
String
->
Int
;
find_null_char_in_string
i
s
|
i
<
size
s
&&
s
.[
i
]<>
'\0'
=
find_null_char_in_string
(
i
+1
)
s
;
=
i
;
find_data_file_name
find_data
#
i
=
find_null_char_in_string
44
find_data
;
=
find_data
%
(
44
,
i
-1
);
find_first_file_and_close
::
!
String
->
(!
Bool
,!
String
);
find_first_file_and_close
file_name
#
(
handle
,
find_data
)
=
FindFirstFile
file_name
;
|
handle
<>
(
-1
)
#
r
=
FindClose
handle
;
|
r
==
r
=
(
True
,
find_data
);
=
(
False
,
find_data
);
=
(
False
,
""
);
find_last_backslash_in_string
i
s
|
i
<
0
=
(
False
,
-1
);
|
s
.[
i
]==
'\\'
=
(
True
,
i
);
=
find_last_backslash_in_string
(
i
-1
)
s
;
expand_8_3_names_in_path
::
!{#
Char
}
->
{#
Char
};
expand_8_3_names_in_path
path_and_file_name
#
(
found_backslash
,
back_slash_index
)
=
find_last_backslash_in_string
(
size
path_and_file_name
-1
)
path_and_file_name
;
|
not
found_backslash
=
path_and_file_name
;
#
path
=
expand_8_3_names_in_path
(
path_and_file_name
%
(
0
,
back_slash_index
-1
));
#
file_name
=
path_and_file_name
%
(
back_slash_index
+1
,
size
path_and_file_name
-1
);
#
path_and_file_name
=
path
+++
"
\\
"
+++
file_name
;
#
(
ok
,
find_data
)
=
find_first_file_and_close
(
path_and_file_name
+++
"
\0
"
);
|
ok
=
path
+++
"
\\
"
+++
find_data_file_name
find_data
;
=
path_and_file_name
;
//--
/*
import code from library "kernel_library"
Start = GetModuleFileName
MAX_PATH :== 260
GetModuleFileName :: (!Bool,!String)
GetModuleFileName
#! buf = createArray (MAX_PATH+1) '\0'
#! res = GetModuleFileName_ 0 buf MAX_PATH
= (res <> 0,buf)
where
GetModuleFileName_ :: !Int !String !Int -> !Int
GetModuleFileName_ handle buffer buf_length
= code {
ccall GetModuleFileNameA@12 "PIsI:I"
}
*/
//====
CcRqALTDIRECTORYDIALOG
:==
1475
CcRqALTFILEOPENDIALOG
:==
1478
CcRqALTFILESAVEDIALOG
:==
1479
selectInputFile`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectInputFile`
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectinputfile
handleOSEvent
pState
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectOutputFile`
::
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectOutputFile`
prompt
filename
ok
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectoutputfile
handleOSEvent
pState
prompt
filename
ok
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectDirectory`
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!(
PSt
.
l
))
selectDirectory`
env
// = selectDirectory Nothing env
#
initial
=
global
.[
0
]
#
(
result
,
env
)
=
selectDirectory
initial
env
#
(
result
,_)
=
case
result
of
Nothing
->
(
result
,
global
)
(
Just
_)
->
update_maybe_string
result
global
=
(
result
,
env
)
where
selectDirectory
::
!(
Maybe
String
)
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectDirectory
initial
pState
#
(
tb
,
pState
)
=
accPIO
getIOToolbox
pState
#
tb
=
osInitialiseFileSelectors
tb
#
(
ok
,
name
,
pState
,
tb
)
=
osSelectdirectory
handleOSEvent
pState
initial
tb
#
pState
=
appPIO
(
setIOToolbox
tb
)
pState
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
// handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile.
handleOSEvent
::
!
OSEvent
!*(
PSt
.
l
)
->
*
PSt
.
l
handleOSEvent
osEvent
pState
=
thd3
(
handleOneEventForDevices
(
ScheduleOSEvent
osEvent
[])
pState
)
osSelectinputfile
::
!(
OSEvent
->.
s
->.
s
)
!.
s
!*
OSToolbox
->
(!
Bool
,!
String
,!.
s
,!*
OSToolbox
)
osSelectinputfile
handleOSEvent
state
tb
#
(
rcci
,
state
,
tb
)
=
issueCleanRequest
(
callback
handleOSEvent
)
(
Rq0Cci
CcRqALTFILEOPENDIALOG
)
state
tb
#
(
ok
,
name
,
tb
)
=
getinputfilename
rcci
tb
=
(
ok
,
name
,
state
,
tb
)