Commit e5008729 authored by John van Groningen's avatar John van Groningen

support error messages of more than one line

parent f5dd40b7
......@@ -38,17 +38,14 @@ where
//--- Error window handling
isErr Error = True
isErr _ = False
isWrn Warning = True
isWrn _ = False
isInf Info = True
isInf _ = False
countnums [] nums = nums
countnums [Error:ts] (e,w,i) = countnums ts (inc e,w,i)
countnums [Warning:ts] (e,w,i) = countnums ts (e,inc w,i)
countnums [Info:ts] (e,w,i) = countnums ts (e,w,inc i)
countnums [message:messages] (e,w,i)
| IsErrorMsg message
= countnums (dropWhile first_char_is_space messages) (inc e,w,i)
| IsWarningMsg message
= countnums messages (e,inc w,i)
= countnums messages (e,w,inc i)
countnums [] nums
= nums
checkWindowExistence id io
# (st,io) = getWindowsStack io
......@@ -71,9 +68,8 @@ updateErrorWindowInteractive messages ps
True -> ps
_ -> err_open errinfo ps
#! ps = appendFilteredListBoxItems errinfo.infoId messages ps
#! types = map TypeErrorMsg messages
#! (numerr,numwrn,numinf)
= countnums types (errinfo.err_count,errinfo.wrn_count,errinfo.inf_count)
= countnums messages (errinfo.err_count,errinfo.wrn_count,errinfo.inf_count)
# err = (errinfo.err_countId,toString numerr)
# wrn = (errinfo.wrn_countId,toString numwrn)
# inf = (errinfo.inf_countId,toString numinf)
......@@ -198,17 +194,30 @@ where
# ps = setErrInfo {ei & inf = inf} ps
# ps = setFilter ei.infoId (makeFilter err wrn inf) ps
= ((err,wrn,inf),ps)
makeFilter err wrn inf str
# msg = TypeErrorMsg str
| isErr msg && not err = False
| isWrn msg && not wrn = False
| isInf msg && not inf = False
= True
makeFilter err wrn inf [str:strings]
| IsErrorMsg str
| err
# (error_strings,strings) = span first_char_is_space strings
= [str:error_strings++makeFilter err wrn inf strings]
= makeFilter err wrn inf (dropWhile first_char_is_space strings)
| IsWarningMsg str
| wrn
= [str:makeFilter err wrn inf strings]
= makeFilter err wrn inf strings
| inf
= [str:makeFilter err wrn inf strings]
= makeFilter err wrn inf strings
makeFilter err wrn inf []
= []
err_resize ih oc ow nw
= {w = nw.w, h = nw.Size.h - ih}
inf_resize oc ow nw
= {oc & w = nw.w}
first_char_is_space s = size s>0 && s.[0]==' '
ew_activate cId ps
# ({mn_cut,mn_cpy,mn_pst,mn_clr,mg_edt,searchIds},ps=:{io})
= getMenuIds ps
......@@ -563,34 +572,37 @@ err_shut info
}
= prefs
//
// Extract module name and line number from error message.
//
:: MessageType = Error | Warning | Info
TypeErrorMsg :: !String -> MessageType
TypeErrorMsg msg = type
IsErrorMsg :: !String -> Bool
IsErrorMsg msg = type
where
msglen = size msg
type
| msglen > 5 && msg%(0,4) == "Error" = True
| msglen > 12 && msg%(0,11) == "Syntax error" = True
| msglen > 11 && msg%(0,10) == "Parse error" = True
| msglen > 11 && msg%(0,10) == "Check error" = True
| msglen > 11 && msg%(0,10) == "Check Error" = True
| msglen > 10 && msg%(0,9) == "Type error" = True
| msglen > 10 && msg%(0,9) == "Link error" = True
| msglen > 12 && msg%(0,11) == "Linker error" = True
| msglen > 16 && msg%(0,15) == "Uniqueness error" = True
| msglen > 16 && msg%(0,15) == "Undefined symbol" = True
| msglen > 17 && msg%(0,16) == "Overloading error" = True
= False
IsWarningMsg :: !String -> Bool
IsWarningMsg msg = type
where
msglen = size msg
type
| msglen > 5 && msg%(0,4) == "Error" = Error
| msglen > 12 && msg%(0,11) == "Syntax error" = Error
| msglen > 11 && msg%(0,10) == "Parse error" = Error
| msglen > 11 && msg%(0,10) == "Check error" = Error
| msglen > 11 && msg%(0,10) == "Check Error" = Error
| msglen > 10 && msg%(0,9) == "Type error" = Error
| msglen > 10 && msg%(0,9) == "Link error" = Error
| msglen > 12 && msg%(0,11) == "Linker error" = Error
| msglen > 16 && msg%(0,15) == "Uniqueness error" = Error
| msglen > 16 && msg%(0,15) == "Undefined symbol" = Error
| msglen > 17 && msg%(0,16) == "Overloading error" = Error
| msglen > 7 && msg%(0,6) == "Warning" = Warning
| msglen > 12 && msg%(0,11) == "Type warning" = Warning
| msglen > 13 && msg%(0,12) == "Parse warning" = Warning
| msglen > 12 && msg%(0,11) == "Link warning" = Warning
| msglen > 14 && msg%(0,13) == "Linker warning" = Warning
= Info
| msglen > 7 && msg%(0,6) == "Warning" = True
| msglen > 12 && msg%(0,11) == "Type warning" = True
| msglen > 13 && msg%(0,12) == "Parse warning" = True
| msglen > 12 && msg%(0,11) == "Link warning" = True
| msglen > 14 && msg%(0,13) == "Linker warning" = True
= False
//
// Extract module name and line number from error message.
//
ParseErrorMsg :: !String -> (!Modulename, !Int);
ParseErrorMsg msg
......
......@@ -26,7 +26,7 @@ flbKeyboard :: ({#Char} -> .(*(PSt .a) -> *PSt .a)) -> .ControlAttribute *((Filt
:: FilteredListBoxState
setFilter :: !FilteredListBoxId (String->Bool) !(PSt .l) -> PSt .l
getFilter :: !FilteredListBoxId !(PSt .l) -> (!String->Bool,PSt .l)
setFilter :: !FilteredListBoxId ([String]->[String]) !(PSt .l) -> PSt .l
getFilter :: !FilteredListBoxId !(PSt .l) -> (![String]->[String],PSt .l)
getFilteredListBoxSelection :: !FilteredListBoxId !(PSt .l) -> (!(!Bool,![(String,!Index)]),!PSt .l)
implementation module FilteredListBox
import StdBool, StdEnum, StdList, StdMisc, StdOrdList, StdTuple, StdFunc
import StdBool, StdEnum, StdList, StdMisc, StdOrdList, StdTuple, StdFunc, StdArray
import StdControl, StdControlReceiver, StdId, StdPicture, StdPSt, StdReceiver, StdWindow
import StdControlAttribute
import ioutil
......@@ -14,7 +14,7 @@ from commondef import strictSeq
, lineHeight :: !Int
, initHeight :: !Int
, pen :: ![PenAttribute]
, ifilter :: !{#Char} -> Bool // the item filter
, ifilter :: ![String] -> [String] // the item filter
, aitems :: ![String] // all items (unfiltered)
, domain :: !Rectangle
}
......@@ -38,7 +38,7 @@ openFilteredListBoxId env
| FInCloseAllItems // Request to remove all current items
| FInSetPen [PenAttribute] // Request to set control pen
| FInGetPen // Request to get control pen
| FInSetFilter (String->Bool)
| FInSetFilter ([String]->[String])
| FInGetFilter
:: FilteredMessageOut
......@@ -50,7 +50,7 @@ openFilteredListBoxId env
| FOutSetPen // Reply to set the control pen
| FOutGetPen [PenAttribute] // Reply to get the control pen
| FOutSetFilter
| FOutGetFilter (String->Bool)
| FOutGetFilter ([String] -> [String])
:: FilteredListBoxItem :== String
......@@ -97,7 +97,7 @@ where
, lineHeight = lineHeight
, initHeight = initHeight
, pen = penAtts
, ifilter = const True
, ifilter = id
, aitems = items
, domain = domain
}
......@@ -132,7 +132,7 @@ where
receiver (FInSetFilter filt) ((listboxState=:{pen,aitems},ls),ps)
# items = filter filt aitems
# items = filt aitems
# listboxState = {listboxState & ifilter = filt, items = items}
// refresh...
# (newDomain,ps) = calcControlDomain pen items ps
......@@ -154,31 +154,11 @@ where
receiver (FInSetSelection newSelection) ((listboxState=:{lineHeight,initHeight},ls),ps)
# listboxState = {FilteredListBoxState | listboxState & selection=newSelection}
# (newLook,listboxState)= customlook listboxState
#! ps = scrolltosel ps
#! ps = scroll_to_selection newSelection lineHeight customId ps
#! ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= (FOutSetSelection,((listboxState,ls),ps))
where
customId = listboxState.listboxId.fcontrolId
singlesel = length newSelection == 1
selitem = hd newSelection
scrolltosel ps
| not singlesel = ps
# top = (selitem-1) * lineHeight
# bot = selitem * lineHeight
# (wdef,ps) = accPIO (getParentWindow customId) ps
| isNothing wdef = ps
# wdef = fromJust wdef
# (exists,frame) = getControlViewFrame customId wdef
| not exists = ps
| isNothing frame = ps
# frame = fromJust frame
# delta = top - frame.corner1.y
| delta < 0
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
# delta = bot - frame.corner2.y
| delta > 0
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
= ps
// Return the current elements:
......@@ -202,7 +182,7 @@ where
= (FOutAppendItems,((listboxState,ls),ps))
where
customId = listboxState.listboxId.fcontrolId
filteredNewItems = filter ifilter newItems
filteredNewItems = ifilter newItems
allFilteredItems = items++filteredNewItems
scrolltoend dom=:{corner2={y=bot}} wdef
......@@ -274,6 +254,26 @@ where
# height = oldHeight + nrItems*(fontLineHeight metrics)
# newDomain = {corner1=zero,corner2={x=maxWidth,y=height}} // calculate new domain...
= (newDomain,pic)
scroll_to_selection newSelection lineHeight customId ps
# first_item=hd newSelection
# last_item=last newSelection
# top = (first_item-1) * lineHeight
# bot = last_item * lineHeight
# (wdef,ps) = accPIO (getParentWindow customId) ps
| isNothing wdef = ps
# wdef = fromJust wdef
# (exists,frame) = getControlViewFrame customId wdef
| not exists = ps
| isNothing frame = ps
# frame = fromJust frame
# delta = top - frame.corner1.y
| delta < 0 || (bot-top) > (frame.corner2.y-frame.corner1.y)
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
# delta = bot - frame.corner2.y
| delta > 0
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
= ps
removeDupAtt [x:xs] = [x:removeDupAtt (filter (diff x) xs)]
where
......@@ -300,12 +300,26 @@ where
| y<min_y || y-lineHeight>max_y
= (y+lineHeight,p)
= (y+lineHeight,drawAt {x=0,y=y} line p)
# pict = strictSeq [drawsel sel \\ sel <- selection] pict
# pict = hilite_selections selection pict
= pict
where
x1 = newFrame.corner1.x
x2 = newFrame.corner2.x
drawsel i = hilite {corner1={x=x1,y=(i-1)*lineHeight}, corner2={x=x2,y=i*lineHeight-1}}
hilite_selections [selection:selections] pict
# (last_line_n,selections) = determine_last_line_of_rectangle selection selections
# pict = drawsel selection last_line_n pict
= hilite_selections selections pict
with
determine_last_line_of_rectangle line_n [next_line_n:next_lines]
| next_line_n==line_n+1
= determine_last_line_of_rectangle next_line_n next_lines
determine_last_line_of_rectangle line_n lines
= (line_n,lines)
hilite_selections [] pict
= pict;
drawsel i j = hilite {corner1={x=x1,y=(i-1)*lineHeight}, corner2={x=x2,y=j*lineHeight-1}}
//--
......@@ -317,7 +331,7 @@ flbKeyboard efun = ControlKeyboard keyFilter Able (keyboard efun)
keyFilter :: KeyboardState -> Bool
keyFilter (SpecialKey _ (KeyDown _) _) = True
keyFilter _ = False
keyFilter _ = False
keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbState=:{selection,items,lineHeight},ls),ps)
| key == enterKey
......@@ -336,11 +350,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
# newSelection = if hasSelection (max 1 (lastSelection - 1)) 1
# lbState = {lbState & selection = [newSelection]}
# newSelection = if hasSelection [max 1 (lastSelection - 1)] [1]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
| key == downKey
......@@ -348,11 +362,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
# newSelection = if hasSelection (min nrItems (lastSelection + 1)) nrItems
# lbState = {lbState & selection = [newSelection]}
# newSelection = [if hasSelection (min nrItems (lastSelection + 1)) nrItems]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
| key == beginKey
......@@ -360,11 +374,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
# newSelection = 1
# lbState = {lbState & selection = [newSelection]}
# newSelection = [1]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
| key == endKey
......@@ -372,11 +386,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
# newSelection = nrItems
# lbState = {lbState & selection = [newSelection]}
# newSelection = [nrItems]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
# (wstate,ps) = accPIO (getParentWindow customId) ps
......@@ -398,14 +412,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
# top = (lastSelection-2) * lineHeight
# newSelection = if hasSelection
(if (top <= frame.corner1.y) //topLine
(max 1 (lastSelection - linesOnPage))
(2 + (frame.corner1.y / lineHeight)) //topOfPage
[max 1 (lastSelection - linesOnPage)]
[2 + (frame.corner1.y / lineHeight)] //topOfPage
)
1
# lbState = {lbState & selection = [newSelection]}
[1]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
| key == pgDownKey
......@@ -416,14 +430,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
# bot = (inc lastSelection) * lineHeight
# newSelection = if hasSelection
(if (bot >= frame.corner2.y) //bottomLine
(min nrItems (lastSelection + linesOnPage))
(frame.corner2.y / lineHeight) //bottomOfPage
[min nrItems (lastSelection + linesOnPage)]
[frame.corner2.y / lineHeight] //bottomOfPage
)
nrItems
# lbState = {lbState & selection = [newSelection]}
[nrItems]
# lbState = {lbState & selection = newSelection}
# (newLook,lbState)
= customlook lbState
# ps = scrolltoselection True newSelection ps
# ps = scroll_to_selection newSelection lineHeight customId ps
# ps = appPIO (setControlLooks [(customId,True,(True,newLook))]) ps
= ((lbState,ls),ps)
= ((lbState,ls),ps)
......@@ -434,24 +448,6 @@ where
| isEmpty selection = False
= True
lastSelection = hd selection
scrolltoselection singlesel selitem ps
| not singlesel = ps
# top = (selitem-1) * lineHeight
# bot = selitem * lineHeight
# (wdef,ps) = accPIO (getParentWindow customId) ps
| isNothing wdef = ps
# wdef = fromJust wdef
# (exists,frame) = getControlViewFrame customId wdef
| not exists = ps
| isNothing frame = ps
# frame = fromJust frame
# delta = top - frame.corner1.y
| delta < 0
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
# delta = bot - frame.corner2.y
| delta > 0
= appPIO (moveControlViewFrame customId {vx=0, vy=delta}) ps
= ps
keyboard _ _ _ = abort "FilteredListBox: unsupported keyboard action"
// The mouse responds only to MouseDowns:
......@@ -478,12 +474,12 @@ where
newSelection
| shiftDown
| hasSelection
= removeDup [newIndex:listSelection++selection]
= removeMembers selection listSelection++listSelection
= [newIndex]
| controlDown
| isMember newIndex selection
= removeMembers selection [newIndex]
= [newIndex:selection]
= removeMember newIndex selection
= selection++[newIndex]
= [newIndex]
okSelection = filter (isBetween 1 nrItems) newSelection
customId = listboxState.listboxId.fcontrolId
......@@ -547,17 +543,17 @@ setFilteredListBoxPen :: !FilteredListBoxId ![PenAttribute] !(PSt .l) -> PSt .l
setFilteredListBoxPen {freceiverId} pen ps
= snd (syncSend2 freceiverId (FInSetPen pen) ps)
setFilter :: !FilteredListBoxId (String->Bool) !(PSt .l) -> PSt .l
setFilter :: !FilteredListBoxId ([String]->[String]) !(PSt .l) -> PSt .l
setFilter {freceiverId} flt ps
= snd (syncSend2 freceiverId (FInSetFilter flt) ps)
getFilter :: !FilteredListBoxId !(PSt .l) -> (!String->Bool,PSt .l)
getFilter :: !FilteredListBoxId !(PSt .l) -> (![String]->[String],PSt .l)
getFilter {freceiverId} ps
# ((_,out),ps) = (syncSend2 freceiverId (FInGetFilter) ps)
| isNothing out = (const True,ps)
| isNothing out = (id,ps)
# out = case (fromJust out) of
(FOutGetFilter filt) -> filt
_ -> const True
_ -> id
= (out,ps)
exec_next_filtered :: !Bool !FilteredListBoxId (String (PSt .l) -> (PSt .l)) !(PSt .l) -> (PSt .l)
......@@ -566,29 +562,56 @@ exec_next_filtered next lbId efun ps
| not ok = ps
# ((ok,lst),ps) = getFilteredListBoxItems lbId ps
| not ok = ps
| length lst == 0 = ps
# idx = (if (isEmpty sel) (firsti) (nexti (snd(hd sel)) lst))
# ps = setFilteredListBoxSelection lbId [idx] ps
# l = length lst
| l == 0 = ps
# selected_line_numbers = if (isEmpty sel)
(lines_from 1 lst l)
(next_selected_line_numbers (snd(hd sel)) lst l)
# ps = setFilteredListBoxSelection lbId selected_line_numbers ps
# ((ok,sel),ps) = getFilteredListBoxSelection lbId ps
| not ok = ps
| isEmpty sel = ps
# path = fst(hd sel)
= efun path ps
where
firsti = 1
nexti idx lst
# idx = fun idx
# idx = normalise idx 1 l l
= idx
where
l = length lst
fun
| next = inc
= dec
normalise num min max incr
| num < min = normalise (num+incr) min max incr
| num > max = normalise (num-incr) min max incr
= num
next_selected_line_numbers line_n lst l
| next
# line_n = inc line_n
| line_n > l
= lines_from 1 lst l
= next_if_string_begins_with_space line_n lst l
# line_n = dec line_n
| line_n < 1
= move_up_while_string_begins_with_space l lst l
= next_if_string_begins_with_space line_n lst l
next_if_string_begins_with_space line_n lst l
# s=lst!!(line_n-1)
| size s>0 && s.[0]==' '
= next_selected_line_numbers line_n lst l
= lines_from line_n lst l
move_up_while_string_begins_with_space line_n lst l
| line_n == 1
= lines_from 1 lst l
# s=lst!!(line_n-1)
| size s>0 && s.[0]==' '
= move_up_while_string_begins_with_space (dec line_n) lst l
= lines_from line_n lst l
lines_from line_n lst l
# s=lst!!(line_n-1)
| size s>0 && s.[0]==' '
= [line_n]
= [line_n:lines_beginning_with_space (line_n+1) lst l]
lines_beginning_with_space line_n lst l
| line_n>l
= []
# s=lst!!(line_n-1)
| size s>0 && s.[0]==' '
= [line_n:lines_beginning_with_space (line_n+1) lst l]
= []
// Auxiliary functions:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment