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
b69907fe
Commit
b69907fe
authored
Oct 05, 2012
by
John van Groningen
Browse files
add support for hierarchical modules
parent
6198c5bc
Changes
8
Show whitespace changes
Inline
Side-by-side
Ide/IDE.icl
View file @
b69907fe
...
...
@@ -25,7 +25,7 @@ import ideoptions
import
clipboard
,
typewin
,
idehelp
,
PmEnvironment
,
search
import
errwin
,
messwin
,
projwin
,
edfiles
import
projmen
,
filehist
,
ioutil
,
menubar
from
PmDirCache
import
SearchDisk
from
PmDirCache
import
SearchDisk
,
FindHModule
import
targetui
from
PmCleanSystem
import
QuitCleanCompiler
import
Platform
,
PlatformObjectIO
,
IdePlatform
...
...
@@ -760,20 +760,22 @@ ed_open_sel openImp mods ps
#
(
res
,
ps
)
=
maybe_type_win_message
wId
msgGetSelection
ps
|
isJust
res
#
(
sel
,_)
=
fromJust
res
|
sel
==
""
||
not
(
CleanModId
sel
)
|
sel
==
""
||
not
(
is_h_module_name
sel
)
=
open_dlog
ps
#
sel
=
(
if
openImp
MakeImpPathname
MakeDefPathname
)
sel
=
OpenModule
sel
emptySelection
ps
=
open_imp_or_def_module
openImp
sel
ps
#
(
msel
,
ps
)
=
sendToActiveWindow
msgGetSelection
ps
|
isNothing
msel
=
open_dlog
ps
#
(
sel
,_)
=
fromJust
msel
|
sel
==
""
||
not
(
CleanModId
sel
)
|
sel
==
""
||
not
(
is_h_module_name
sel
)
=
open_dlog
ps
#
sel
=
(
if
openImp
MakeImpPathname
MakeDefPathname
)
sel
=
OpenModule
sel
emptySelection
ps
=
open_imp_or_def_module
openImp
sel
ps
where
open_imp_or_def_module
openImp
sel
ps
|
openImp
=
open_imp_module
sel
ps
=
open_def_module
sel
ps
open_dlog
pstate
#
(
dlogId
,
pstate
)
=
openId
pstate
(
textId
,
pstate
)
=
openId
pstate
...
...
@@ -843,42 +845,93 @@ ed_open_other pstate
=
pstate
=
pstate
OpenModuleNoSel
pathname
ps
get_environment_and_project_paths
::
!(*
PSt
General
)
->
(!
List
{#
Char
},!*
PSt
General
)
get_environment_and_project_paths
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
#
(
prj
,
ps
)
=
getProject
ps
#
prjpaths
=
PR_GetPaths
prj
#
srcpaths
=
AppendLists
prjpaths
syspaths
#
srcpaths
=
case
IsABCPathname
pathname
of
True
->
Map
MakeSystemPathname
srcpaths
_
->
srcpaths
=
(
AppendLists
prjpaths
syspaths
,
ps
)
OpenModuleNoSel
pathname
ps
#
(
srcpaths
,
ps
)
=
get_environment_and_project_paths
ps
#
srcpaths
=
if
(
IsABCPathname
pathname
)
(
Map
MakeSystemPathname
srcpaths
)
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
pathname
srcpaths
)
ps
|
not
ok
=
okNotice
[
"Clean Project Manager"
,
"Could not find file:"
,
pathname
]
ps
=
could_not_find_file_notice
pathname
ps
#
fullpath`
=
GetLongPathName
fullpath
=
ed_open_path
fullpath`
ps
n_chars_of_file_ext
s
#
n
=
size
s
|
n
>
3
&&
is_3_char_file_ext
(
s
%
(
n
-4
,
n
-1
))
=
4
|
n
>
2
&&
is_2_char_file_ext
(
s
%
(
n
-3
,
n
-1
))
=
3
=
0
where
is_3_char_file_ext
".icl"
=
True
is_3_char_file_ext
".dcl"
=
True
is_3_char_file_ext
".lhs"
=
True
is_3_char_file_ext
_
=
False
is_2_char_file_ext
".hs"
=
True
is_2_char_file_ext
_
=
False
split_string
::
!
Int
!{#
Char
}
->
(!{#
Char
},!{#
Char
})
split_string
i
s
#
n
=
size
s
#
i
=
n
-
i
=
(
s
%
(
0
,
i
-1
),
s
%
(
i
,
n
-1
))
OpenModule
::
!.
Modulename
!.
Selection
!*(
PSt
General
)
->
*
PSt
General
OpenModule
pathname
sel
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
#
(
prj
,
ps
)
=
getProject
ps
#
prjpaths
=
PR_GetPaths
prj
#
srcpaths
=
AppendLists
prjpaths
syspaths
#
srcpaths
=
case
IsABCPathname
pathname
of
True
->
Map
MakeSystemPathname
srcpaths
_
->
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
pathname
srcpaths
)
ps
#
(
srcpaths
,
ps
)
=
get_environment_and_project_paths
ps
#
srcpaths
=
if
(
IsABCPathname
pathname
)
(
Map
MakeSystemPathname
srcpaths
)
srcpaths
#
n
=
n_chars_of_file_ext
pathname
#
((
ok
,
fullpath
),
ps
)
=
if
(
n
==
0
)
(
accFiles
(
SearchDisk
pathname
srcpaths
)
ps
)
(
let
(
module_name
,
file_ext
)
=
split_string
n
pathname
in
accFiles
(
FindHModule
module_name
file_ext
srcpaths
)
ps
)
|
not
ok
=
could_not_find_file_notice
pathname
ps
#
fullpath`
=
GetLongPathName
fullpath
=
ed_open_path_sel
fullpath`
sel
ps
open_def_module
::
!
Modulename
!*(
PSt
General
)
->
*
PSt
General
open_def_module
pathname
ps
#
module_name
=
RemoveSuffix
pathname
#
(
srcpaths
,
ps
)
=
get_environment_and_project_paths
ps
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
FindHModule
module_name
".dcl"
srcpaths
)
ps
|
not
ok
=
could_not_find_file_notice
(
module_name
+++
".dcl"
)
ps
#
fullpath`
=
GetLongPathName
fullpath
=
ed_open_path_sel
fullpath`
emptySelection
ps
open_imp_module
::
!
Modulename
!*(
PSt
General
)
->
*
PSt
General
open_imp_module
pathname
ps
#
module_name
=
RemoveSuffix
pathname
#
(
srcpaths
,
ps
)
=
get_environment_and_project_paths
ps
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
FindHModule
module_name
".icl"
srcpaths
)
ps
|
ok
=
open_file
fullpath
ps
|
not
ok
=
could_not_find_file_notice
(
module_name
+++
".icl"
)
ps
where
open_file
fullpath
ps
#
fullpath`
=
GetLongPathName
fullpath
=
ed_open_path_sel
fullpath`
emptySelection
ps
could_not_find_file_notice
file_name
ps
=
okNotice
[
"Clean Project Manager"
,
"Could not find file:"
,
path
name
,
file_
name
]
ps
#
fullpath`
=
GetLongPathName
fullpath
=
ed_open_path_sel
fullpath`
sel
ps
//--- edit menu stuff
...
...
Ide/edfiles.icl
View file @
b69907fe
...
...
@@ -14,8 +14,6 @@ import menubar
import
UtilNewlinesFile
//import treeparse //P4
//--
ed_ask_save_all
::
!
Bool
!
Bool
(*(
PSt
General
)
->
*
PSt
General
)
!*(
PSt
General
)
->
*
PSt
General
ed_ask_save_all
close
update_in_project
cont
pstate
#
(
windows
,
pstate
)
=
accPIO
getWindowsStack
pstate
...
...
@@ -125,6 +123,9 @@ ed_open_cont pathName cont ps
// bring to front...allready done by 'doall'
=
cont
True
(
fromJust
exists
)
ps
// read the file from disk
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
(
prjpaths
,
ps
)
=
getFromProject
PR_GetPaths
ps
({
mdn_name
=
modname
},_)
=
determine_dir_and_filename
pathName
(
AppendLists
prjpaths
syspaths
)
#
((
errorText
,
nlConv
,
readOnly
),
ps
)
=
readText
pathName
ps
|
isError
errorText
...
...
@@ -135,7 +136,6 @@ ed_open_cont pathName cont ps
,
giveError
errorText
// for debugging purposes only?
]
ps
#
text
=
fromOk
errorText
#
modname
=
GetModuleName
pathName
#
isDefMod
=
IsDefPathname
pathName
#
isImpMod
=
IsImpPathname
pathName
#
(
inf
,
ps
)
=
getFromProject
(
PR_GetModuleInfo
modname
)
ps
...
...
@@ -442,7 +442,9 @@ ed_common_close update_in_project win ps
=
closeEditWindow
win
ps
// this should not occur
#
pos
=
fromJust
pos
#
(
siz
,
ps
)
=
accPIO
(
getWindowViewSize
win
)
ps
#
modname
=
GetModuleName
nam
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
(
prjpaths
,
ps
)
=
getFromProject
PR_GetPaths
ps
({
mdn_name
=
modname
},_)
=
determine_dir_and_filename
nam
(
AppendLists
prjpaths
syspaths
)
#
isDefmod
=
IsDefPathname
nam
#
pos_size
=
WindowPosAndSize
{
posx
=
pos
.
vx
,
posy
=
pos
.
vy
,
sizex
=
siz
.
w
,
sizey
=
siz
.
Size
.
h
}
#
update
=
\
inf
=:{
mod_edit_options
=
mod_edit_options
=:{
defeo
,
impeo
}}
->
if
isDefmod
...
...
Ide/projwin.icl
View file @
b69907fe
...
...
@@ -531,7 +531,7 @@ where
=
bf
r
makenice
_
_
[]
=
[]
makenice
u
s
l
=:[(
a
,
b
,_,_):
r
]
makenice
u
s
l
=:[(
imp_mod_name_with_ext
,
b
,_,_):
r
]
|
s
<>
b
// new directory
#
u`
=
isUnfoldedDir
b
srcpaths
dir
=
symPath
appPath
prjPath
b
...
...
@@ -540,93 +540,99 @@ where
(
"//--- "
+++
dir
,
pm_update_project_window_interactive
o
updFstate
b
True
,
id
)
=
[
pw_separator
:
makenice
u`
b
l
]
|
u
=
[(
GetModuleName
a
,
f
a
,
f`
a
):
makenice
u
s
r
]
// add seperators...
=
[(
GetModuleName
imp_mod_name_with_ext
,
f
imp_mod_name_with_ext
,
f`
imp_mod_name_with_ext
):
makenice
u
s
r
]
// add seperators...
=
makenice
u
s
r
where
f
mod
=
if
shift
(
open_def
b
mod
)
//(OpenModule (MakeDefPathname mod) emptySelection)
(
open_imp
b
mod
)
//(OpenModule (MakeImpPathname mod) emptySelection)
f`
mod
=
if
shift
(
open_imp
b
mod
)
//(OpenModule (MakeImpPathname mod) emptySelection)
(
open_def
b
mod
)
//(OpenModule (MakeDefPathname mod) emptySelection)
f
imp_mod_name_with_ext
=
if
shift
(
open_def
b
imp_mod_name_with_ext
)
(
open_imp
b
imp_mod_name_with_ext
)
f`
imp_mod_name_with_ext
=
if
shift
(
open_imp
b
imp_mod_name_with_ext
)
(
open_def
b
imp_mod_name_with_ext
)
isUnfoldedDir
d
Nil
=
False
isUnfoldedDir
d
((
u
,
d`
):!
ds
)
|
d
==
d`
=
u
=
isUnfoldedDir
d
ds
open_def
dirpath
mod
ps
#
defpath
=
MakeDefPathname
mod
#
path
=
dirpath
+++
defpath
open_def
dirpath
imp_mod_name_with_ext
ps
#
imp_mod_file_name
=
replace_dots_by_dir_separators
(
RemoveSuffix
imp_mod_name_with_ext
)
#
dcl_file_name
=
imp_mod_file_name
+++
".dcl"
#
path
=
dirpath
+++
dcl_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
l
hs
path
=
RemoveSuffix
mod
+++
".
l
hs"
#
path
=
dirpath
+++
l
hs
path
#
hs
_file_name
=
imp_mod_file_name
+++
".hs"
#
path
=
dirpath
+++
hs
_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
hs
path
=
RemoveSuffix
mod
+++
".hs"
#
path
=
dirpath
+++
hs
path
#
l
hs
_file_name
=
imp_mod_file_name
+++
".
l
hs"
#
path
=
dirpath
+++
l
hs
_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
defpath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".dcl"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
lhspath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".hs"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
hspath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".lhs"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
=
okNotice
[
"Clean Project Manager"
,
"Could not find file:"
,
defpath
]
ps
=
could_not_find_notice
dcl_file_name
ps
open_imp
dirpath
mod
ps
#
defpath
=
MakeImpPathname
mod
#
path
=
dirpath
+++
defpath
open_imp
dirpath
imp_mod_name_with_ext
ps
#
imp_mod_file_name
=
replace_dots_by_dir_separators
(
RemoveSuffix
imp_mod_name_with_ext
)
#
icl_file_name
=
imp_mod_file_name
+++
".icl"
#
path
=
dirpath
+++
icl_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
l
hs
path
=
RemoveSuffix
mod
+++
".
l
hs"
#
path
=
dirpath
+++
l
hs
path
#
hs
_file_name
=
imp_mod_file_name
+++
".hs"
#
path
=
dirpath
+++
hs
_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
hs
path
=
RemoveSuffix
mod
+++
".hs"
#
path
=
dirpath
+++
hs
path
#
l
hs
_file_name
=
imp_mod_file_name
+++
".
l
hs"
#
path
=
dirpath
+++
l
hs
_file_name
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
defpath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".icl"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
lhspath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".hs"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
(
exists
,
path
,
ps
)
=
exists_module
hspath
ps
#
(
exists
,
path
,
ps
)
=
exists_module
imp_mod_file_name
".lhs"
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
=
could_not_find_notice
icl_file_name
ps
could_not_find_notice
path
ps
=
okNotice
[
"Clean Project Manager"
,
"Could not find file:"
,
def
path
,
path
]
ps
exists_module
pathname
ps
exists_module
::
{#
Char
}
{#
Char
}
*(
PSt
*
General
)
->
*(!
Bool
,{#
Char
},!*(
PSt
*
General
))
exists_module
module_name
file_ext
ps
#
(
srcpaths
,
ps
)
=
get_project_and_environment_paths
ps
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
FindHModule
module_name
file_ext
srcpaths
)
ps
=
(
ok
,
GetLongPathName
fullpath
,
ps
)
get_project_and_environment_paths
::
*(
PSt
*
General
)
->
*(!(
List
{#
Char
}),!*(
PSt
*
General
))
get_project_and_environment_paths
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
#
(
prj
,
ps
)
=
getProject
ps
#
prjpaths
=
PR_GetPaths
prj
#
srcpaths
=
AppendLists
prjpaths
syspaths
#
srcpaths
=
case
IsABCPathname
pathname
of
True
->
Map
MakeSystemPathname
srcpaths
_
->
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
pathname
srcpaths
)
ps
=
(
ok
,
GetLongPathName
fullpath
,
ps
)
=
(
AppendLists
prjpaths
syspaths
,
ps
)
// pm_set: set main module
pm_set
::
!*(
PSt
*
General
)
->
*
PSt
*
General
...
...
@@ -777,7 +783,9 @@ pm_copt ps
#
(
path
,
ps
)
=
sendToActiveWindow
msgGetPathName
ps
|
isJust
path
#
path
=
fromJust
path
#
mod
=
GetModuleName
path
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
(
prjpaths
,
ps
)
=
getFromProject
PR_GetPaths
ps
({
mdn_name
=
mod
},_)
=
determine_dir_and_filename
path
(
AppendLists
prjpaths
syspaths
)
#
minf
=
PR_GetModuleInfo
mod
project
|
isNothing
minf
// module not found in project...
...
...
@@ -841,18 +849,14 @@ getActiveModules ps
findModule
::
!.
Modulename
!*(
PSt
General
)
->
(!
Maybe
Pathname
,!*
PSt
General
)
findModule
pathname
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
#
(
prj
,
ps
)
=
getProject
ps
#
prjpaths
=
PR_GetPaths
prj
#
srcpaths
=
AppendLists
prjpaths
syspaths
#
srcpaths
=
case
IsABCPathname
pathname
of
True
->
Map
MakeSystemPathname
srcpaths
_
->
srcpaths
#
(
srcpaths
,
ps
)
=
get_project_and_environment_paths
ps
#
srcpaths
=
if
(
IsABCPathname
pathname
)
(
Map
MakeSystemPathname
srcpaths
)
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
pathname
srcpaths
)
ps
|
not
ok
=
(
Nothing
,
ps
)
#
fullpath`
=
GetLongPathName
fullpath
=
(
Just
fullpath`
,
ps
)
=
(
Just
(
GetLongPathName
fullpath
),
ps
)
DoProcess
msg
compile
cont
ps
#
(
paths
,
ps
)
=
getActiveModules
ps
...
...
Ide/search.icl
View file @
b69907fe
...
...
@@ -11,10 +11,9 @@ import PmParse, PmPath
import
ioutil
import
PmPrefs
from
EdText
import
textToStrings
from
PmDirCache
import
SearchDisk
from
PmDirCache
import
SearchDisk
,
FindHModule
import
morecontrols
,
colorpickcontrol
,
colourclip
initFindBoxInfo
::
!
Prefs
!*
a
->
*(.(
FindBoxInfo
*(
PSt
General
)),*
a
)
|
Ids
,
accScreenPicture
a
initFindBoxInfo
prefs
pstate
#
(
dlogId
,
pstate
)
=
openId
pstate
...
...
@@ -55,8 +54,6 @@ initFindBoxInfo prefs pstate
}
=
(
fbi
,
pstate
)
//--
sr_find_idi
::
!
Bool
!*(
PSt
General
)
->
*
PSt
General
sr_find_idi
always_dialog
pstate
// Find Definition & Implementation & Identifier
#
(
fbi
,
pstate
)
=
getFBI
pstate
...
...
@@ -114,8 +111,6 @@ sr_find_def_imp_sel always_dialog selection pathname info=:{cleanid} pstate
=
fi_dialog
info
pstate
=
fi_messagebox
info
pstate
//--
fi_messagebox
info
=:{
cleanid
,
dlogId
,
stringId
,
msgId
,
kind
,
closeId
}
pstate
|
isEmpty
cleanid
=
pstate
...
...
@@ -157,8 +152,6 @@ where
#
ps
=
closeWindow
dlogId
ps
=
(
ls
,
ps
)
//--
fi_dialog
info
=:{
dlogId
,
msgId
,
stringId
,
cleanid
,
kind
,
type
,
verb
,
export_
,
closeId
,
findId
,
recvId
}
pstate
#
pstate
=
closeWindow
dlogId
pstate
(_,
pstate
)
=
openModalDialog
info
dialog
pstate
...
...
@@ -276,22 +269,22 @@ recvfun _ (ls=:{is_searching,findId},ps)
#
ps
=
appPIO
(
setControlText
findId
"Stop"
)
ps
=
(
ls
,
ps
)
//--
import
StdPathname
,
Directory
getModulesInPaths
ps
#
(
ep
,
ps
)
=
getCurrentPaths
ps
#
(
pp
,
ps
)
=
getFromProject
PR_GetPaths
ps
#
(
mods
,
ps
)
=
accFiles
(
findmods
(
Concat
pp
ep
))
ps
=
(
mods
,
ps
)
=
accFiles
(
findmods
(
Concat
pp
ep
))
ps
where
findmods
Nil
files
=
([],
files
)
findmods
(
path
:!
paths
)
files
#
((
ok
,
path`
),
files
)
=
pd_StringToPath
path
files
|
not
ok
=
findmods
paths
files
|
not
ok
=
findmods
paths
files
#
((
err
,
dir
),
files
)
=
getDirectoryContents
path`
files
|
err
<>
NoDirError
=
findmods
paths
files
|
err
<>
NoDirError
=
findmods
paths
files
#
dir
=
map
getinfo
dir
// only need common fileinfo...
#
dir
=
filter
(\(
b
,
n
)->
(
not
b
))
dir
#
dir
=
map
(\(_,
n
)->
n
)
dir
...
...
@@ -306,43 +299,48 @@ where
=
(
isDirectory
,
fileName
)
is_interesting
string
|
lengths
<
lengthsuf
=
False
;
=
isMember
(
string
%
(
lengths
-
lengthsuf
,
lengths
))
[
suffix1
,
suffix2
]
where
lengths
=
dec
(
size
string
);
lengthsuf
=
dec
(
size
suffix1
);
suffix1
=
".icl"
suffix2
=
".dcl"
#
s
=
size
string
suffix_4
=
string
%
(
s
-4
,
s
-1
)
suffix_3
=
string
%
(
s
-3
,
s
-1
)
=
(
s
>=
4
&&
(
suffix_4
==
".icl"
||
suffix_4
==
".dcl"
))
||
(
s
>=
3
&&
suffix_3
==
".hs"
)
//
sr_find_worker ::
.
FindBoxInfo
.Pathname *(PSt .Project
General) ->
*
PSt General
sr_find_worker
::
!(
FindBoxInfo
*(
PSt
*
General
),!*(
PSt
*
General
)
)
->
(!
FindBoxInfo
*(
PSt
*
General
),!*
PSt
*
General
)
sr_find_worker
(
info
=:{
kind
,
type
,
dlogId
=
fId
,
intrId
=
tId
,
pathname
},
pstate
)
// close search window... so that it can be opened later with the search results
#
pstate
=
sw_safe_close
pstate
|
type
==
SearchPaths
=
case
type
of
SearchPaths
#
(
modpaths
,
pstate
)
=
getModulesInPaths
pstate
#
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
pathname
(
pathname
:!
(
ListToStrictList
modpaths
))
kind
)
pstate
=
(
info
,
pstate
)
|
type
==
SearchProject
// Wrong: searches imports visible from main instead of project :-(
(
paths
,
pstate
)
=
get_paths
pstate
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
pathname
(
pathname
:!
(
ListToStrictList
modpaths
))
kind
paths
)
pstate
->
(
info
,
pstate
)
SearchProject
// Wrong: searches imports visible from main instead of project :-(
#
(
prj
,
pstate
)
=
getProject
pstate
#
(
rootpath
,
prj
)
=
PR_GetRootPathName
prj
#
rootmodn
=
PR_GetRootModuleName
prj
#
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
rootpath
(
rootmodn
:!
Nil
)
kind
)
pstate
=
(
info
,
pstate
)
// type == SearchImports
#
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
pathname
(
GetModuleName
pathname
:!
Nil
)
kind
)
pstate
=
(
info
,
pstate
)
({
mdn_dir
,
mdn_name
},
prj
)
=
PR_GetRootModuleDirAndName
prj
(
paths
,
pstate
)
=
get_paths
pstate
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
(
mdn_dir
+++
mdn_name
)
(
mdn_name
:!
Nil
)
kind
paths
)
pstate
->
(
info
,
pstate
)
SearchImports
#
(
paths
,
pstate
)
=
get_paths
pstate
({
mdn_dir
,
mdn_name
},
module_path
)
=
determine_dir_and_filename
pathname
paths
pstate
=
StartIntr
(
fId
,
tId
)
(
search
fId
tId
module_path
(
mdn_name
:!
Nil
)
kind
paths
)
pstate
->
(
info
,
pstate
)
where
search
dId
iId
pathname
modpaths
Identifier
intr
pstate
=
SearchIdentifiersInFiles
dId
iId
(
IsDefPathname
pathname
)
info
Nil
modpaths
intr
pstate
search
dId
iId
pathname
modpaths
search_kind
intr
pstate
=
SearchDefinitionInFiles
dId
iId
(
IsDefPathname
pathname
)
info
Nil
modpaths
intr
pstate
get_paths
pstate
#
(
syspaths
,
pstate
)
=
getCurrentPaths
pstate
(
prjpaths
,
pstate
)
=
getFromProject
PR_GetPaths
pstate
=
(
AppendLists
prjpaths
syspaths
,
pstate
)
search
dId
iId
pathname
modpaths
Identifier
paths
intr
pstate
=
SearchIdentifiersInFiles
dId
iId
(
IsDefPathname
pathname
)
info
Nil
modpaths
paths
intr
pstate
search
dId
iId
pathname
modpaths
search_kind
paths
intr
pstate
=
SearchDefinitionInFiles
dId
iId
(
IsDefPathname
pathname
)
info
Nil
modpaths
paths
intr
pstate
//--- Definition Search
//
SearchDefinitionInFiles
(done,todo) -> (done,todo
)
//SearchDefinitionInFiles :: !Id !Id !Bool !(FindBoxInfo *(PSt .Project *General)) !(List String) !(List Pathname) !Bool !*(PSt .Project *General)
-> *PSt *General
SearchDefinitionInFiles
dId
iId
is_dcl_file
info
=:{
type
}
done
modnames
intr
ps
SearchDefinitionInFiles
::
!
Id
!
Id
!
Bool
!(
FindBoxInfo
*(
PSt
*
General
))
!(
List
String
)
!(
List
Pathname
)
!(
List
Pathname
)
!
Bool
!*(
PSt
*
General
)
->
*
PSt
*
General
SearchDefinitionInFiles
dId
iId
is_dcl_file
info
=:{
type
}
done
modnames
paths
intr
ps
=
SearchDefinitionInFiles
True
False
is_dcl_file
info
done
modnames
intr
ps
where
imports
=
(
type
==
SearchImports
)
||
(
type
==
SearchProject
)
...
...
@@ -376,11 +374,10 @@ where
// if already done move onto next...
// slightly tricky phrasing is to make sure that if search starts in mod.icl then mod.dcl is also done...
=
SearchDefinitionInFiles
False
found
is_dcl_file
info
done
rest
intr
ps
#
ps
=
ChangeMsgString
verbose
(
"Searching '"
+++
RemovePath
modname`
+++
"'"
)
ps
(
syspaths
,
ps
)
=
getCurrentPaths
ps
(
prj
,
ps
)
=
getProject
ps
prjpaths
=
PR_GetPaths
prj
((
impsa
,
found_positions
),
ps
)
=
SearchDefinitionInFile
imports
rest
cleanid
modname`
syspaths
prjpaths
ps
#
modname`
=
add_suffix
is_dcl_file
modname
ps
=
ChangeMsgString
verbose
(
"Searching '"
+++
RemovePath
modname`
+++
"'"
)
ps
(
impsa
,
found_positions
,
modname`
,
ps
)
=
SearchDefinitionInFile
imports
rest
cleanid
modname`
paths
ps
found_in_file
=
case
found_positions
of
Pos
_
_
_
->
True
Cls
_
_
_
->
True
...
...
@@ -390,9 +387,9 @@ where
Definition
->
True
_
->
False
search_icl_file_next
=
found_in_file
&&
is_dcl_file
&&
(
not
find_definition
)
rest`
=
if
(
search_icl_file_next
)
rest`
=
if
search_icl_file_next
(
modname
:!
impsa
)
(
if
(
is_dcl_file
)
(
impsa
)
(
modname
:!
impsa
))
(
if
is_dcl_file
impsa
(
modname
:!
impsa
))
next_file_is_dcl_file
=
not
search_icl_file_next
found_here
=
found_in_file
&&
(
find_definition
==
is_dcl_file
)
found
=
found
||
found_here
...
...
@@ -402,49 +399,45 @@ where
=
ContIntr
(
dId
,
iId
)
(
SearchDefinitionInFiles
first
found
next_file_is_dcl_file
info
done`
rest`
)
ps
=
ContIntr
(
dId
,
iId
)
(
SearchDefinitionInFiles
first
found
next_file_is_dcl_file
info
done`
rest`
)
ps
where
modname`
|
is_dcl_file
=
MakeDefPathname
modname
=
MakeImpPathname
modname
done`
|
is_dcl_file
=
(
modname
:!
done
)
|
is_dcl_file
=
(
modname
:!
done
)
=
done
SearchDefinitionInFile
imp
rest
cleanid
modname
syspaths
prjpaths
ps
SearchDefinitionInFile
imp
rest
cleanid
modname
paths
ps
|
IsFullPathname
modname
#
(
win
,
ps
)
=
IsOpen
modname
ps
|
isJust
win
#
(
text
,
ps
)
=
message
(
fromJust
win
)
msgGetText
ps
|
isNothing
text
=
accFiles
(
FindDefinitionInFile
imp
rest
cleanid
modname
)
ps
#
text
=
fromJust
text
#
text
=
textToStrings
text
#
text
=
slToList
text
#
text
=
{
t
\\
t
<-
text
}
=
accFiles
(
FindDefinitionInText
imp
rest
cleanid
text
)
ps
=
accFiles
(
FindDefinitionInFile
imp
rest
cleanid
modname
)
ps