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
e1f4cd2d
Commit
e1f4cd2d
authored
Dec 10, 2001
by
Diederik van Arkel
Browse files
cleanup for Clean2 release
parent
af9b4495
Changes
115
Show whitespace changes
Inline
Side-by-side
Pm/PmPrefs.dcl
View file @
e1f4cd2d
definition
module
PmPrefs
/*
The IDE Preferences
*/
// The IDE Preferences
from
StdPictureDef
import
::
FontDef
import
StdFile
,
StdIOBasic
...
...
@@ -90,6 +88,21 @@ PrefsFileName :== "IDEPrefs"
,
be_verbose
::
!
Bool
// give extended diagnostics
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
newline_handling
::
!
NewlinePrefs
,
reg_prefs
::
!
RegPrefs
}
::
RegPrefs
=
{
rp_flags
::
![(
String
,
String
,
String
)]
// should use registry entries for the following instead of Prefs file...
,
tp_name
::
!
String
,
tp_path
::
!
String
,
hp_name
::
!
String
,
hp_path
::
!
String
,
pr_name
::
!
String
,
pr_path
::
!
String
,
ve_name
::
!
String
,
ve_path
::
!
String
}
::
NewlinePrefs
...
...
Pm/PmPrefs.icl
View file @
e1f4cd2d
...
...
@@ -85,9 +85,20 @@ PrefsFileName :== "IDEPrefs"
,
be_verbose
::
!
Bool
// give extended diagnostics
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
newline_handling
::
!
NewlinePrefs
// RWS ...
// , number_of_processes :: !Int
// ... RWS
,
reg_prefs
::
!
RegPrefs
}
::
RegPrefs
=
{
rp_flags
::
![(
String
,
String
,
String
)]
,
tp_name
::
!
String
,
tp_path
::
!
String
,
hp_name
::
!
String
,
hp_path
::
!
String
,
pr_name
::
!
String
,
pr_path
::
!
String
,
ve_name
::
!
String
,
ve_path
::
!
String
}
::
NewlinePrefs
...
...
@@ -120,6 +131,19 @@ emptyPrefs =
,
be_verbose
=
False
,
altgr_workaround
=
False
,
newline_handling
=
LeaveAlone
NewlineConventionNone
,
reg_prefs
=
emptyRegPrefs
}
emptyRegPrefs
=
{
rp_flags
=
[]
,
tp_name
=
"ShowTimeProfile.exe"
,
tp_path
=
"C:
\\
CLEAN
\\
TOOLS
\\
TIMEPR~1
\\
"
,
hp_name
=
"ShowHeapProfile.exe"
,
hp_path
=
"C:
\\
CLEAN
\\
TOOLS
\\
HEAPPR~1
\\
"
,
pr_name
=
"Sparkle.exe"
,
pr_path
=
"C:
\\
CLEAN
\\
TOOLS
\\
SPARKLE
\\
"
,
ve_name
=
""
,
ve_path
=
""
}
emptyTypPrefs
=
...
...
@@ -354,6 +378,7 @@ PrefsOptionsTable =
,
SimpleOption
"BeVerbose"
(\
a
->
if
a
.
be_verbose
"1"
"0"
)
(\
v
a
->{
a
&
be_verbose
=(
if
(
v
==
"1"
)
True
False
)})
,
SimpleOption
"AltGrWorkaround"
(\
a
->
if
a
.
altgr_workaround
"1"
"0"
)
(\
v
a
->{
a
&
altgr_workaround
=(
if
(
v
==
"1"
)
True
False
)})
,
SimpleOption
"NewlineHandling"
writeNLH
readNLH
,
GroupedOption
"RegPrefs"
RegPrefsOptionsTable
(\
a
->
a
.
reg_prefs
)
(\
v
a
->{
a
&
reg_prefs
=
v
})
}
where
writeNLH
{
newline_handling
}
...
...
@@ -378,6 +403,28 @@ where
"A3"
->
{
a
&
newline_handling
=
AlwaysUse
NewlineConventionDos
}
_
->
{
a
&
newline_handling
=
LeaveAlone
NewlineConventionNone
}
RegPrefsOptionsTable
::
OptionsTable
RegPrefs
RegPrefsOptionsTable
=
{
ListOption
"ClideFlags"
FlagOption
(
""
,
""
,
""
)
(\
a
->
ListToStrictList
a
.
rp_flags
)
(\
v
a
->{
a
&
rp_flags
=
StrictListToList
v
})
,
SimpleOption
"TimepName"
(\
a
->
a
.
tp_name
)
(\
v
a
->{
a
&
tp_name
=
v
})
,
SimpleOption
"TimepPath"
(\
a
->
a
.
tp_path
)
(\
v
a
->{
a
&
tp_path
=
v
})
,
SimpleOption
"HeappName"
(\
a
->
a
.
hp_name
)
(\
v
a
->{
a
&
hp_name
=
v
})
,
SimpleOption
"HeappPath"
(\
a
->
a
.
hp_path
)
(\
v
a
->{
a
&
hp_path
=
v
})
,
SimpleOption
"ProofName"
(\
a
->
a
.
pr_name
)
(\
v
a
->{
a
&
pr_name
=
v
})
,
SimpleOption
"ProofPath"
(\
a
->
a
.
pr_path
)
(\
v
a
->{
a
&
pr_path
=
v
})
,
SimpleOption
"VisedName"
(\
a
->
a
.
ve_name
)
(\
v
a
->{
a
&
ve_name
=
v
})
,
SimpleOption
"VisedPath"
(\
a
->
a
.
ve_path
)
(\
v
a
->{
a
&
ve_path
=
v
})
}
FlagOption
=
GroupedOption
"Flags"
FlagsOptionsTable
id
const
FlagsOptionsTable
::
OptionsTable
(
String
,
String
,
String
)
FlagsOptionsTable
=
{
SimpleOption
"fName"
(\(
a
,_,_)->
a
)
(\
v
(
a
,
b
,
c
)->(
v
,
b
,
c
))
,
SimpleOption
"fPath"
(\(_,
a
,_)->
a
)
(\
v
(
a
,
b
,
c
)->(
a
,
v
,
c
))
,
SimpleOption
"fVers"
(\(_,_,
a
)->
a
)
(\
v
(
a
,
b
,
c
)->(
a
,
b
,
v
))
}
ErrPrefsOptionsTable
::
OptionsTable
ErrPrefs
ErrPrefsOptionsTable
=
{
GroupedOption
"EWPos"
VectOptionsTable
(\
a
->
a
.
err_pos
)
(\
v
a
->{
a
&
err_pos
=
v
})
...
...
Pm/PmProject.icl
View file @
e1f4cd2d
...
...
@@ -839,8 +839,7 @@ ReadProjectFile projectPath applicationDir ps
(
id
)
)
project
// DvA: need to set needs save flag for project;
/*
Mooier is om ipv bovenstaande een dialoogje te laten zien met popupje met mogelijke environments.
Plus button om in htmlHelp in relevante sectie over environments te komen.
It's better to replace above with a dialog with popup of available environments.
*/
project
=
SetProject
applicationDir
projectDir
project
execpath
=
PR_GetExecPath
project
...
...
@@ -849,7 +848,7 @@ Plus button om in htmlHelp in relevante sectie over environments te komen.
(
closed
,
ps
)
=
fclose
file
ps
|
not
closed
// generate warning?
=
((
project
,
True
,
"The file
\"
"
+++
projectName
+++
"
\"
c
l
ould not be closed."
),
ps
)
=
((
project
,
True
,
"The file
\"
"
+++
projectName
+++
"
\"
could not be closed."
),
ps
)
=
((
project
,
True
,
""
),
ps
)
getStaticInfo
::
!
Project
->
(
ProjectStaticInfo
,
Project
)
...
...
Pm/PmTypes.dcl
View file @
e1f4cd2d
definition
module
PmTypes
/* The types for the Project Manager */
// The types for the Project Manager
from
StdPathname
import
::
Pathname
from
UtilNewlinesFile
import
::
NewlineConvention
(..)
...
...
@@ -35,7 +34,7 @@ instance fromString Processor
DefaultLinkOptions
::
LinkOptions
::
LinkMethod
::
LinkMethod
// => is really project method/type now?
=
LM_Static
// | LM_Eager
|
LM_Dynamic
...
...
Pm/PmTypes.icl
View file @
e1f4cd2d
implementation
module
PmTypes
/
*
The types for the Project Manager
*/
/
/
The types for the Project Manager
import
StdBool
,
StdInt
import
UtilStrictLists
,
UtilDate
...
...
Registry/first_run.icl
View file @
e1f4cd2d
module
first_run
implementation
module
first_run
import
StdEnv
,
StdMaybe
,
StdDebug
import
StdEnv
,
StdMaybe
import
StdDebug
import
registry
,
version
import
UtilIO
import
dodebug
//==
...
...
@@ -16,17 +16,39 @@ GetLastError = code {
//==
Start
w
=
startIO
NDI
Void
pinit
[
ProcessClose
closeProcess
]
w
pinit
ps
#
ps
=
first_run
app_vers
app_path
app_name
ps
=
finish
ps
GetVNP
::
(
String
,
String
,
String
)
GetVNP
=
(
app_vers
,
app_name
,
app_path
)
where
path
=
winGetModulePath
long_path
=
GetLongPathName
path
app_name
=
GetFileName
long_path
app_path
=
GetFilePath
path
app_vers
=
ReadVersionInfo
//==
Start``
w
=
startIO
NDI
Void
pinit
[
ProcessClose
closeProcess
]
w
pinit
ps
#
((
flag_name
,
flag_path
,
flag_vers
),
ps
)
=
read_version_flag
ps
#
flags
=
[(
flag_name
,
flag_path
,
flag_vers
)]
#
(
res
,
ps
)
=
first_run
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
flags
ps
#
ps
=
case
res
of
True
->
write_version_flag
(
ide_name
,
ide_path
,
ide_vers
)
ps
_
->
ps
=
finish
ps
where
path
=
winGetModulePath
long_path
=
GetLongPathName
path
long_path
=
GetLongPathName
path
// ide_name = GetFileName long_path
// ide_path = GetFilePath path
ide_name
=
"CleanIDE.exe"
ide_path
=
"C:
\\
CLEAN
\\
"
ide_vers
=
ReadVersionInfo
pcl_name
=
"ShowTimeProfile.exe"
pcl_path
=
"C:
\\
CLEAN
\\
TOOLS
\\
TIMEPR~1
\\
"
hcl_name
=
"ShowHeapProfile.exe"
hcl_path
=
"C:
\\
CLEAN
\\
TOOLS
\\
HEAPPR~1
\\
"
GetFileName
::
!
String
->
String
;
GetFileName
path
...
...
@@ -101,7 +123,7 @@ ReadVersionInfo
#
sptr
=
s2i
buff
#
slen
=
s2i
blen
// # info = toString sptr +++ " :: " +++ toString slen
#
info
=
{
read_char
p
\\
p
<-
[
sptr
..]
&
x
<-
[
1
..
slen
]}
#
info
=
{
read_char
p
\\
p
<-
[
sptr
..]
&
x
<-
[
1
..
slen
-1
]}
=
info
where
path
=
winGetModulePath
+++.
"
\0
"
...
...
@@ -111,55 +133,65 @@ where
//==
MyEntry
:==
1
NoEntry
:==
2
DiffEntry
:==
3
::
CheckResult
=
MyEntry
|
NoEntry
|
DiffEntry
|
ErrEntry
!
String
Yes
:==
1
No
:==
2
Never
:==
3
::
DialogResult
=
Yes
|
No
|
Never
first_run
app_vers
app_path
app_name
ps
#
(
run
,
ps
)
=
check_flag
app_vers
app_path
app_name
ps
first_run
::
!
String
!
String
!
String
!
String
!
String
!
String
!
String
![(
String
,
String
,
String
)]
!(
PSt
.
ls
)
->
(!
Bool
,!
PSt
.
ls
)
first_run
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
flags
ps
#
(
run
,
ps
)
=
check_flags
ide_vers
ide_path
ide_name
flags
ps
|
not
run
=
ps
#
(
res
,
ps
)
=
check_registry
app_path
ps
|
res
==
MyEntry
=
ps
|
res
==
NoEntry
=
(
False
,
ps
)
#
(
res
,
ps
)
=
check_registry
ide_name
ide_path
ide_vers
ps
=
case
res
of
MyEntry
->
(
False
,
ps
)
NoEntry
#
(
res
,
ps
)
=
init_dialog
ps
|
res
==
Yes
#
ps
=
set_registry
app_name
app_path
ps
=
ps
|
res
==
No
=
ps
|
res
==
Never
#
ps
=
set_flag
app_vers
app_path
app_name
ps
=
ps
=
abort
"Uncaught case in first_run:first_run: [2]
\n
"
|
res
==
DiffEntry
->
case
res
of
Yes
#
(
err
,
ps
)
=
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
|
err
<>
""
#
ps
=
err_dialog
False
err
ps
=
(
False
,
ps
)
=
(
False
,
ps
)
No
->
(
False
,
ps
)
Never
->
(
True
,
ps
)
DiffEntry
#
(
res
,
ps
)
=
delta_dialog
ps
|
res
==
Yes
#
ps
=
set_registry
app_name
app_path
ps
=
ps
|
res
==
No
=
ps
|
res
==
Never
#
ps
=
set_flag
app_vers
app_path
app_name
ps
=
ps
=
abort
"Uncaught case in first_run:first_run: [3]
\n
"
=
abort
"Uncaught case in first_run:first_run: [1]
\n
"
->
case
res
of
Yes
#
(
err
,
ps
)
=
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
|
err
<>
""
#
ps
=
err_dialog
False
err
ps
=
(
False
,
ps
)
=
(
False
,
ps
)
No
->
(
False
,
ps
)
Never
->
(
True
,
ps
)
ErrEntry
err
#
ps
=
err_dialog
True
err
ps
=
(
False
,
ps
)
uninstall
::
!(
PSt
.
ls
)
->
(![
String
],!
PSt
.
ls
)
uninstall
ps
#
(
e
,
rs
)
=
([],
0
)
#
(
e
,
rs
)
=
remove_file_type_from_registry
".icl
\0
"
"iclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".dcl
\0
"
"dclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".prj
\0
"
"prjfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".abc
\0
"
"abcfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".pcl
\0
"
"pclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".hcl
\0
"
"hclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_ide_from_registry
e
rs
=
(
e
,
ps
)
uninstall
application_path
ps
=
abort
"first_run:uninstall unimplemented.
\n
"
//==
check_flag
app_vers
app_path
app_name
ps
// read flag => flag+vers+path+name
// compare...
// if vers & path & name match => use flag
// otherwise run first-run
read_version_flag
ps
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FReadText
ps
|
not
ok
=
abort
"no VERSION"
#
(
flag_vers
,
file
)
=
freadline
file
...
...
@@ -169,56 +201,56 @@ check_flag app_vers app_path app_name ps
#
flag_name
=
dropnl
flag_name
#
flag_path
=
dropnl
flag_path
#
(_,
ps
)
=
fclose
file
ps
|
app_vers
==
flag_vers
&&
app_path
==
flag_path
&&
app_name
==
flag_name
=
trace_n`
"check=>False"
(
False
,
ps
)
=
trace_n`
"check=>True"
(
True
,
ps
)
=
((
flag_name
,
flag_path
,
flag_vers
),
ps
)
where
flag_vers
=
"2.0.1.42
\0
"
flag_name
=
"first_run.exe"
flag_path
=
"C:
\\
CLEANTOOLS
\\
REGISTRY
\\
"
dropnl
s
=
{
c
\\
c
<-:
s
|
c
<>
'\xA'
&&
c
<>
'\xD'
}
set_flag
app_vers
app_path
app_name
ps
#
ps
=
trace_n`
(
"set"
,
app_vers
,
app_path
,
app_name
)
ps
write_version_flag
(
flag_name
,
flag_path
,
flag_vers
)
ps
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FWriteText
ps
|
not
ok
=
abort
"set failed"
#
file
=
writeln
app
_vers
file
#
file
=
writeln
app
_name
file
#
file
=
writeln
app
_path
file
#
file
=
writeln
flag
_vers
file
#
file
=
writeln
flag
_name
file
#
file
=
writeln
flag
_path
file
#
(_,
ps
)
=
fclose
file
ps
=
ps
where
writeln
s
f
=
f
<<<
s
<<<
'\n'
check_registry
app_path
ps
#
(
err
,
rs
)
=
([],
7
)
#
(
err
,
found
,
rs
)
=
check_file_type_in_registry
registry_name
command
err
rs
|
notEmpty
err
=
abort
(
hd
err
+++.
"
\n
"
)
///////////////!!!!!!!!!!!!!!!!!!!!!
|
found
==
""
check_flags
::
!
String
!
String
!
String
![(
String
,
String
,
String
)]
!(
PSt
.
l
)
->
(!
Bool
,!
PSt
.
l
)
check_flags
_
_
_
[]
ps
=
(
True
,
ps
)
check_flags
app_vers
app_path
app_name
[(
flag_name
,
flag_path
,
flag_vers
):
flags
]
ps
|
app_vers
==
flag_vers
&&
app_path
==
flag_path
&&
app_name
==
flag_name
=
(
False
,
ps
)
=
check_flags
app_vers
app_path
app_name
flags
ps
check_registry
::
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
CheckResult
,!
PSt
.
l
)
check_registry
app_name
app_path
app_vers
ps
#
(
name
,
path
,
vers
,
errs
)
=
get_ide_from_registry
|
notEmpty
errs
=
(
NoEntry
,
ps
)
#
mine
=
quoted
app_path
|
found
<>
mine
|
name
<>
app_name
||
path
<>
app_path
||
vers
<>
app_vers
=
(
DiffEntry
,
ps
)
=
(
MyEntry
,
ps
)
where
registry_name
=
"iclfile
\0
"
command
=
"open
\0
"
quoted
string
=
"
\"
"
+++
string
+++
"
\"
\"
%1
\"
"
set
_registry
app
_name
app_path
ps
#
err
=
change_ide_registry_fun
app_name
app_path
#
err
=
change_pcl_registry_fun
app_name
app_path
pcl_name
pcl_path
#
err
=
change_
hcl
_registry_fun
app_name
app_path
hcl
_name
hcl
_path
set_registry
::
!
String
!
String
!
String
!
String
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
String
,!
PSt
.
l
)
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
#
(
err
,
r
)
=
enter_ide_in
_registry
(
ide
_name
+++
"
\0
"
)
(
ide_path
+++
"
\0
"
)
(
ide_vers
+++
"
\0
"
)
[]
7
|
notEmpty
err
||
r
<>
7
=
(
hd
err
,
ps
)
#
err
=
change_
ide
_registry_fun
ide
_name
ide
_path
|
notEmpty
err
=
abort
(
hd
err
+++.
"
\n
"
)
///////////////!!!!!!!!!!!!!!!!!!!!!
=
ps
=
(
hd
err
,
ps
)
#
err
=
change_pcl_registry_fun
ide_name
ide_path
pcl_name
pcl_path
|
notEmpty
err
=
(
hd
err
,
ps
)
#
err
=
change_hcl_registry_fun
ide_name
ide_path
hcl_name
hcl_path
|
notEmpty
err
=
(
hd
err
,
ps
)
=
(
""
,
ps
)
import
StdIO
init_dialog
::
!(
PSt
.
l
)
->
(!
In
t
,!
PSt
.
l
)
init_dialog
::
!(
PSt
.
l
)
->
(!
DialogResul
t
,!
PSt
.
l
)
init_dialog
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
...
...
@@ -227,7 +259,8 @@ init_dialog ps
|
err
<>
NoError
||
isNothing
res
=
(
No
,
ps
)
=
(
fromJust
res
,
ps
)
delta_dialog
::
!(
PSt
.
l
)
->
(!
Int
,!
PSt
.
l
)
delta_dialog
::
!(
PSt
.
l
)
->
(!
DialogResult
,!
PSt
.
l
)
delta_dialog
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
...
...
@@ -284,6 +317,26 @@ ddef okId cancelId dialogId = Dialog "Ide Integration"
]
dfun
ret
dId
(_,
ps
)
=
(
ret
,
closeWindow
dId
ps
)
err_dialog
wasChecking
err
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
dlogId
,
ps
)
=
openId
ps
#
(_,
ps
)
=
openModalDialog
Void
(
Dialog
(
if
wasChecking
"Check Registry Failed!"
"Setting Registry Failed!"
)
(
edef
okId
dlogId
)
[
WindowOk
okId
,
WindowId
dlogId
]
)
ps
=
ps
where
edef
okId
dlogId
=
TextControl
(
if
wasChecking
"Checking the windows registry failed:"
"Setting the windows registry failed:"
)
[
ControlPos
(
Left
,
zero
)
]
:+:
TextControl
err
[
ControlPos
(
Left
,
zero
)]
:+:
ButtonControl
"OK"
[
ControlPos
(
Right
,
zero
),
ControlId
okId
,
ControlFunction
(
noLS
(
closeWindow
dlogId
))]
//==
Start`
...
...
@@ -313,6 +366,8 @@ import code from "cCrossCall_121.obj", "cCrossCallProcedureTable_121.obj", "cAcc
"util_121.obj"
import
code
from
library
"userExt_library"
// from clCCall_12.dcl...
winGetModulePath
::
{#
Char
}
winGetModulePath
=
code
...
...
@@ -346,14 +401,12 @@ where
check
::
!
Int
!
RegistryKey
!
Bool
!
RegistryState
->
(![
String
],!
String
,!
RegistryState
)
check
hkey
[]
is_a_string
rs
#
data
=
createArray
256
'@'
#
size
=
"
\0\1\0\0
"
#
size
=
{
c
\\
c
<-:
"
\0\1\0\0
"
}
#
(
r
,
rs
)
=
if
is_a_string
(
RegQueryValueEx
hkey
"
\0
"
0
0
data
size
rs
)
(
RegQueryValueEx
hkey
"EditFlags
\0
"
0
0
data
size
rs
)
|
r
<>
ERROR_SUCCESS
=
([
"RegQueryValueEx failed
\n
"
],
""
,
rs
)
// # rs = trace_n ("data: "+++.data) rs
// # rs = trace_n ("size: "+++. (convert size)) rs
#
size
=
convert2
size
#
value
=
data
%(
0
,
size
-2
)
=
([],
value
,
rs
)
...
...
@@ -362,7 +415,7 @@ where
|
r
<>
ERROR_SUCCESS
#
(
r
,
hkey2
,
rs
)
=
RegOpenKeyEx
hkey
path
0
(
KEY_READ
bitor
KEY_SET_VALUE
)
rs
|
r
<>
ERROR_SUCCESS
=
abort
"RegOpenKeyEx failed
\n
"
// 1
=
([
"RegOpenKeyEx failed
\n
"
],
""
,
rs
)
#
(
e
,
r
,
rs
)
=
check
hkey2
path_list
is_a_string
rs
#
(_,
rs
)
=
RegCloseKey
hkey2
rs
=
(
e
,
r
,
rs
)
...
...
@@ -390,16 +443,7 @@ convert2 s
,
hcl
::
!
Bool
}
remStart
#
(
e
,
rs
)
=
([],
0
)
#
(
e
,
rs
)
=
remove_file_type_from_registry
".icl
\0
"
"iclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".dcl
\0
"
"dclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".prj
\0
"
"prjfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".abc
\0
"
"abcfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".pcl
\0
"
"pclfile
\0
"
"open
\0
"
e
rs
#
(
e
,
rs
)
=
remove_file_type_from_registry
".hcl
\0
"
"hclfile
\0
"
"open
\0
"
e
rs
=
e
change_hcl_registry_fun
::
!
String
!
String
!
String
!
String
->
[
String
]
change_hcl_registry_fun
ide_name
ide_path
hcl_name
hcl_path
#
(
e
,
rs
)
=
([],
0
)
#
(
e
,
rs
)
=
enter_file_type_in_registry
hclMapping
e
rs
...
...
@@ -417,6 +461,7 @@ where
}
application
=
StripExtension
hcl_name
+++.
"
\0
"
change_pcl_registry_fun
::
!
String
!
String
!
String
!
String
->
[
String
]
change_pcl_registry_fun
ide_name
ide_path
pcl_name
pcl_path
#
(
e
,
rs
)
=
([],
0
)
#
(
e
,
rs
)
=
enter_file_type_in_registry
pclMapping
e
rs
...
...
@@ -497,6 +542,30 @@ where
,
fm_icon
::
!
Maybe
!
String
// resource identifier string [NULL-terminated]
}
enter_ide_in_registry
name
path
vers
e
rs
#
(
e
,
rs
)
=
add_to_registry
[
"Software
\0
"
,
"Clean
\0
"
]
"
\0
"
True
e
rs
#
(
e
,
rs
)
=
add_to_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
]
"
\0
"
True
e
rs
#
(
e
,
rs
)
=
add_to_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Name
\0
"
]
name
True
e
rs
#
(
e
,
rs
)
=
add_to_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Path
\0
"
]
path
True
e
rs
#
(
e
,
rs
)
=
add_to_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Vers
\0
"
]
vers
True
e
rs
=
(
e
,
rs
)
remove_ide_from_registry
e
rs
#
(
e
,
rs
)=
remove_from_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Name
\0
"
]
e
rs
#
(
e
,
rs
)=
remove_from_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Path
\0
"
]
e
rs
#
(
e
,
rs
)=
remove_from_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Vers
\0
"
]
e
rs
#
(
e
,
rs
)=
remove_from_registry
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
]
e
rs
#
(
e
,
rs
)=
remove_from_registry
[
"Software
\0
"
,
"Clean
\0
"
]
e
rs
=
(
e
,
rs
)
get_ide_from_registry
::
(!
String
,!
String
,!
String
,![
String
])
get_ide_from_registry
#
rs
=
7
#
(
nerr
,
name
,
rs
)
=
check_registry_key
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Name
\0
"
]
rs
#
(
perr
,
path
,
rs
)
=
check_registry_key
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Path
\0
"
]
rs
#
(
verr
,
vers
,
rs
)
=
check_registry_key
[
"Software
\0
"
,
"Clean
\0
"
,
"CleanIDE
\0
"
,
"Vers
\0
"
]
rs
=
(
name
,
path
,
vers
,
nerr
++
perr
++
verr
)
enter_file_type_in_registry
::
!
FileMapping
[
String
]
!
RegistryState
->
(![
String
],!
RegistryState
)
enter_file_type_in_registry
fm
e
rs
#
(
e
,
rs
)
=
add_to_registry
p1
fm
.
fm_registry_name
True
e
rs
...
...
@@ -575,14 +644,14 @@ add_to_registry` hkey1 [] value value_is_a_string rs
(
RegSetValueEx
hkey1
"
\0
"
0
REG_SZ
value
(
size
value
)
rs
)
(
RegSetValueEx
hkey1
"EditFlags
\0
"
0
REG_BINARY
value
4
rs
)
|
r
<>
ERROR_SUCCESS
=
abort
"RegSetValueEx failed
\n
"
// 1
=
(
1
,
rs
)
//
"RegSetValueEx failed\n"
=
(
0
,
rs
)
add_to_registry`
hkey1
[
path
:
path_list
]
value
value_is_a_string
rs
#
(
r
,
hkey2
,
dw
,
rs
)
=
RegCreateKeyEx
hkey1
path
0
"
\0
"
REG_OPTION_NON_VOLATILE
KEY_ALL_ACCESS
0
rs
|
r
<>
ERROR_SUCCESS
#
(
r
,
hkey2
,
dw
,
rs
)
=
RegCreateKeyEx
hkey1
path
0
"
\0
"
REG_OPTION_NON_VOLATILE
(
KEY_READ
bitor
KEY_SET_VALUE
)
0
rs
|
r
<>
ERROR_SUCCESS
=
abort
"RegCreateKeyEx failed
\n
"
// 1
=
(
2
,
rs
)
//
"RegCreateKeyEx failed\n"
#
(
r
,
rs
)
=
add_to_registry`
hkey2
path_list
value
value_is_a_string
rs
#
(_,
rs
)
=
RegCloseKey
hkey2
rs
=
(
r
,
rs
)
...
...
Registry/registry.icl
View file @
e1f4cd2d
...
...
@@ -41,32 +41,11 @@ RegSetValueEx :: !Int !{#Char} !Int !Int !{#Char} !Int !RegistryState -> (!Int,!
RegSetValueEx
hkey
s1
i1
i2
s2
i3
rs
=
code {
ccall
RegSetValueExA@24
"PIsIIsI:I"
}
;
/*