tools.icl 2.38 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
8
implementation module tools

import StdBool, StdFunc, StdFile, StdPStClass, StdSystem
import ExtNotice, StdPathname
import IdeState, UtilIO

//-- call out to supporting applications...

Diederik van Arkel's avatar
Diederik van Arkel committed
9
10
11
12
13
14
15
16
17
18
timepsuf	=: " Time Profile.pcl"
timeparg	=: " -h 4M "

heappsuf	=: " Heap Profile0.hcl"
heapparg	=: " -h 4M "

proofsuf	=: ".prj"
proofarg	=: " "

shoprofun :: !*(PSt General) -> *PSt General
Diederik van Arkel's avatar
Diederik van Arkel committed
19
20
21
22
23
shoprofun ps
	# (prj,ps)		= getProject ps
	# execpath		= PR_GetExecPath prj
	// approximate name mangling done by RTE
	// should still take into account max filename length
Diederik van Arkel's avatar
Diederik van Arkel committed
24
	# profpath		= quoted_string (RemoveSuffix` execpath +++ timepsuf)
25
26
	# (prefs,ps)	= getPrefs ps
	# timepapp		= quoted_string (prefs.reg_prefs.tp_path +++ prefs.reg_prefs.tp_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
27
	# sp			= timepapp +++ timeparg +++ profpath
Diederik van Arkel's avatar
Diederik van Arkel committed
28
29
	# stup			= RemoveFilename execpath
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
30
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
31
32
	# (ok,ps)		= accFiles (LaunchApplication sp stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
33
		= openNotice (Notice ["Unable to launch " +++  sp +++ ".",stup] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
34
35
	= ps

Diederik van Arkel's avatar
Diederik van Arkel committed
36
shoheapfun :: !*(PSt General) -> *PSt General
Diederik van Arkel's avatar
Diederik van Arkel committed
37
38
39
40
41
shoheapfun ps
	# (prj,ps)		= getProject ps
	# execpath		= PR_GetExecPath prj
	// approximate name mangling done by RTE
	// should still take into account max filename length
Diederik van Arkel's avatar
Diederik van Arkel committed
42
	# profpath		= quoted_string (RemoveSuffix` execpath +++ heappsuf)
43
44
	# (prefs,ps)	= getPrefs ps
	# heappapp		= quoted_string (prefs.reg_prefs.hp_path +++ prefs.reg_prefs.hp_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
45
	# sp			= heappapp +++  heapparg +++  profpath
Diederik van Arkel's avatar
Diederik van Arkel committed
46
47
	# stup			= RemoveFilename execpath
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
48
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
49
50
	# (ok,ps)		= accFiles (LaunchApplication sp stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
51
		= openNotice (Notice ["Unable to launch " +++  sp +++ ".",stup] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
52
53
	= ps

Diederik van Arkel's avatar
Diederik van Arkel committed
54
provefun :: !*(PSt General) -> *PSt General
Diederik van Arkel's avatar
Diederik van Arkel committed
55
56
provefun ps
	# (pathname,ps) = getPath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
57
	# pr_path		= quoted_string (RemoveSuffix` pathname +++. proofsuf)
58
59
	# (prefs,ps)	= getPrefs ps
	# proofapp		= quoted_string (prefs.reg_prefs.pr_path +++ prefs.reg_prefs.pr_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
60
	# cps			= proofapp +++ proofarg +++ pr_path
Diederik van Arkel's avatar
Diederik van Arkel committed
61
62
	# stup			= RemoveFilename pathname
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
63
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
64
65
	# (ok,ps)		= accFiles (LaunchApplication cps stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
66
		= openNotice (Notice ["Unable to launch " +++  cps +++ "."] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
67
68
	= ps