tools.icl 3.29 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
implementation module tools

import StdBool, StdFunc, StdFile, StdPStClass, StdSystem
import ExtNotice, StdPathname
5
import IdeState, UtilIO, PmPath, projwin
Diederik van Arkel's avatar
Diederik van Arkel committed
6
7
8

//-- 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
	# (prefs,ps)	= getPrefs ps
26
27
28
29
30
31
32
33
34
35

	# pcl_path				= prefs.reg_prefs.tp_path
	# (app_path,ps)			= accFiles GetFullApplicationPath ps
	# app_path				= GetLongPathName app_path
	# pcl_path				= fulAppPath app_path pcl_path
	# pcl_path				= case GetShortPathName pcl_path of
								(True,pcl_path)	-> pcl_path
								_				-> pcl_path

	# timepapp		= quoted_string (pcl_path +++ prefs.reg_prefs.tp_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
36
	# sp			= timepapp +++ timeparg +++ profpath
Diederik van Arkel's avatar
Diederik van Arkel committed
37
38
	# stup			= RemoveFilename execpath
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
39
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
40
41
	# (ok,ps)		= accFiles (LaunchApplication sp stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
42
		= openNotice (Notice ["Unable to launch " +++  sp +++ ".",stup] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
43
44
	= ps

Diederik van Arkel's avatar
Diederik van Arkel committed
45
shoheapfun :: !*(PSt General) -> *PSt General
Diederik van Arkel's avatar
Diederik van Arkel committed
46
47
48
49
50
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
51
	# profpath		= quoted_string (RemoveSuffix` execpath +++ heappsuf)
52
	# (prefs,ps)	= getPrefs ps
53
54
55
56
57
58
59
60
61
62

	# pcl_path				= prefs.reg_prefs.hp_path
	# (app_path,ps)			= accFiles GetFullApplicationPath ps
	# app_path				= GetLongPathName app_path
	# pcl_path				= fulAppPath app_path pcl_path
	# pcl_path				= case GetShortPathName pcl_path of
								(True,pcl_path)	-> pcl_path
								_				-> pcl_path

	# heappapp		= quoted_string (pcl_path +++ prefs.reg_prefs.hp_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
63
	# sp			= heappapp +++  heapparg +++  profpath
Diederik van Arkel's avatar
Diederik van Arkel committed
64
65
	# stup			= RemoveFilename execpath
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
66
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
67
68
	# (ok,ps)		= accFiles (LaunchApplication sp stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
69
		= openNotice (Notice ["Unable to launch " +++  sp +++ ".",stup] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
70
71
	= ps

Diederik van Arkel's avatar
Diederik van Arkel committed
72
provefun :: !*(PSt General) -> *PSt General
Diederik van Arkel's avatar
Diederik van Arkel committed
73
provefun ps
74
75
	# ps			= pm_save ps	// ensure project file is recent...
	
Diederik van Arkel's avatar
Diederik van Arkel committed
76
	# (pathname,ps) = getPath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
77
	# pr_path		= quoted_string (RemoveSuffix` pathname +++. proofsuf)
78
	# (prefs,ps)	= getPrefs ps
79
80
81
82
83
84
85
86
87
88

	# pcl_path				= prefs.reg_prefs.pr_path
	# (app_path,ps)			= accFiles GetFullApplicationPath ps
	# app_path				= GetLongPathName app_path
	# pcl_path				= fulAppPath app_path pcl_path
	# pcl_path				= case GetShortPathName pcl_path of
								(True,pcl_path)	-> pcl_path
								_				-> pcl_path

	# proofapp		= quoted_string (pcl_path +++ prefs.reg_prefs.pr_name)
Diederik van Arkel's avatar
Diederik van Arkel committed
89
	# cps			= proofapp +++ proofarg +++ pr_path
Diederik van Arkel's avatar
Diederik van Arkel committed
90
91
	# stup			= RemoveFilename pathname
	# (ok,ps)		= accFiles (FExists stup) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
92
	# stup			= if ok (stup +++ "\\") (applicationpath "")
Diederik van Arkel's avatar
Diederik van Arkel committed
93
94
	# (ok,ps)		= accFiles (LaunchApplication cps stup False) ps
	| not ok
Diederik van Arkel's avatar
Diederik van Arkel committed
95
		= openNotice (Notice ["Unable to launch " +++  cps +++ "."] (NoticeButton "OK" id) []) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
96
97
	= ps