Commit f9238177 authored by Diederik van Arkel's avatar Diederik van Arkel

remove icons.exe

parent f4418e34
......@@ -60,6 +60,7 @@ import Platform, IdePlatform
import PmDriver
import ArgEnv
import logfile, set_return_code
import StdSystem
trace_n _ f :== f
......@@ -142,50 +143,50 @@ where
= ([],world)
# items = []
# (items,world) = toolIconFun
"bitmaps\\srchBM.bmp"
srchBM//"bitmaps\\srchBM.bmp"
(Just "Search...")
(sr_find_idi True)
items world
# (items,world) = toolIconFun
"bitmaps\\findBM.bmp"
findBM//"bitmaps\\findBM.bmp"
(Just "Find...")
sr_find
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun
"bitmaps\\execBM.bmp"
/* # (items,world) = toolIconFun
execBM//"bitmaps\\execBM.bmp"
(Just "Run")
pm_run
items world
# (items,world) = toolIconFun
"bitmaps\\updtBM.bmp"
*/ # (items,world) = toolIconFun
updtBM//"bitmaps\\updtBM.bmp"
(Just "Update")
(pm_upto False)
items world
# (items,world) = toolIconFun
"bitmaps\\urunBM.bmp"
urunBM//"bitmaps\\urunBM.bmp"
(Just "Update and Run")
pm_exec
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun
"bitmaps\\prntBM.bmp"
prntBM//"bitmaps\\prntBM.bmp"
(Just "Print...")
ed_print
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun
"bitmaps\\saveBM.bmp"
saveBM//"bitmaps\\saveBM.bmp"
(Just "Save")
(ide_save NoModifiers)
items world
# (items,world) = toolIconFun
"bitmaps\\openBM.bmp"
openBM//"bitmaps\\openBM.bmp"
(Just "Open...")
(ed_open NoModifiers)
items world
# (items,world) = toolIconFun
"bitmaps\\newfBM.bmp"
newfBM//"bitmaps\\newfBM.bmp"
(Just "New...")
(ed_new "*.icl")
items world
......@@ -194,9 +195,10 @@ where
# toolbar = [ ProcessToolbar items]
= (toolbar,world)
toolIconFun toolname tooltip toolfun itemlist world
# (bmp,world) = openBitmap (applicationpath toolname) world
// # (bmp,world) = openBitmap (applicationpath toolname) world
# (bmp,world) = GetBitmapResource toolname world
# itemlist = case bmp of
Nothing -> itemlist
Nothing -> abort ("Loading failed: "+++toString toolname)//itemlist
Just bmp -> [ToolbarItem bmp tooltip toolfun:itemlist]
= (itemlist,world)
ini envspath prefspath mEditId mEdUndoId iniClip iniTargets mTargetId eTargetId
......
......@@ -75,8 +75,8 @@ where
]) ps
// actualProject
(project,ps0) = getProject ps`
([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,c2id,c3id,c4id,xpId,rsrcsId,symbolsId:_],ps1)
= openIds 16 ps0
([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,r1id,c2id,c3id,c4id,xpId,rsrcsId,symbolsId:_],ps1)
= openIds 17 ps0
(lbpadId,ps2) = openExtListBoxId ps1
(lbobjId,ps3) = openExtListBoxId ps2
(lbdlibId,ps4) = openExtListBoxId ps3
......@@ -98,7 +98,7 @@ where
( applicationPane
:+: profilingPane
:+: diagnosticsPane
:+: pathsPane ap pp paths lbpadId c1id root_path
:+: pathsPane ap pp paths False 200 lbpadId c1id r1id root_path
:+: linkerPane
:+: objectsPane
:+: slibsPane
......@@ -120,21 +120,28 @@ where
# (wdef,ps) = accPIO (getWindow dlogId) ps
| isNothing wdef = abort "Fatal error in Project Options Dialog"
# wdef = fromJust wdef
[(ok1,hs),(ok2,ss),(ok3,hm),(ok4,ih),(ok5,mh),(ok6,em):_] = getControlTexts [hsId,ssId,hmId,ihId,mhId,emId] wdef
| not (ok1 && ok2 && ok3 && ok4 && ok5 && ok6)
[(ok1,hs),(ok2,ss),(ok3,hm),(ok4,ih),(ok5,mh):_] = getControlTexts [hsId,ssId,hmId,ihId,mhId] wdef
| not (ok1 && ok2 && ok3 && ok4 && ok5)
= abort "More fatal stuff in Project Options dialog"
| (isNothing hs) || (isNothing ss) || (isNothing hm) || (isNothing ih) || (isNothing mh) || (isNothing em)
| (isNothing hs) || (isNothing ss) || (isNothing hm) || (isNothing ih) || (isNothing mh)
= abort "Yet more fatal stuff in Project Options dialog"
# ls = { ls & ao =
{ls.ao
& hs = MemSizeToInt (fromJust hs)
, ss = MemSizeToInt (fromJust ss)
, em = MemSizeToInt (fromJust em)
// , em = MemSizeToInt (fromJust em)
, heap_size_multiple = StringToFixedPoint (fromJust hm)
, initial_heap_size = MemSizeToInt (fromJust ih)
, memoryProfilingMinimumHeapSize = MemSizeToInt (fromJust mh)
}}
# ls = PlatformDependant ls (macstuff ls wdef)
= (ls, closeWindow dlogId ps)
where
macstuff ls wdef
# (ok,em)= getControlText emId wdef
| not ok || isNothing em = abort "Fatal mac specific"
# ls = {ls & ao.em = MemSizeToInt (fromJust em)}
= ls
cancelfun (ls,ps) = (inils,closeWindow dlogId ps)
......@@ -165,9 +172,12 @@ where
// stack size
:+: EditControl (IntToMemSize ao.ss) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId ssId]
:+: TextControl "Stack Size" []
// extra memory (want only on mac...)
:+: EditControl (IntToMemSize ao.em) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId emId]
:+: TextControl "Extra Memory" []
:+: PlatformDependant // extra memory (want only on mac...)
(NilLS) // win
( // mac
EditControl (IntToMemSize ao.em) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId emId]
:+: TextControl "Extra Memory" []
)
// next heap size factor
:+: EditControl (FixedPointToString ao.heap_size_multiple) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId hmId]
:+: TextControl "Next Heap Size Factor" []
......@@ -176,7 +186,12 @@ where
:+: TextControl "Initial Heap Size" []
// marking collector
:+: CheckControl
[ ( "Use Marking Garbage Collector"
[ ( "Enable dynamics"
, Nothing
, if (lo.method == LM_Static) NoMark Mark
, noPS (\l->{l & lo = {l.lo & method = if (l.lo.method == LM_Static) LM_Dynamic LM_Static}})
)
, ( "Use Marking Garbage Collector"
, Nothing
, toMark ao.marking_collection
, noPS (\l->{l & ao = {l.ao & marking_collection = not l.ao.marking_collection}})
......@@ -245,10 +260,11 @@ where
)
linkerPane = Pane "Linker"
( TextControl "Linker Options" []
/*
:+: TextControl "Link Method" [ControlPos (Left,zero)]
:+: RadioControl
[("Static" ,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Static}}))
,("Eager" ,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Eager}}))
// ,("Eager" ,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Eager}}))
,("Lazy" ,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Dynamic}}))
]
(Rows 1) inilinkmethod
......@@ -257,6 +273,7 @@ where
:+: TextControl "Link Options"
[ ControlPos (Left,OffsetVector {zero & vy = 10})
]
*/
:+: CheckControl
[ ("Generate Relocations" ,Nothing,toMark lo.generate_relocations,noPS (\ls -> {ls & lo = {ls.lo & generate_relocations = not ls.lo.generate_relocations}}))
, ("Generate Link Map" ,Nothing,toMark lo.generate_link_map,noPS (\ls -> {ls & lo = {ls.lo & generate_link_map = not ls.lo.generate_link_map}}))
......@@ -279,12 +296,16 @@ where
:+: ButtonControl "Set dll symbol source..."
[ControlFunction setsymbols,ControlPos (Left,zero)]
)
/*
where
inilinkmethod = case lo.method of
LM_Static -> 1
LM_Dynamic -> 2
*/
/*
LM_Eager -> 2
LM_Dynamic -> 3
*/
setrsrcs (ls,ps)
# (rsrcname,ps) = PlatformDependant
(selectOutputFile "Resource source" "*.exe" ps) // win
......@@ -476,7 +497,7 @@ where
ps = appendExtListBoxItems lbdlibId (zip3 (FullPaths full ap pp (StrictListToList lo.libraries))(repeat id)(repeat id)) ps
= ((full,tg),ps)
pathsPane ap pp paths lbpadId c1id root_path
pathsPane ap pp paths inifull height lbpadId c1id r1id root_path
= Pane "Project Paths"
{addLS = inifull
,addDef = TextControl "Project Paths" []
......@@ -489,7 +510,11 @@ pathsPane ap pp paths lbpadId c1id root_path
[ ControlPos (Left,zero)
, ControlFunction removePath
, ControlWidth buttonWidth
, ControlId r1id
, ControlSelectState Unable
]
:+: ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
:+: ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
:+: lbpad
:+: CheckControl
......@@ -504,15 +529,28 @@ where
lbpad = ExtListBoxControl
(zip3(FullPaths inifull ap pp (StrictListToList paths))(repeat id)(repeat id))
[] // initial selection
(\_ ps -> ps)
(\sel ps->case sel of
[] -> appPIO (disableControl r1id) ps
_ -> appPIO (enableControl r1id) ps
) // selection update function
lbpadId
[ControlViewSize {h=200,w=300}]
[ControlViewSize {h=height,w=300}]
buttonWidth = ContentWidth "Append..."
inifull = False
lbUp ((full,tg),ps)
# lo = tg.paths
# (_,(lo,ps)) = upSelItem lbpadId (StrictListToList lo,ps)
# lo = ListToStrictList lo
# tg = {tg & paths = lo}
= ((full,tg),ps)
lbDn ((full,tg),ps)
# lo = tg.paths
# (_,(lo,ps)) = dnSelItem lbpadId (StrictListToList lo,ps)
# lo = ListToStrictList lo
# tg = {tg & paths = lo}
= ((full,tg),ps)
addPath ((full,tg),ps)
# (fs,ps) = selectDirectory` ps
| isNothing fs = ((full,tg),ps)
// # pathname = RemoveFilename (fromJust fs)
# pathname = fromJust fs
tg = {tg & paths = Append tg.paths pathname}
ps = appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
......@@ -568,17 +606,21 @@ doPathsDialog titlestring ap pp lo set ps
True
Nothing Nothing Nothing ps
(lb1Id,ps) = openExtListBoxId ps
(r1id,ps) = openId ps
lbpad = ExtListBoxControl
(zip3(FullPaths inifull ap pp (StrictListToList lo))(repeat id)(repeat id))
[] // initial selection
(\_ ps -> ps)
(\sel ps->case sel of
[] -> appPIO (disableControl r1id) ps
_ -> appPIO (enableControl r1id) ps
) // selection update function
lb1Id
[ControlViewSize {h=siz.Size.h,w=300}]
(_,ps) = openModalDialog (lo,inifull) (ddef wid okid cancelid lbpad lb1Id siz) ps
(_,ps) = openModalDialog (lo,inifull) (ddef wid okid cancelid lbpad lb1Id r1id siz) ps
= ps
where
inifull = False
ddef wid okId cancelId lb1 lb1Id siz = Dialog "Paths"
ddef wid okId cancelId lb1 lb1Id r1id siz = Dialog "Paths"
(title :+: left :+: buttons)
[WindowId wid, WindowOk okId, WindowCancel cancelId, WindowClose cancel]
where
......@@ -604,6 +646,8 @@ where
:+: ButtonControl "Remove"
[ ControlPos (Left,zero)
, ControlFunction removePath
, ControlSelectState Unable
, ControlId r1id
]
:+: ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
:+: ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
......
......@@ -4,7 +4,7 @@ implementation module idehelp
import StdFunc, StdMisc
import StdMenu, StdPStClass, StdSystem
import ExtNotice
import ioutil, UtilIO
import ioutil, UtilIO, IdePlatform
//import dodebug
trace_n` m f :== f
......@@ -12,7 +12,7 @@ trace_n` m f :== f
//-- export
IDE_VERSION
:== "v2.0 build 2001-08-28 "
:== "v2.0 build 2001-10-30 "
// want link(?) date/time to be automatically entered...
+++. PLATFORM
+++. CLEAN_VERSION
......@@ -47,7 +47,7 @@ initHelpMenu wId ps
bitmapname = case toInt '\n' of
13 -> applicationpath ":bitmaps:aboutIDE.pict"
10 -> applicationpath "bitmaps//aboutIDE.bmp"
10 -> applicationpath "bitmaps\\aboutIDE.bmp"
_ -> abort "idehelp: unknown platform"
idehelpname = applicationpath "idehelp"
......@@ -80,13 +80,14 @@ where
= (isDirectory,fileName)
help file wId ps
# path = applicationpath ("help//"+++.file)
# path = applicationpath ("help\\"+++.file)
# (ret,ps) = ShellDefault path ps
= trace_n` ("ShellExecute",ret,file) ps
= trace_n` ("ShellExecute",ret,file,path) ps
about wId ps
# (wId,ps) = openId ps
# (bmap,ps) = accFiles (openBitmap bitmapname) ps
// # (bmap,ps) = accFiles (openBitmap bitmapname) ps
# (bmap,ps) = GetBitmapResource AboutBitmap ps
| isNothing bmap
= openNotice (Notice [bitmapname+++" bitmap unavailable."] (NoticeButton "OK" id) []) ps
# bmap = fromJust bmap
......@@ -97,7 +98,6 @@ where
dloc = 0
ddef bmap cId wId
# bitmapSize = getBitmapSize bmap
# bitmapLook = \_ {newFrame} -> drawAt {x=newFrame.corner1.x+10,y=newFrame.corner2.y-20} IDE_VERSION o draw bmap
= Dialog "About the Clean IDE"
( CustomControl bitmapSize bitmapLook [ControlId cId])
[ WindowClose (noLS (closeWindow wId))
......@@ -105,3 +105,12 @@ where
, WindowHMargin 0 0
, WindowVMargin 0 0
]
where
bitmapLook _ {newFrame} p
# p = draw bmap p
# (font,p) = openDefaultFont p
# ((ok,font`),p) = openFont {SerifFontDef & fSize = 14} p
# font`` = if ok font` font
# p = setPenFont font`` p
# p = drawAt {x=newFrame.corner1.x+10,y=newFrame.corner2.y-20} IDE_VERSION p
= p
......@@ -12,7 +12,7 @@ ideOptionsDialog ps
# (okId,ps) = openId ps
# iniSWMark = toMark prefs.switch_close
# iniTBMark = toMark prefs.show_toolbar
# iniTPMark = toMark prefs.enable_prover
// # iniTPMark = toMark prefs.enable_prover
# iniBVMark = toMark prefs.be_verbose
# (iniNHIndex,iniCVIndex)
= case prefs.newline_handling of
......@@ -25,12 +25,12 @@ ideOptionsDialog ps
(AlwaysUse NewlineConventionUnix) -> (2,3)
(AlwaysUse NewlineConventionDos) -> (2,4)
# iniAWMark = toMark prefs.altgr_workaround
# (_,ps) = openModalDialog Void (ddef iniSWMark iniTBMark iniTPMark iniBVMark iniNHIndex iniCVIndex iniAWMark
# (_,ps) = openModalDialog Void (ddef iniSWMark iniTBMark /*iniTPMark*/ iniBVMark iniNHIndex iniCVIndex iniAWMark
okId wId) ps
= ps
ddef
iniSWMark iniTBMark iniTPMark iniBVMark iniNHIndex iniCVIndex iniAWMark
iniSWMark iniTBMark /*iniTPMark*/ iniBVMark iniNHIndex iniCVIndex iniAWMark
okId wId
= Dialog "IDE Options"
( CheckControl
......@@ -39,11 +39,13 @@ ddef
,("Verbose diagnostics",Nothing,iniBVMark,noLS switchBV)
,("AltGr workaround",Nothing,iniAWMark,noLS switchAW)
] (Columns 1) []
/*
:+: CheckControl
[("Enable Theorem Prover",Nothing,iniTPMark,id)
] (Columns 1)
[ControlSelectState Unable
,ControlPos (Left,zero)]
*/
:+: TextControl "Newline Handling"
[ControlPos (Left,zero)]
:+: RadioControl
......
......@@ -22,9 +22,12 @@ pm_menu_add path ps
= getMenuIds ps
// do Project menu...
# (prefs,ps) = getPrefs ps
# projIds = removeAt 9 projIds // Disable theorem prover module...
/*
# projIds = case prefs.enable_prover of
True -> removeAt 9 projIds
False -> removeAt 8 (removeAt 9 projIds)
*/
# ps = appPIO (enableMenuElements projIds) ps
// do Module menu...
# moduleIds = [mn_sav,mn_sva,md_cmp,md_chk,md_gen,md_cst,md_est]
......@@ -93,9 +96,12 @@ where
| isEmpty (fromJust rep)
# ({projIds},ps) = getMenuIds ps
# (prefs,ps) = getPrefs ps
# projIds = removeAt 9 projIds // disable module theorem proving...
/*
# projIds = case prefs.enable_prover of
True -> removeAt 9 projIds
False -> removeAt 8 (removeAt 9 projIds)
*/
// if projwin or editwin active disable moduleIds...
// not necessary here because only called from active dialog...
# ps = setModuleIds [] ps
......
......@@ -8,7 +8,7 @@ import PmProject, PmFiles, UtilStrictLists, PmPath
import edfiles, messwin, errwin
import PmDialogues, PmDriver
import PmCleanSystem
import ProverOptions
//import ProverOptions
import flextextcontrol
import ioutil, morecontrols, colorpickcontrol
import projmen, menubar, colourclip
......@@ -605,6 +605,7 @@ where
# (lo,ps) = accProject (\project->(PR_GetLinkOptions project,project)) ps
# (prj_path,ps) = getPath ps
# (app_path,ps) = getStup ps
/*
| lo.method == LM_Dynamic
# (dynlstr,ps) = getCurrentDynl ps
# dyn_start = (app_path +++ {dirseparator} +++dynlstr)
......@@ -612,6 +613,7 @@ where
| not ok
= okNotice ["Unable to start dynamic linker:",dyn_start] ps
= ps
*/
# prj_path` = RemoveFilename prj_path
# execpath = fulPath app_path prj_path` execpath
= RunProgram execpath ps
......@@ -624,6 +626,7 @@ pm_run ps
# prj_path` = RemoveFilename prj_path
# execpath = fulPath app_path prj_path` execpath
# (lo,ps) = accProject (\project->(PR_GetLinkOptions project,project)) ps
/*
| lo.method == LM_Dynamic
# (dynlstr,ps) = getCurrentDynl ps
# dyn_start = (app_path +++ {dirseparator} +++dynlstr)
......@@ -631,6 +634,7 @@ pm_run ps
| not ok
= okNotice ["Unable to start dynamic linker:",dyn_start] ps
= ps
*/
= RunProgram execpath ps
//--
......@@ -762,6 +766,7 @@ pm_save_common pathname project ps
] ps
= (project,ps)
# (prefs,ps) = getPrefs ps
/*
| not prefs.enable_prover
= (project,ps)
# (syspaths,ps) = getCurrentPaths ps
......@@ -787,6 +792,7 @@ pm_save_common pathname project ps
, "of a file I/O error."
] ps
= (project,ps)
*/
= (project,ps)
pm_maybe_save :: !Id !*(PSt *General) -> (Bool,*PSt *General)
......@@ -803,12 +809,13 @@ pm_set_window_title pathname ps
# name = RemovePath pathname
= appPIO (setWindowTitle wId (name+++" - "+++pathname)) ps
/*
make_prover_name name
# name = MakeProjectPathname name
# name = RemoveSuffix name
# name = name +++ ".pr_"
= name
*/
pm_get_projwin_possiz :: *(PSt *General) -> *(.(Vector2,Size),*PSt *General);
pm_get_projwin_possiz ps
......
......@@ -4,7 +4,6 @@ definition module targetui
import PmEnvironment
import IdeState
import StdSystem
setProjectTarget :: !String !(PSt *General) -> PSt *General
// sets the environment for the current project
......
......@@ -381,15 +381,6 @@ envDialog ap pp ts ct getTs setTs ps
lblibId
[ControlViewSize {h=siz.Size.h,w=300}]
# (lbpadId,ps) = openExtListBoxId ps
# (lbpad) = ExtListBoxControl
(zip3(StrictListToList(FullPaths inifull ap pp tg.target_path))(repeat id)(repeat id))
[] // initial selection
(\sel ps->case sel of
[] -> appPIO (disableControl r1id) ps
_ -> appPIO (enableControl r1id) ps
) // selection update function
lbpadId
[ControlViewSize {h=siz.Size.h,w=300}]
# (lbsllId,ps) = openExtListBoxId ps
# lbsll = ExtListBoxControl
(zip3(StrictListToList(FullPaths inifull ap pp tg.target_stat))(repeat id)(repeat id))
......@@ -425,7 +416,7 @@ envDialog ap pp ts ct getTs setTs ps
, lblibId = lblibId
}
# (_,ps) = openModalDialog iniLS
(ddef wid okId cancelId lbobj lbobjId lblib lblibId lbpad lbpadId lbsll
(ddef wid okId cancelId lbobj lbobjId lblib lblibId (siz.Size.h) lbpadId lbsll
lbsllId siz compId cgenId linkId dynlId versId methId c1id c2id c3id c4id
r1id r2id r3id r4id
) ps
......@@ -434,7 +425,7 @@ where
tg = ts!!ct
inifull = False
ddef wid okId cancelId lbobj lbobjId lblib lblibId lbpad lbpadId lbsll lbsllId siz compId cgenId linkId dynlId
ddef wid okId cancelId lbobj lbobjId lblib lblibId height lbpadId lbsll lbsllId siz compId cgenId linkId dynlId
versId methId c1id c2id c3id c4id r1id r2id r3id r4id
= Dialog ("Environment: "+++tg.target_name)
(title :+: panes :+: buttons`)
......@@ -443,7 +434,7 @@ where
buttons` = buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId methId
panes = TabControl
( Pane "Tools" (toolpane tg compId cgenId linkId dynlId versId methId)
:+: Pane "Paths" (pathpane inifull lbpad lbpadId c1id r1id)
:+: Pane "Paths" (pathpane ap pp tg.target_path inifull height lbpadId c1id r1id)
:+: Pane "Dynamic Libraries" (dlibpane inifull lblib c2id r2id)
:+: Pane "Static Libraries" (slibpane inifull lbsll c3id r3id)
:+: Pane "Object Modules" (objmpane inifull lbobj c4id r4id)
......@@ -469,14 +460,16 @@ buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId m
where
width = ContentWidth "Save As..."
savefun (ls=:{tg},ps)
savefun (ls,ps)
# (ls,ps) = commonsave (ls,ps)
# (tg,ls) = ls!tg
# ps = setTs (updateAt ct tg ts) ps
# ps = setProjectTarget tg.target_name ps
// possible since we know it's only possible to edit the active environment...
= (ls,ps)
saveasfun (ls=:{tg},ps)
saveasfun (ls,ps)
# (ls,ps) = commonsave (ls,ps)
# (tg,ls) = ls!tg
= newNameDialog tg.target_name contSaveAs (ls,ps)
contSaveAs target_name (ls,ps)
# ls = {ls & tg.target_name = target_name}
......@@ -585,7 +578,7 @@ where
# ls = {ls & tg.target_meth = CompilePers}
= (ls,ps)
pathpane inifull lbpad lbpadId c1id r1id
pathpane ap pp paths inifull height lbpadId c1id r1id
= TextControl "Paths" []
:+: LayoutControl
( ButtonControl "Append..."
......@@ -599,6 +592,8 @@ pathpane inifull lbpad lbpadId c1id r1id
, ControlId r1id
, ControlSelectState Unable
]
:+: ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
:+: ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
:+: lbpad
:+: CheckControl
......@@ -608,6 +603,45 @@ pathpane inifull lbpad lbpadId c1id r1id
[ ControlPos (Left,zero)
, ControlId c1id
]
where
lbpad = ExtListBoxControl
(zip3(StrictListToList(FullPaths inifull ap pp paths))(repeat id)(repeat id))
[] // initial selection
(\sel ps->case sel of
[] -> appPIO (disableControl r1id) ps
_ -> appPIO (enableControl r1id) ps
) // selection update function
lbpadId
[ControlViewSize {h=height,w=300}]
lbUp (ls,ps)
# lo = ls.tg.target_path
# (_,(lo,ps)) = upSelItem lbpadId (StrictListToList lo,ps)
# lo = ListToStrictList lo
# ls = {ls & tg.target_path = lo}
= (ls,ps)
lbDn (ls,ps)
# lo = ls.tg.target_path
# (_,(lo,ps)) = dnSelItem lbpadId (StrictListToList lo,ps)
# lo = ListToStrictList lo
# ls = {ls & tg.target_path = lo}
= (ls,ps)
addPath (ls=:{tg,full,ap,pp,lbpadId},ps)
# (fs,ps) = selectDirectory` ps
| isNothing fs = (ls,ps)
# pathname = fromJust fs
ls = {ls & tg.target_path = Append tg.target_path pathname}
ps = appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
= (ls,ps)
removePath (ls=:{tg,ap,pp,lbpadId},ps)
# ((ok,sel),ps) = getExtListBoxSelection lbpadId ps
| not ok || isEmpty sel = (ls,ps)
# (pathsel,indexsel) = unzip sel
ls = {ls & tg.target_path = RemoveMembers tg.target_path (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}
ps = closeExtListBoxItems lbpadId indexsel ps
ps = setExtListBoxSelection lbpadId [] ps
= (ls,ps)
dlibpane inifull lblib c2id r2id
= TextControl "Dynamic Libraries" []
......@@ -683,24 +717,6 @@ objmpane inifull lbobj c4id r4id
//--
addPath (ls=:{tg,full,ap,pp,lbpadId},ps)
# (fs,ps) = selectDirectory` ps
| isNothing fs = (ls,ps)
// # pathname = RemoveFilename (fromJust fs)
# pathname = fromJust fs
ls = {ls & tg.target_path = Append tg.target_path pathname}
ps = appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
= (ls,ps)
removePath (ls=:{tg,ap,pp,lbpadId},ps)
# ((ok,sel),ps) = getExtListBoxSelection lbpadId ps
| not ok || isEmpty sel = (ls,ps)
# (pathsel,indexsel) = unzip sel
ls = {ls & tg.target_path = RemoveMembers tg.target_path (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}
ps = closeExtListBoxItems lbpadId indexsel ps
ps = setExtListBoxSelection lbpadId [] ps
= (ls,ps)
showFullPaths (ls=:{ap,pp,tg,full,c1id,c2id,c3id,c4id,lbpadId,lbobjId,lblibId,lbsllId},ps)
# full= not full
ps = appPIO (setCheckControlMarks [c1id,c2id,c3id,c4id] full) ps
......
......@@ -4,11 +4,11 @@ definition module tools
import IdeState
shoprofun :: !*(PSt *General) -> *PSt *General
shoprofun :: !*(PSt General) -> *PSt General
// launch time profiler for active project
shoheapfun :: !*(PSt *General) -> *PSt *General
shoheapfun :: !*(PSt General) -> *PSt General
// launch heap profiler for active project
provefun :: !*(PSt *General) -> *PSt *General
provefun :: !*(PSt General) -> *PSt General
// launch theorem prover for active project
......@@ -9,60 +9,64 @@ import IdeState, UtilIO
//-- ahhh... problem is then how to inform the change_registry
//-- application of their new location...
shoprofun :: !*(PSt *General) -> *PSt *General
timepsuf =: " Time Profile.pcl"
timepdir =: applicationpath "Tools\\TimeProfiler"
timepapp =: quoted_string (MakeFullPathname timepdir "ShowTimeProfile.exe")
timeparg =: " -h 4M "
heappsuf =: " Heap Profile0.hcl"
heappdir =: applicationpath "Tools\\HeapProfiler"
heappapp =: quoted_string (MakeFullPathname heappdir "ShowHeapProfile.exe")
heapparg =: " -h 4M "
proofsuf =: ".prj"
proofdir =: applicationpath "Tools\\Sparkle"
proofapp =: quoted_string (MakeFullPathname proofdir "Sparkle.exe")
proofarg =: " "
shoprofun :: !*(PSt General) -> *PSt General
shoprofun ps
# (prj,ps) = getProject ps
# execpath = PR_GetExecPath prj
// approximate name mangling done by RTE
//--> expand pathname...
// should still take into account max filename length
# profpath = (RemoveSuffix` execpath)+++" Time Profile.pcl"
# applpath = applicationpath "ShowTimeProfile.exe"
# sp = quoted_string applpath +++ " -h 4M " +++ (quoted_string profpath)
# profpath = quoted_string (RemoveSuffix` execpath +++ timepsuf)
# sp = timepapp +++ timeparg +++ profpath
# stup = RemoveFilename execpath
# (ok,ps) = accFiles (FExists stup) ps
# stup = case ok of
True -> stup +++ "\\"
False -> applicationpath ""
// check if legal stup...
# stup = if ok (stup +++ "\\") (applicationpath "")
# (ok,ps) = accFiles (LaunchApplication sp stup False) ps
| not ok
# ps = openNotice (Notice ["Unable to launch " +++ sp +++ ".",stup] (NoticeButton "OK" id) []) ps
= ps
= openNotice (Notice ["Unable to launch " +++ sp +++ ".",stup] (NoticeButton "OK" id) []) ps
= ps
shoheapfun :: !*(PSt *General) -> *PSt *General
shoheapfun :: !*(PSt General) -> *PSt General
shoheapfun ps
# (prj,ps) = getProject ps
# execpath = PR_GetExecPath prj
// approximate name mangling done by RTE
// should still take into account max filename length
# profpath = (RemoveSuffix` execpath)+++" Heap Profile0.hcl"
# applpath = applicationpath "ShowHeapProfile.exe"
# sp = quoted_string applpath +++ " -h 4M " +++ (quoted_string profpath)
# profpath = quoted_string (RemoveSuffix` execpath +++ heappsuf)
# sp = heappapp +++ heapparg +++ profpath
# stup = RemoveFilename execpath
# (ok,ps) = accFiles (FExists stup) ps
# stup = case ok of
True -> stup +++ "\\"
False -> applicationpath ""
# stup = if ok (stup +++ "\\") (applicationpath "")
# (ok,ps) = accFiles (LaunchApplication sp stup False) ps
| not ok
# ps = openNotice (Notice ["Unable to launch " +++ sp +++ ".",stup] (NoticeButton "OK" id) []) ps
= ps
= openNotice (Notice ["Unable to launch " +++ sp +++ ".",stup] (NoticeButton "OK" id) []) ps
= ps
provefun :: !*(PSt *General) -> *PSt *General
provefun :: !*(PSt General) -> *PSt General
provefun ps
# (pathname,ps) = getPath ps
# cps = quoted_string (applicationpath "CleanProverSystem.exe")+++" "+++quoted_string (RemoveSuffix` pathname +++. ".pr_")
# pr_path = quoted_string (RemoveSuffix` pathname +++. proofsuf)
# cps = proofapp +++ proofarg +++ pr_path
# stup = RemoveFilename pathname
# (ok,ps) = accFiles (FExists stup) ps
# stup = case ok of
True -> stup +++ "\\"
False -> applicationpath ""
# stup = if ok (stup +++ "\\") (applicationpath "")
# (ok,ps) = accFiles (LaunchApplication cps stup False) ps
| not ok
# ps = openNotice (Notice ["Unable to launch " +++ cps +++ "."] (NoticeButton "OK" id) []) ps
= ps
= openNotice (Notice ["Unable to launch " +++ cps +++ "."] (NoticeButton "OK" id) []) ps
= ps
......@@ -272,7 +272,7 @@ typewinPane ps
# (twi,ps) = accPLoc getTypeWinInfo ps
# (fontNames, ps)
= accPIO (accScreenPicture getFontNames) ps
# fixed = map lisFixedWidth fontNames // allow all fonts for types window
# (fixed,ps) = seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames) ps
# fontNames = lfilter fixed fontNames
# fontSizes = [7, 8, 9, 10, 12, 14, 18, 24 ]
# {typewinfont={fName=inifn,fSize=inifs},typewinsync=sync}
......
......@@ -19,6 +19,7 @@ from UtilStrictLists import List
, stack_size :: !Int
, gen_dll :: !Bool
, dll_names :: !String
, dynamics_path :: !String
}
emptyLinkInfo` :: LinkInfo`
......
......@@ -21,6 +21,7 @@ import UtilOptions, UtilStrictLists
, stack_size :: !Int
, gen_dll :: !Bool
, dll_names :: !String
, dynamics_path :: !String
}
emptyLinkInfo` :: LinkInfo`
......@@ -38,6 +39,7 @@ emptyLinkInfo` =
, stack_size = 0x100000 // 1MB oude linker default
, gen_dll = False
, dll_names = ""
, dynamics_path = ""
}
......@@ -98,6 +100,7 @@ LinkOptionsTable =
, SimpleOption "StackSize" (\a->a.stack_size) (\v a->{a & stack_size=v})
, SimpleOption "GenDLL" (\a->if a.gen_dll "1" "0") (\v a->{a & gen_dll=(if (v=="1") True False)})
, SimpleOption "DLLSymbols" (\a->a.dll_names) (\v a->{a & dll_names=v})
, SimpleOption "DynamicLinker" (\a->a.dynamics_path) (\v a->{a & dynamics_path=v})
}
PathOption =SimpleOption "Path" id const
......
......@@ -260,6 +260,17 @@ step True (DComp force dircache compinfo rest ds) ps
# (paths,ds) = ds!modpaths
= step True (DGene paths SyncCodeGeneration ds) ps
step True (DComp force dircache (Pers inf) rest ds) ps
// compile phase interrupted: continue with generation phase? Can skip straight to cleanup...