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
Hide whitespace changes
Inline
Side-by-side
Pm/PmPrefs.dcl
View file @
e1f4cd2d
definition
module
PmPrefs
definition
module
PmPrefs
/*
// The IDE Preferences
The IDE Preferences
*/
from
StdPictureDef
import
::
FontDef
from
StdPictureDef
import
::
FontDef
import
StdFile
,
StdIOBasic
import
StdFile
,
StdIOBasic
...
@@ -90,6 +88,21 @@ PrefsFileName :== "IDEPrefs"
...
@@ -90,6 +88,21 @@ PrefsFileName :== "IDEPrefs"
,
be_verbose
::
!
Bool
// give extended diagnostics
,
be_verbose
::
!
Bool
// give extended diagnostics
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
newline_handling
::
!
NewlinePrefs
,
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
::
NewlinePrefs
...
...
Pm/PmPrefs.icl
View file @
e1f4cd2d
...
@@ -85,9 +85,20 @@ PrefsFileName :== "IDEPrefs"
...
@@ -85,9 +85,20 @@ PrefsFileName :== "IDEPrefs"
,
be_verbose
::
!
Bool
// give extended diagnostics
,
be_verbose
::
!
Bool
// give extended diagnostics
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
altgr_workaround
::
!
Bool
// temp fix to workaround french azerty keyboard menu shortcuts...
,
newline_handling
::
!
NewlinePrefs
,
newline_handling
::
!
NewlinePrefs
// RWS ...
// , number_of_processes :: !Int
,
reg_prefs
::
!
RegPrefs
// ... RWS
}
::
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
::
NewlinePrefs
...
@@ -120,8 +131,21 @@ emptyPrefs =
...
@@ -120,8 +131,21 @@ emptyPrefs =
,
be_verbose
=
False
,
be_verbose
=
False
,
altgr_workaround
=
False
,
altgr_workaround
=
False
,
newline_handling
=
LeaveAlone
NewlineConventionNone
,
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
=
emptyTypPrefs
=
{
typewinfont
=
NonProportionalFontDef
{
typewinfont
=
NonProportionalFontDef
,
typewinpos
=
{
vx
=
30
,
vy
=
30
}
,
typewinpos
=
{
vx
=
30
,
vy
=
30
}
...
@@ -354,6 +378,7 @@ PrefsOptionsTable =
...
@@ -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
"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
"AltGrWorkaround"
(\
a
->
if
a
.
altgr_workaround
"1"
"0"
)
(\
v
a
->{
a
&
altgr_workaround
=(
if
(
v
==
"1"
)
True
False
)})
,
SimpleOption
"NewlineHandling"
writeNLH
readNLH
,
SimpleOption
"NewlineHandling"
writeNLH
readNLH
,
GroupedOption
"RegPrefs"
RegPrefsOptionsTable
(\
a
->
a
.
reg_prefs
)
(\
v
a
->{
a
&
reg_prefs
=
v
})
}
}
where
where
writeNLH
{
newline_handling
}
writeNLH
{
newline_handling
}
...
@@ -378,6 +403,28 @@ where
...
@@ -378,6 +403,28 @@ where
"A3"
->
{
a
&
newline_handling
=
AlwaysUse
NewlineConventionDos
}
"A3"
->
{
a
&
newline_handling
=
AlwaysUse
NewlineConventionDos
}
_
->
{
a
&
newline_handling
=
LeaveAlone
NewlineConventionNone
}
_
->
{
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
::
OptionsTable
ErrPrefs
ErrPrefsOptionsTable
=
ErrPrefsOptionsTable
=
{
GroupedOption
"EWPos"
VectOptionsTable
(\
a
->
a
.
err_pos
)
(\
v
a
->{
a
&
err_pos
=
v
})
{
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
...
@@ -839,8 +839,7 @@ ReadProjectFile projectPath applicationDir ps
(
id
)
(
id
)
)
project
// DvA: need to set needs save flag for project;
)
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.
It's better to replace above with a dialog with popup of available environments.
Plus button om in htmlHelp in relevante sectie over environments te komen.
*/
*/
project
=
SetProject
applicationDir
projectDir
project
project
=
SetProject
applicationDir
projectDir
project
execpath
=
PR_GetExecPath
project
execpath
=
PR_GetExecPath
project
...
@@ -849,7 +848,7 @@ Plus button om in htmlHelp in relevante sectie over environments te komen.
...
@@ -849,7 +848,7 @@ Plus button om in htmlHelp in relevante sectie over environments te komen.
(
closed
,
ps
)
=
fclose
file
ps
(
closed
,
ps
)
=
fclose
file
ps
|
not
closed
|
not
closed
// generate warning?
// 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
)
=
((
project
,
True
,
""
),
ps
)
getStaticInfo
::
!
Project
->
(
ProjectStaticInfo
,
Project
)
getStaticInfo
::
!
Project
->
(
ProjectStaticInfo
,
Project
)
...
...
Pm/PmTypes.dcl
View file @
e1f4cd2d
definition
module
PmTypes
definition
module
PmTypes
/
*
The types for the Project Manager
*/
/
/
The types for the Project Manager
from
StdPathname
import
::
Pathname
from
StdPathname
import
::
Pathname
from
UtilNewlinesFile
import
::
NewlineConvention
(..)
from
UtilNewlinesFile
import
::
NewlineConvention
(..)
import
PmCompilerOptions
import
PmCompilerOptions
from
UtilStrictLists
import
::
List
from
UtilStrictLists
import
::
List
import
UtilDate
import
UtilDate
::
Modulename
:==
String
::
Modulename
:==
String
...
@@ -35,7 +34,7 @@ instance fromString Processor
...
@@ -35,7 +34,7 @@ instance fromString Processor
DefaultLinkOptions
::
LinkOptions
DefaultLinkOptions
::
LinkOptions
::
LinkMethod
::
LinkMethod
// => is really project method/type now?
=
LM_Static
=
LM_Static
// | LM_Eager
// | LM_Eager
|
LM_Dynamic
|
LM_Dynamic
...
...
Pm/PmTypes.icl
View file @
e1f4cd2d
implementation
module
PmTypes
implementation
module
PmTypes
/
*
The types for the Project Manager
*/
/
/
The types for the Project Manager
import
StdBool
,
StdInt
import
StdBool
,
StdInt
import
UtilStrictLists
,
UtilDate
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
registry
,
version
import
UtilIO
import
UtilIO
import
dodebug
//==
//==
...
@@ -15,18 +15,40 @@ GetLastError = code {
...
@@ -15,18 +15,40 @@ GetLastError = code {
}
}
//==
//==
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
Start
``
w
=
startIO
NDI
Void
pinit
[
ProcessClose
closeProcess
]
w
pinit
ps
pinit
ps
#
ps
=
first_run
app_vers
app_path
app_name
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
=
finish
ps
where
where
app_name
=
GetFileName
long_path
path
=
winGetModulePath
app_path
=
GetFilePath
path
long_path
=
GetLongPathName
path
app_vers
=
ReadVersionInfo
// ide_name = GetFileName long_path
path
=
winGetModulePath
// ide_path = GetFilePath path
long_path
=
GetLongPathName
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
::
!
String
->
String
;
GetFileName
path
GetFileName
path
...
@@ -101,7 +123,7 @@ ReadVersionInfo
...
@@ -101,7 +123,7 @@ ReadVersionInfo
#
sptr
=
s2i
buff
#
sptr
=
s2i
buff
#
slen
=
s2i
blen
#
slen
=
s2i
blen
// # info = toString sptr +++ " :: " +++ toString slen
// # 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
=
info
where
where
path
=
winGetModulePath
+++.
"
\0
"
path
=
winGetModulePath
+++.
"
\0
"
...
@@ -111,114 +133,124 @@ where
...
@@ -111,114 +133,124 @@ where
//==
//==
MyEntry
:==
1
::
CheckResult
NoEntry
:==
2
=
MyEntry
DiffEntry
:==
3
|
NoEntry
|
DiffEntry
|
ErrEntry
!
String
Yes
:==
1
::
DialogResult
No
:==
2
=
Yes
Never
:==
3
|
No
|
Never
first_run
app_vers
app_path
app_name
ps
first_run
::
!
String
!
String
!
String
!
String
!
String
!
String
!
String
![(
String
,
String
,
String
)]
!(
PSt
.
ls
)
->
(!
Bool
,!
PSt
.
ls
)
#
(
run
,
ps
)
=
check_flag
app_vers
app_path
app_name
ps
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
|
not
run
=
ps
=
(
False
,
ps
)
#
(
res
,
ps
)
=
check_registry
app_path
ps
#
(
res
,
ps
)
=
check_registry
ide_name
ide_path
ide_vers
ps
|
res
==
MyEntry
=
case
res
of
=
ps
MyEntry
->
(
False
,
ps
)
|
res
==
NoEntry
NoEntry
#
(
res
,
ps
)
=
init_dialog
ps
#
(
res
,
ps
)
=
init_dialog
ps
|
res
==
Yes
->
case
res
of
#
ps
=
set_registry
app_name
app_path
ps
Yes
#
(
err
,
ps
)
=
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
=
ps
|
err
<>
""
|
res
==
No
#
ps
=
err_dialog
False
err
ps
=
ps
=
(
False
,
ps
)
|
res
==
Never
=
(
False
,
ps
)
#
ps
=
set_flag
app_vers
app_path
app_name
ps
No
->
(
False
,
ps
)
=
ps
Never
->
(
True
,
ps
)
=
abort
"Uncaught case in first_run:first_run: [2]
\n
"
DiffEntry
|
res
==
DiffEntry
#
(
res
,
ps
)
=
delta_dialog
ps
#
(
res
,
ps
)
=
delta_dialog
ps
->
case
res
of
|
res
==
Yes
Yes
#
(
err
,
ps
)
=
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
#
ps
=
set_registry
app_name
app_path
ps
|
err
<>
""
=
ps
#
ps
=
err_dialog
False
err
ps
|
res
==
No
=
(
False
,
ps
)
=
ps
=
(
False
,
ps
)
|
res
==
Never
No
->
(
False
,
ps
)
#
ps
=
set_flag
app_vers
app_path
app_name
ps
Never
->
(
True
,
ps
)
=
ps
ErrEntry
err
=
abort
"Uncaught case in first_run:first_run: [3]
\n
"
#
ps
=
err_dialog
True
err
ps
=
abort
"Uncaught case in first_run:first_run: [1]
\n
"
=
(
False
,
ps
)
uninstall
application_path
ps
uninstall
::
!(
PSt
.
ls
)
->
(![
String
],!
PSt
.
ls
)
=
abort
"first_run:uninstall unimplemented.
\n
"
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
)
//==
//==
check_flag
app_vers
app_path
app_name
ps
read_version_flag
ps
// read flag => flag+vers+path+name
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FReadText
ps
// compare...
// if vers & path & name match => use flag
// otherwise run first-run
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FReadText
ps
|
not
ok
=
abort
"no VERSION"
|
not
ok
=
abort
"no VERSION"
#
(
flag_vers
,
file
)
=
freadline
file
#
(
flag_vers
,
file
)
=
freadline
file
#
(
flag_name
,
file
)
=
freadline
file
#
(
flag_name
,
file
)
=
freadline
file
#
(
flag_path
,
file
)
=
freadline
file
#
(
flag_path
,
file
)
=
freadline
file
#
flag_vers
=
dropnl
flag_vers
#
flag_vers
=
dropnl
flag_vers
#
flag_name
=
dropnl
flag_name
#
flag_name
=
dropnl
flag_name
#
flag_path
=
dropnl
flag_path
#
flag_path
=
dropnl
flag_path
#
(_,
ps
)
=
fclose
file
ps
#
(_,
ps
)
=
fclose
file
ps
|
app_vers
==
flag_vers
&&
app_path
==
flag_path
&&
app_name
==
flag_name
=
((
flag_name
,
flag_path
,
flag_vers
),
ps
)
=
trace_n`
"check=>False"
(
False
,
ps
)
=
trace_n`
"check=>True"
(
True
,
ps
)
where
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'
}
dropnl
s
=
{
c
\\
c
<-:
s
|
c
<>
'\xA'
&&
c
<>
'\xD'
}
set_flag
app_vers
app_path
app_name
ps
write_version_flag
(
flag_name
,
flag_path
,
flag_vers
)
ps
#
ps
=
trace_n`
(
"set"
,
app_vers
,
app_path
,
app_name
)
ps
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FWriteText
ps
#
(
ok
,
file
,
ps
)
=
fopen
"VERSION.txt"
FWriteText
ps
|
not
ok
=
abort
"set failed"
|
not
ok
=
abort
"set failed"
#
file
=
writeln
app
_vers
file
#
file
=
writeln
flag
_vers
file
#
file
=
writeln
app
_name
file
#
file
=
writeln
flag
_name
file
#
file
=
writeln
app
_path
file
#
file
=
writeln
flag
_path
file
#
(_,
ps
)
=
fclose
file
ps
#
(_,
ps
)
=
fclose
file
ps
=
ps
=
ps
where
where
writeln
s
f
=
f
<<<
s
<<<
'\n'
writeln
s
f
=
f
<<<
s
<<<
'\n'
check_registry
app_path
ps
check_flags
::
!
String
!
String
!
String
![(
String
,
String
,
String
)]
!(
PSt
.
l
)
->
(!
Bool
,!
PSt
.
l
)
#
(
err
,
rs
)
=
([],
7
)
check_flags
_
_
_
[]
ps
=
(
True
,
ps
)
#
(
err
,
found
,
rs
)
=
check_file_type_in_registry
registry_name
command
err
rs
check_flags
app_vers
app_path
app_name
[(
flag_name
,
flag_path
,
flag_vers
):
flags
]
ps
|
notEmpty
err
|
app_vers
==
flag_vers
&&
app_path
==
flag_path
&&
app_name
==
flag_name
=
abort
(
hd
err
+++.
"
\n
"
)
///////////////!!!!!!!!!!!!!!!!!!!!!
=
(
False
,
ps
)
|
found
==
""
=
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
)
=
(
NoEntry
,
ps
)
#
mine
=
quoted
app_path
|
name
<>
app_name
||
path
<>
app_path
||
vers
<>
app_vers
|
found
<>
mine
=
(
DiffEntry
,
ps
)
=
(
DiffEntry
,
ps
)
=
(
MyEntry
,
ps
)
=
(
MyEntry
,
ps
)
where
registry_name
=
"iclfile
\0
"
command
=
"open
\0
"
quoted
string
=
"
\"
"
+++
string
+++
"
\"
\"
%1
\"
"
set_registry
app_name
app_path
ps
set_registry
::
!
String
!
String
!
String
!
String
!
String
!
String
!
String
!(
PSt
.
l
)
->
(!
String
,!
PSt
.
l
)
#
err
=
change_ide_registry_fun
app_name
app_path
set_registry
ide_vers
ide_name
ide_path
pcl_name
pcl_path
hcl_name
hcl_path
ps
#
err
=
change_pcl_registry_fun
app_name
app_path
pcl_name
pcl_path
#
(
err
,
r
)
=
enter_ide_in_registry
(
ide_name
+++
"
\0
"
)
(
ide_path
+++
"
\0
"
)
(
ide_vers
+++
"
\0
"
)
[]
7
#
err
=
change_hcl_registry_fun
app_name
app_path
hcl_name
hcl_path
|
notEmpty
err
||
r
<>
7
=
(
hd
err
,
ps
)
#
err
=
change_ide_registry_fun
ide_name
ide_path
|
notEmpty
err
|
notEmpty
err
=
abort
(
hd
err
+++.
"
\n
"
)
///////////////!!!!!!!!!!!!!!!!!!!!!
=
(
hd
err
,
ps
)
=
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
import
StdIO
init_dialog
::
!(
PSt
.
l
)
->
(!
In
t
,!
PSt
.
l
)
init_dialog
::
!(
PSt
.
l
)
->
(!
DialogResul
t
,!
PSt
.
l
)
init_dialog
ps
init_dialog
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
...
@@ -227,7 +259,8 @@ init_dialog ps
...
@@ -227,7 +259,8 @@ init_dialog ps
|
err
<>
NoError
||
isNothing
res
|
err
<>
NoError
||
isNothing
res
=
(
No
,
ps
)
=
(
No
,
ps
)
=
(
fromJust
res
,
ps
)
=
(
fromJust
res
,
ps
)
delta_dialog
::
!(
PSt
.
l
)
->
(!
Int
,!
PSt
.
l
)
delta_dialog
::
!(
PSt
.
l
)
->
(!
DialogResult
,!
PSt
.
l
)
delta_dialog
ps
delta_dialog
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
okId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
#
(
cancelId
,
ps
)
=
openId
ps
...
@@ -284,6 +317,26 @@ ddef okId cancelId dialogId = Dialog "Ide Integration"
...
@@ -284,6 +317,26 @@ ddef okId cancelId dialogId = Dialog "Ide Integration"
]
]
dfun
ret
dId
(_,
ps
)
dfun
ret
dId
(_,
ps
)
=
(
ret
,
closeWindow
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`
Start`
...
@@ -313,6 +366,8 @@ import code from "cCrossCall_121.obj", "cCrossCallProcedureTable_121.obj", "cAcc
...
@@ -313,6 +366,8 @@ import code from "cCrossCall_121.obj", "cCrossCallProcedureTable_121.obj", "cAcc
"util_121.obj"
"util_121.obj"
import
code
from
library
"userExt_library"
import
code
from
library
"userExt_library"
// from clCCall_12.dcl...