Commit 71ca6921 authored by Diederik van Arkel's avatar Diederik van Arkel

More mods from uniqueness experiment

parent 2d67a49a
......@@ -831,23 +831,23 @@ recfun (MSet ss) (ls,ps) = (ss,(ss,ps))
editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, mn_cut, mn_cpy, mn_pst, mn_clr, mg_edt, searchIds} iniClip = Menu "&Edit"
( MenuItem "&Undo"
[ MenuShortKey 'Z'
, MenuFunction (\(ls,ps)->(ls,ls.zfun ps))
, MenuFunction (\(ls=:{zfun},ps)->(ls,zfun ps))
, MenuSelectState Unable
, MenuId mn_und
]
:+: MenuItem "Cu&t"
[ MenuShortKey 'X'
, MenuFunction (\(ls,ps)->(ls,ls.xfun ps))
, MenuFunction (\(ls=:{xfun},ps)->(ls,xfun ps))
, MenuId mn_cut
]
:+: MenuItem "&Copy"
[ MenuShortKey 'C'
, MenuFunction (\(ls,ps)->(ls,ls.cfun ps))
, MenuFunction (\(ls=:{cfun},ps)->(ls,cfun ps))
, MenuId mn_cpy
]
:+: MenuItem "&Paste"
[ MenuShortKey 'V'
, MenuFunction (\(ls,ps)->(ls,ls.vfun ps))
, MenuFunction (\(ls=:{vfun},ps)->(ls,vfun ps))
, MenuId mn_pst
]
:+: Receiver2 editRecId recfun []
......
......@@ -363,11 +363,11 @@ where
ps = closeExtListBoxItems lbobjId indexsel ps
ps = setExtListBoxSelection lbobjId [] ps
= ((full,tg),ps)
showFullPaths ((full,tg),ps)
showFullPaths ((full,tg=:{lo}),ps)
# full = not full
ps = appPIO (setCheckControlMark full c2id) ps
ps = closeAllExtListBoxItems lbobjId ps
ps = appendExtListBoxItems lbobjId (zip3 (FullPaths full ap pp (StrictListToList tg.lo.extraObjectModules))(repeat id)(repeat id)) ps
ps = appendExtListBoxItems lbobjId (zip3 (FullPaths full ap pp (StrictListToList lo.extraObjectModules))(repeat id)(repeat id)) ps
= ((full,tg),ps)
slibsPane = Pane "Static Libraries"
{addLS = inifull
......@@ -416,11 +416,11 @@ where
ps = closeExtListBoxItems lbslibId indexsel ps
ps = setExtListBoxSelection lbslibId [] ps
= ((full,tg),ps)
showFullPaths ((full,tg),ps)
showFullPaths ((full,tg=:{sl}),ps)
# full = not full
ps = appPIO (setCheckControlMark full c3id) ps
ps = closeAllExtListBoxItems lbslibId ps
ps = appendExtListBoxItems lbslibId (zip3 (FullPaths full ap pp (StrictListToList (SL_Libs tg.sl)))(repeat id)(repeat id)) ps
ps = appendExtListBoxItems lbslibId (zip3 (FullPaths full ap pp (StrictListToList (SL_Libs sl)))(repeat id)(repeat id)) ps
= ((full,tg),ps)
dlibsPane = Pane "Dynamic Libraries"
{addLS = inifull
......@@ -469,11 +469,11 @@ where
ps = closeExtListBoxItems lbdlibId indexsel ps
ps = setExtListBoxSelection lbdlibId [] ps
= ((full,tg),ps)
showFullPaths ((full,tg),ps)
showFullPaths ((full,tg=:{lo}),ps)
# full = not full
ps = appPIO (setCheckControlMark full c4id) ps
ps = closeAllExtListBoxItems lbdlibId ps
ps = appendExtListBoxItems lbdlibId (zip3 (FullPaths full ap pp (StrictListToList tg.lo.libraries))(repeat id)(repeat id)) ps
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
......@@ -530,11 +530,11 @@ where
ps = closeExtListBoxItems lbpadId indexsel ps
ps = setExtListBoxSelection lbpadId [] ps
= ((full,tg),ps)
showFullPaths ((full,tg),ps)
showFullPaths ((full,tg=:{paths}),ps)
# full = not full
ps = appPIO (setCheckControlMark full c1id) ps
ps = closeAllExtListBoxItems lbpadId ps
ps = appendExtListBoxItems lbpadId (zip3 (FullPaths full ap pp (StrictListToList tg.paths))(repeat id)(repeat id)) ps
ps = appendExtListBoxItems lbpadId (zip3 (FullPaths full ap pp (StrictListToList paths))(repeat id)(repeat id)) ps
= ((full,tg),ps)
setCheckControlMark full id io
......
......@@ -154,7 +154,7 @@ beforeParse level line bln bcn text
afterParse level line eln ecn text
*/
/*
sl_balance cl string sel_begin sel_end
= inComment
......@@ -215,3 +215,4 @@ where
| i >= m = i
| funnyChar s.[i] = scanFunny (inc i)
= i
*/
\ No newline at end of file
......@@ -473,33 +473,33 @@ where
= updateCW win (ls,closeWindow dialogId ps)
cancelFun win wini dialogId (ls,ps)
= updateCW win (wini,closeWindow dialogId ps)
setBoxCol cb1id cb2id cb3id cb4id (ls=:{cur},ps)
setBoxCol cb1id cb2id cb3id cb4id (ls=:{cur,txt,cmt,mod,bck},ps)
# (cId,col) = case cur of
TXT -> (cb1id,ls.CWC_LS.txt)
CMT -> (cb2id,ls.CWC_LS.cmt)
MOD -> (cb3id,ls.CWC_LS.mod)
BCK -> (cb4id,ls.CWC_LS.bck)
TXT -> (cb1id,txt)
CMT -> (cb2id,cmt)
MOD -> (cb3id,mod)
BCK -> (cb4id,bck)
# ps = appPIO (SetColourBox` cId (toRGBColour col)) ps
= (ls,ps)
updateCW win (ls,ps)
updateCW win (ls=:{txt,cmt,mod,bck,fn,fs},ps)
# (twi,ps) = accPLoc getConsWinInfo ps
# sync = getConSync twi
# sync = sc_update ls sync
# (font,ps) = safeOpen {fName = ls.CWC_LS.fn, fSize = ls.CWC_LS.fs, fStyles = []} ps
# sync = sc_update sync
# (font,ps) = safeOpen {fName = fn, fSize = fs, fStyles = []} ps
# twi = setConSync sync twi
# twi = setConFont font twi
# ps = appPLoc (setConsWinInfo twi) ps
# (_,ps) = maybe_cons_win_message2 (appFontInfo (fi_update ls)) ps
# (_,ps) = maybe_cons_win_message2 (appFontInfo fi_update) ps
# (_,ps) = maybe_cons_win_message2 (setFont font) ps
# ps = appPIO (updateWindow win Nothing) ps
= (ls,ps)
where
fi_update ls fi =
fi_update fi =
{ fi
& syntaxColours = sc_update ls fi.syntaxColours
& syntaxColours = sc_update fi.syntaxColours
}
sc_update {txt,cmt,mod,bck} sc =
sc_update sc =
{ sc
& textColour = txt
, commentColour = cmt
......
......@@ -98,9 +98,10 @@ editColours ps
(Just (0,0))
(Just (0,0))
(Just (0,0)) ps
# buttonWidth = ContentWidth "Cancel"
# buttonWidth = ContentWidth "Cancel"
# (ilook,wloc) = idslook wloc
# wdef = Dialog "Editor Colours"
( RGBColourPickControl` rgbid (prefs.syncols.textColour) (idslook wloc) Nothing
( RGBColourPickControl` rgbid (prefs.syncols.textColour) ilook Nothing
:+: ButtonControl "&Copy"
[ ControlFunction (copyFun wId)
, ControlWidth buttonWidth
......@@ -176,13 +177,13 @@ editColours ps
# (_,ps) = openModalDialog wloc wdef ps
= ps
where
copyFun wId (ls,ps)
copyFun wId (ls=:{cls,act},ps)
// get active colour control
// and put in clipboard
# cur = ls.cls!!ls.act
# cur = cls!!act
# ps = setClipboard [toClipboard (toString cur)] ps
= (ls,ps)
pasteFun wId rId (ls,ps)
pasteFun wId rId (ls=:{cls,act},ps)
// get clipboard
// and put in active colour control
# (its,ps) = getClipboard ps
......@@ -195,9 +196,10 @@ where
# it = fromJust (hd its)
| it <> toStringC (fromString it)
= (ls,ps)
# ls = {ls & cls = updateAt ls.act (fromString it) ls.cls}
# ls = {ls & cls = updateAt act (fromString it) cls}
# (ls,ps) = setBoxCol (ls,ps)
# ps = setColourBoxColour` rId (clslook ls) ps
# (clook,ls)= clslook ls
# ps = setColourBoxColour` rId clook ps
= (ls,ps)
ColourBoxControl`` rgbid lsid cls ids x p
= ColourBoxControl` (toRGBColour (cls!!x)) (ids!!x) (mstuff rgbid lsid x) p
......@@ -209,18 +211,24 @@ where
= updateActiveInLS rgbid lsid cont (ls,ps)
where
cont (ls,ps)
# ps = appPIO (SetColourBox (idslook ls) (toRGBColour(clslook ls))) ps
# (ilook,ls) = idslook ls
# (clook,ls) = clslook ls
# ps = appPIO (SetColourBox ilook (toRGBColour clook)) ps
# ls = {ls & act = x}
# ps = appPIO (SetColourBox` (idslook ls) (toRGBColour(clslook ls))) ps
# ps = setColourBoxId rgbid (idslook ls) ps
# ps = setColourBoxColour` rgbid (clslook ls) ps
# (ilook,ls) = idslook ls
# (clook,ls) = clslook ls
# ps = appPIO (SetColourBox` ilook (toRGBColour clook)) ps
# ps = setColourBoxId rgbid ilook ps
# ps = setColourBoxColour` rgbid clook ps
= (ls,ps)
setBoxCol (ls,ps)
# ps = appPIO (SetColourBox` (idslook ls) (toRGBColour(clslook ls))) ps
# (ilook,ls) = idslook ls
# (clook,ls) = clslook ls
# ps = appPIO (SetColourBox` ilook (toRGBColour clook)) ps
= (ls,ps)
idslook {ids,act} = ids!!act
clslook {cls,act} = cls!!act
idslook ls=:{ids,act} = (ids!!act, ls)
clslook ls=:{cls,act} = (cls!!act, ls)
toStringC :: !Colour -> String
toStringC c = toString c
lsfun f (ls,ps) = f (ls,ps)
......@@ -234,8 +242,8 @@ where
# col = fromJust col
# (_,ps) = asyncSend lsid (cont2 col) ps
= ps
cont2 col (ls,ps)
# ls = {ls & cls = updateAt ls.act col ls.cls}
cont2 col (ls=:{act,cls},ps)
# ls = {ls & cls = updateAt act col cls}
= cont3 (ls,ps)
okFun rgbid lsid wId (ls,ps)
......@@ -252,37 +260,37 @@ where
applyFun rgbid lsid (ls,ps)
= updateActiveInLS rgbid lsid apply (ls,ps)
apply (ls,ps)
apply (ls=:{cls},ps)
# (prefs,ps) = getPrefs ps
# syncols` =
{ prefs.syncols
& textColour = ls.cls!!0
, tabColour = ls.cls!!3
, commentColour = ls.cls!!6
, stringColour = ls.cls!!9
, charColour = ls.cls!!12
, backgroundColour = ls.cls!!15
, keywordColour = ls.cls!!18
& textColour = cls!!0
, tabColour = cls!!3
, commentColour = cls!!6
, stringColour = cls!!9
, charColour = cls!!12
, backgroundColour = cls!!15
, keywordColour = cls!!18
}
# defcols` =
{ prefs.defcols
& textColour = ls.cls!!1
, tabColour = ls.cls!!4
, commentColour = ls.cls!!7
, stringColour = ls.cls!!10
, charColour = ls.cls!!13
, backgroundColour = ls.cls!!16
, keywordColour = ls.cls!!19
& textColour = cls!!1
, tabColour = cls!!4
, commentColour = cls!!7
, stringColour = cls!!10
, charColour = cls!!13
, backgroundColour = cls!!16
, keywordColour = cls!!19
}
# impcols` =
{ prefs.impcols
& textColour = ls.cls!!2
, tabColour = ls.cls!!5
, commentColour = ls.cls!!8
, stringColour = ls.cls!!11
, charColour = ls.cls!!14
, backgroundColour = ls.cls!!17
, keywordColour = ls.cls!!20
& textColour = cls!!2
, tabColour = cls!!5
, commentColour = cls!!8
, stringColour = cls!!11
, charColour = cls!!14
, backgroundColour = cls!!17
, keywordColour = cls!!20
}
# prefs = {prefs & syncols = syncols`, defcols = defcols`, impcols = impcols`}
# ps = setPrefs prefs ps
......
......@@ -439,10 +439,10 @@ where
# (ls,ps) = setBoxCol fcid bcid (ls,ps)
# ps = setColourBoxColour` rgbId col ps
= (ls,ps)
setBoxCol fcid bcid (ls=:{cur},ps)
setBoxCol fcid bcid (ls=:{cur,fc,bc},ps)
# (cId,col) = case cur of
TXT -> (fcid,ls.fc)
BCK -> (bcid,ls.bc)
TXT -> (fcid,fc)
BCK -> (bcid,bc)
# ps = appPIO (SetColourBox` cId (toRGBColour col)) ps
= (ls,ps)
mfilter (MouseDown _ _ _) = True
......@@ -490,10 +490,10 @@ where
TXT -> {ls & fc = col, cur = act}
BCK -> {ls & bc = col, cur = act}
= (ls,ps)
apply (ls=:{fc,bc},ps)
apply (ls=:{fc,bc,fn,fs},ps)
# (errinf,ps) = getErrInfo ps
# lbId = errinf.infoId
# (fnt,ps) = accScreenPicture (safeOpenFixedFont {fName = ls.EWO.fn, fSize = ls.EWO.fs, fStyles = []}) ps
# (fnt,ps) = accScreenPicture (safeOpenFixedFont {fName = fn, fSize = fs, fStyles = []}) ps
# pen = [PenFont fnt, PenColour fc, PenBack bc]
# ps = setFilteredListBoxPen lbId pen ps
# errinf = {errinf & err_font = fnt, err_forg = fc, err_back = bc}
......
......@@ -211,11 +211,11 @@ where
FC -> {ls & fc = col, cr = ac}
BC -> {ls & bc = col, cr = ac}
= (ls,ps)
setBoxCol hcId fcId bcId (ls=:{cr},ps)
setBoxCol hcId fcId bcId (ls=:{cr,hc,fc,bc},ps)
# (cId,col) = case cr of
HC -> (hcId,ls.hc)
FC -> (fcId,ls.fc)
BC -> (bcId,ls.bc)
HC -> (hcId,hc)
FC -> (fcId,fc)
BC -> (bcId,bc)
# ps = appPIO (SetColourBox` cId (toRGBColour col)) ps
= (ls,ps)
applyFun rgbid lsid (ls,ps)
......@@ -244,24 +244,24 @@ where
BC -> {ls & bc = col}
# (ls,ps) = apply (ls,ps)
= finish (ls,ps)
apply (ls,ps)
apply (ls=:{fn,fs,fc,bc,hc,shift},ps)
# (lbId,ps) = getPWI ps
# ((fnt_ok,fnt),ps) = accScreenPicture (openFont {fName = ls.PWO.fn, fSize = ls.PWO.fs, fStyles = []}) ps
# ((fnt_ok,fnt),ps) = accScreenPicture (openFont {fName = fn, fSize = fs, fStyles = []}) ps
# pen2 = if fnt_ok [PenFont fnt] []
# pen = [PenColour (ls.fc), PenBack (ls.bc):pen2]
# pen = [PenColour fc, PenBack bc:pen2]
# ps = closeAllExtListBoxItems lbId ps
# ps = setExtListBoxPen lbId pen ps
# (wId,ps) = getPWW ps
# ps = appPIO (setWindowLook wId True (True,(\_ {newFrame} -> fill newFrame o setPenColour (ls.hc)))) ps
# ps = appPIO (setWindowLook wId True (True,(\_ {newFrame} -> fill newFrame o setPenColour hc))) ps
# (prefs,ps) = getPrefs ps
# prefs = { prefs
& prj_prefs.proj_forc = ls.fc
, prj_prefs.proj_bacc = ls.bc
, prj_prefs.proj_topc = ls.hc
, prj_prefs.proj_font = {prefs.prj_prefs.proj_font & fName = ls.PWO.fn, fSize = ls.PWO.fs}
, prj_prefs.proj_shft = ls.shift
& prj_prefs.proj_forc = fc
, prj_prefs.proj_bacc = bc
, prj_prefs.proj_topc = hc
, prj_prefs.proj_font = {prefs.prj_prefs.proj_font & fName = fn, fSize = fs}
, prj_prefs.proj_shft = shift
}
# ps = setPrefs prefs ps
| not fnt_ok
......@@ -392,7 +392,7 @@ where
, ControlPen pen
, ControlHMargin 10 10
, ControlVMargin 3 3
, ControlMouse mouseFilter Able mouseFunction
// , ControlMouse mouseFilter Able mouseFunction
]
top_controls lbId localId local2Id local3Id xxId mmId pw_main pw_exec butw fnt =
......@@ -653,7 +653,7 @@ pm_copt ps
= okNotice ["This module is not part of the current project."] ps
# minf = fromJust minf
# projco = minf.compilerOptions
# setco = \ao -> appProject (\l->PR_UpdateModule mod (\mi->{mi & compilerOptions = ao}) l)
# setco = \co -> appProject (\l->PR_UpdateModule mod (\mi->{mi & compilerOptions = co}) l)
= doCompilerOptionsDialog "Module Options" projco setco ps
// should check if project window is active...
// otherwise this behaviour is unintuitive
......@@ -671,7 +671,7 @@ pm_copt ps
= ps
# minf = fromJust minf
# projco = minf.compilerOptions
# setco = \ao -> appProject (\l->PR_UpdateModules sel (\mi->{mi & compilerOptions = ao}) l)
# setco = \co -> appProject (\l->PR_UpdateModules sel (\mi->{mi & compilerOptions = co}) l)
= doCompilerOptionsDialog "Module Options" projco setco ps
// work op nothing... ?!
= ps
......
......@@ -75,7 +75,7 @@ sr_find_idi always_dialog pstate // Find Definition & Implementation & Identifi
# (selection,_) = fromJust maybesel
# fbi = {fbi & cleanid = removeDup [selection:fbi.cleanid], pathname = pathname}
# pstate = setFBI fbi pstate
= fi_messagebox fbi (sr_find_worker fbi) pstate
= fi_messagebox fbi pstate
sr_find_def :: !Bool !*(PSt General) -> *PSt General
sr_find_def always_dialog pstate
......@@ -112,11 +112,11 @@ sr_find_def_imp_sel always_dialog selection pathname info=:{cleanid} pstate
# pstate = setFBI info pstate
| size selection == 0 || not (CleanModId selection) || always_dialog
= fi_dialog info pstate
= fi_messagebox info (sr_find_worker info) pstate
= fi_messagebox info pstate
//--
fi_messagebox info=:{cleanid,dlogId} work pstate
fi_messagebox info=:{cleanid,dlogId,stringId,msgId,kind,closeId} pstate
| isEmpty cleanid
= pstate
# pstate = closeWindow dlogId pstate
......@@ -125,41 +125,41 @@ fi_messagebox info=:{cleanid,dlogId} work pstate
= pstate
where
dialog = Dialog
( case info.kind of
( case kind of
Definition -> "Find Definition"
Implementation -> "Find Implementation"
Identifier -> "Find Identifier"
)
( TextControl ""
[ ControlId info.msgId
[ ControlId msgId
, ControlWidth (PixelWidth 300)
] // area to show messages
:+: TextControl "Find:"
[ ControlPos (Left,zero)
]
:+: EditControl (hd info.cleanid) (PixelWidth 300) 1
:+: EditControl (hd cleanid) (PixelWidth 300) 1
[ ControlPos (Left,zero)
, ControlId info.stringId
, ControlId stringId
]
:+: ButtonControl "Close"
[ ControlFunction closefun
, ControlPos (Left,zero)
, ControlId info.closeId
, ControlId closeId
]
)
[ WindowId info.dlogId
, WindowCancel info.closeId
, WindowOk info.closeId
[ WindowId dlogId
, WindowCancel closeId
, WindowOk closeId
, WindowClose closefun
, WindowInit (noLS work)
, WindowInit sr_find_worker
]
closefun (ls,ps)
# ps = closeWindow info.dlogId ps
# ps = closeWindow dlogId ps
= (ls, ps)
//--
fi_dialog info=:{dlogId} pstate
fi_dialog info=:{dlogId,msgId,stringId,cleanid,kind,type,verb,export_,closeId,findId,recvId} pstate
# pstate = closeWindow dlogId pstate
(_,pstate) = openModalDialog info dialog pstate
= pstate
......@@ -167,15 +167,15 @@ where
dialog =
Dialog "Find..."
( TextControl ""
[ ControlId info.msgId
[ ControlId msgId
, ControlWidth (PixelWidth 300)
] // area to show messages
:+: TextControl "Find:"
[ ControlPos (Left,zero)
]
:+: PopUpControl [(ci,id) \\ ci <- info.cleanid] 0
:+: PopUpControl [(ci,id) \\ ci <- cleanid] 0
[ ControlPos (Left,zero)
, ControlId info.stringId
, ControlId stringId
, ControlKeyboard filterReturnKeys Able (noLS1 (\_->stringKey))
, ControlDeactivate (noLS stringKey)
, ControlWidth (PixelWidth 300)
......@@ -185,7 +185,7 @@ where
,("Find Implementation" ,Nothing,noPS (\l->{l & kind = Implementation}))
,("Find Identifiers" ,Nothing,noPS (\l->{l & kind = Identifier}))
] (Columns 1)
( case info.kind of
( case kind of
Definition -> 1
Implementation -> 2
Identifier -> 3
......@@ -197,7 +197,7 @@ where
,("Search in Paths" ,Nothing,noPS (\l->{l & type = SearchPaths}))
,("Search in Project" ,Nothing,noPS (\l->{l & type = SearchProject}))
] (Columns 1)
( case info.type of
( case type of
SearchImports -> 1
SearchPaths -> 2
SearchProject -> 3
......@@ -205,37 +205,37 @@ where
[
]
:+: CheckControl
[("Be Verbose" ,Nothing,toMark info.verb ,noPS (\l->{l & verb = not l.verb}))
,("Exported Identifiers Only" ,Nothing,toMark info.export_ ,noPS (\l->{l & export_ = not l.export_}))
[("Be Verbose" ,Nothing,toMark verb ,noPS (\l->{l & verb = not l.verb}))
,("Exported Identifiers Only" ,Nothing,toMark export_ ,noPS (\l->{l & export_ = not l.export_}))
] (Columns 1)
[ ControlPos (Left,zero)
]
:+: ButtonControl "Close"
[ ControlFunction closefun
, ControlPos (Left,zero)
, ControlId info.closeId
, ControlId closeId
]
:+: ButtonControl "Find"
[ ControlId info.findId
[ ControlId findId
, ControlFunction findfun
]
:+: Receiver info.recvId recvfun
:+: Receiver recvId recvfun
[ ]
)
[ WindowId info.dlogId
, WindowOk info.findId
, WindowCancel info.closeId
[ WindowId dlogId
, WindowOk findId
, WindowCancel closeId
, WindowClose closefun
]
stringKey ps=:{io}
# (wst,io) = getWindow info.dlogId io
title = fromJust (snd (hd (getControlTexts [info.stringId] (fromJust wst))))
# io = openPopUpControlItems info.stringId 0 [(title,id)] io
# io = selectPopUpControlItem info.stringId 0 io
# (wst,io) = getWindow dlogId io
title = fromJust (snd (hd (getControlTexts [stringId] (fromJust wst))))
# io = openPopUpControlItems stringId 0 [(title,id)] io
# io = selectPopUpControlItem stringId 0 io
= {ps & io=io}
savefun (ls=:{dlogId,stringId},ps)
savefun (ls=:{dlogId,stringId,cleanid},ps)
# (wdef,ps) = accPIO (getWindow dlogId) ps
| isNothing wdef
// = trace_n "Fatal error in Find Identifier Dialog: 1" (ls,ps)
......@@ -249,7 +249,7 @@ savefun (ls=:{dlogId,stringId},ps)
// = trace_n "Fatal error in Find Identifier Dialog: 3" (ls,ps)
= (ls,ps)
# ss = fromJust ss
# ls = {ls & cleanid = removeDup [ss:ls.cleanid]}
# ls = {ls & cleanid = removeDup [ss:cleanid]}
# ps = setFBI ls ps
= (ls,ps)
closefun (ls=:{dlogId},ps)
......@@ -265,7 +265,7 @@ findfun (ls=:{is_searching,dlogId,intrId,findId},ps)
= (ls,ps)
# ls = {ls & is_searching = True}
# ps = appPIO (setControlText findId "Stop") ps
# ps = sr_find_worker ls ps
# (ls, ps) = sr_find_worker (ls, ps)
= (ls, ps)
recvfun _ (ls=:{is_searching,findId},ps)
| is_searching
......@@ -316,19 +316,22 @@ where
suffix2 = ".dcl"
//sr_find_worker :: .FindBoxInfo .Pathname *(PSt .Project General) -> *PSt General
sr_find_worker info=:{kind,type,dlogId=fId,intrId=tId, pathname} pstate
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
# (modpaths, pstate) = getModulesInPaths pstate
= StartIntr (fId,tId) (search fId tId pathname (pathname :! (ListToStrictList modpaths)) kind) 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 :-(
# (prj,pstate) = getProject pstate
# (rootpath,prj) = PR_GetRootPathName prj
# rootmodn = PR_GetRootModuleName prj
= StartIntr (fId,tId) (search fId tId rootpath (rootmodn :! Nil) kind) pstate
# pstate = StartIntr (fId,tId) (search fId tId rootpath (rootmodn :! Nil) kind) pstate
= (info,pstate)
// type == SearchImports
= StartIntr (fId,tId) (search fId tId pathname (GetModuleName pathname :! Nil) kind) pstate
# pstate = StartIntr (fId,tId) (search fId tId pathname (GetModuleName pathname :! Nil) kind) pstate
= (info,pstate)
where
search dId iId pathname modpaths Identifier intr pstate
= SearchIdentifiersInFiles dId iId (IsDefPathname pathname) info Nil modpaths intr pstate
......@@ -619,7 +622,7 @@ where
( elb
)
[ WindowId windId
, WindowClose (noLS (sw_close info o wind_deac))
, WindowClose (noLS (sw_close windId o wind_deac))
, WindowInit (noLS (appPIO (enableMenuElements [menu_elem_id])))
, WindowDeactivate (noLS wind_deac)
, WindowActivate (noLS wind_act)
......@@ -655,29 +658,29 @@ wind_act ps
# io = disableMenuElements searchIds.gotoIds io
= {ps & io = io}
sw_close {windId} ps
sw_close windId ps
# ({searchIds},ps) = getMenuIds ps
# ps = appPIO (disableMenuElements [searchIds.nextIds!!0]) ps
= closeWindow windId ps
sw_safe_close :: !*(PSt *General) -> *PSt *General
sw_safe_close ps
# (fbi,ps) = getFBI ps
# ({windId},ps) = getFBI ps
# (win,ps) = accPIO getActiveWindow ps
| isNothing win
= sw_close fbi ps
= sw_close windId ps
# win = fromJust win
| win == fbi.windId
| win == windId
# ps = wind_deac ps
= sw_close fbi ps
= sw_close fbi ps
= sw_close windId ps
= sw_close windId ps
sw_maybe_close :: !Id !*(PSt *General) -> (Bool,*(PSt *General))
sw_maybe_close win ps
# (fbi,ps) = getFBI ps
| win == fbi.windId
# ({windId},ps) = getFBI ps
| win == windId
# ps = wind_deac ps
= (True,sw_close fbi ps)
= (True,sw_close windId ps)
= (False,ps)
......@@ -832,10 +835,10 @@ where
# (ls,ps) = setBoxCol fcid bcid (ls,ps)
# ps = setColourBoxColour` rgbId col ps
= (ls,ps)
setBoxCol fcid bcid (ls=:{cur},ps)
setBoxCol fcid bcid (ls=:{cur,fc,bc},ps)
# (cId,col) = case cur of
TXT -> (fcid,ls.fc)
BCK -> (bcid,ls.bc)
TXT -> (fcid,fc)
BCK -> (bcid,bc)
# ps = appPIO (SetColourBox` cId (toRGBColour col)) ps
= (ls,ps)
mfilter (MouseDown _ _ _) = True
......
......@@ -469,20 +469,21 @@ buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId m
where
width = ContentWidth "Save As..."
savefun (ls,ps)
savefun (ls=:{tg},ps)
# (ls,ps) = commonsave (ls,ps)
# ps = setTs (updateAt ct ls.tg ts) ps
# ps = setProjectTarget ls.tg.target_name ps
# 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,ps)
saveasfun (ls=:{tg},ps)
# (ls,ps) = commonsave (ls,ps)
= newNameDialog ls.tg.target_name contSaveAs (ls,ps)
= newNameDialog tg.target_name contSaveAs (ls,ps)
contSaveAs target_name (ls,ps)
# ls = {ls & tg.target_name = target_name}
# ps = setTs (ts++[ls.tg]) ps
# (tg,ls) = ls!tg
# ps = setTs (ts++[tg]) ps
# ((_,eTargetId),ps) = getTargetIds ps
# (err,ps) = accPIO (openRadioMenuItems eTargetId (1 + length ts) [targetToMenuEntry` ls.tg]) ps
# (err,ps) = accPIO (openRadioMenuItems eTargetId (1 + length ts) [targetToMenuEntry` tg]) ps
| err <> NoError
= abort "targetui.icl: strange error adding target in saveas"
# ps = setProjectTarget target_name ps
......@@ -682,89 +683,89 @@ objmpane inifull lbobj c4id r4id
//--
addPath (ls,ps)
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 ls.tg.target_path pathname}
ps = appendExtListBoxItems ls.lbpadId (zip3 [FullPath ls.full ls.ap ls.pp pathname](repeat id)(repeat id)) ps
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,ps)
# ((ok,sel),ps) = getExtListBoxSelection ls.lbpadId 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 ls.tg.target_path (ListToStrictList [fulPath ls.ap ls.pp s \\ s <- pathsel])}
ps = closeExtListBoxItems ls.lbpadId indexsel ps
ps = setExtListBoxSelection ls.lbpadId [] ps
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},ps)
# full= not ls.full
ps = appPIO (setCheckControlMarks [ls.c1id,ls.c2id,ls.c3id,ls.c4id] full) ps
ps = closeAllExtListBoxItems ls.lbpadId ps
ps = appendExtListBoxItems ls.lbpadId (zip3 (StrictListToList(FullPaths full ap pp tg.target_path))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems ls.lbobjId ps
ps = appendExtListBoxItems ls.lbobjId (zip3 (StrictListToList(FullPaths full ap pp tg.target_objs))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems ls.lblibId ps
ps = appendExtListBoxItems ls.lblibId (zip3 (StrictListToList(FullPaths full ap pp tg.target_libs))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems ls.lbsllId ps
ps = appendExtListBoxItems ls.lbsllId (zip3 (StrictListToList(FullPaths full ap pp tg.target_stat))(repeat id)(repeat id)) 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
ps = closeAllExtListBoxItems lbpadId ps
ps = appendExtListBoxItems lbpadId (zip3 (StrictListToList(FullPaths full ap pp tg.target_path))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems lbobjId ps
ps = appendExtListBoxItems lbobjId (zip3 (StrictListToList(FullPaths full ap pp tg.target_objs))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems lblibId ps
ps = appendExtListBoxItems lblibId (zip3 (StrictListToList(FullPaths full ap pp tg.target_libs))(repeat id)(repeat id)) ps
ps = closeAllExtListBoxItems lbsllId ps
ps = appendExtListBoxItems lbsllId (zip3 (StrictListToList(FullPaths full ap pp tg.target_stat))(repeat id)(repeat id)) ps
= ({ls & full = full},ps)
addLibrary (ls,ps)
addLibrary (ls=:{tg,full,ap,pp,lblibId},ps)
# (fs,ps) = selectInputFile ps
| isNothing fs = (ls,ps)
# pathname = (fromJust fs)
ls = {ls & tg.target_libs = Append ls.tg.target_libs pathname}
ps = appendExtListBoxItems ls.lblibId (zip3[FullPath ls.full ls.ap ls.pp pathname](repeat id)(repeat id)) ps
ls = {ls & tg.target_libs = Append tg.target_libs pathname}
ps = appendExtListBoxItems lblibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
= (ls,ps)
remLibrary (ls,ps)
# ((ok,sel),ps) = getExtListBoxSelection ls.lblibId ps
remLibrary (ls=:{tg,ap,pp,lblibId},ps)
# ((ok,sel),ps) = getExtListBoxSelection lblibId ps
| not ok || isEmpty sel = (ls,ps)
# (pathsel,indexsel) = unzip sel
ls = {ls & tg.target_libs = RemoveMembers ls.tg.target_libs
(fulPaths ls.ap ls.pp (ListToStrictList pathsel))}
ps = closeExtListBoxItems ls.lblibId indexsel ps
ps = setExtListBoxSelection ls.lblibId [] ps
ls = {ls & tg.target_libs = RemoveMembers tg.target_libs
(fulPaths ap pp (ListToStrictList pathsel))}
ps = closeExtListBoxItems lblibId indexsel ps
ps = setExtListBoxSelection lblibId [] ps
= (ls,ps)
addStatic (ls,ps)
addStatic (ls=:{tg,full,ap,pp,lbsllId},ps)
# (fs,ps) = selectInputFile ps
| isNothing fs = (ls,ps)
# pathname = (fromJust fs)
ls = {ls & tg.target_stat = Append ls.tg.target_stat pathname}
ps = appendExtListBoxItems ls.lbsllId (zip3[FullPath ls.full ls.ap ls.pp pathname](repeat id)(repeat id)) ps
ls = {ls & tg.target_stat = Append tg.target_stat pathname}
ps = appendExtListBoxItems lbsllId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
= (ls,ps)
remStatic (ls,ps)
# ((ok,sel),ps) = getExtListBoxSelection ls.lbsllId ps
remStatic (ls=:{tg,ap,pp,lbsllId},ps)
# ((ok,sel),ps) = getExtListBoxSelection lbsllId ps
| not ok || isEmpty sel = (ls,ps)
# (pathsel,indexsel) = unzip sel
ls = {ls & tg.target_stat = RemoveMembers ls.tg.target_stat
(fulPaths ls.ap ls.pp (ListToStrictList pathsel))}
ps = closeExtListBoxItems ls.lbsllId indexsel ps
ps = setExtListBoxSelection ls.lbsllId [] ps
ls = {ls & tg.target_stat = RemoveMembers tg.target_stat