diff --git a/Ide/errwin.icl b/Ide/errwin.icl index b6d6f24d587dae554b60fe5a569a98b3bd528f7f..4a86acef82665fa2433dcb38c92ff14bfd7ba789 100644 --- a/Ide/errwin.icl +++ b/Ide/errwin.icl @@ -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 diff --git a/Util/FilteredListBox.dcl b/Util/FilteredListBox.dcl index 85fc3c8cfeab6e827bb9e350da834445923045b5..3bdae2ba32898faf98b83eeb2d0f6cc93be3f4e4 100644 --- a/Util/FilteredListBox.dcl +++ b/Util/FilteredListBox.dcl @@ -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) diff --git a/Util/FilteredListBox.icl b/Util/FilteredListBox.icl index ba45587e64bdd12913be3f4ecc17e97804d7b392..80af254d13115e0734b25069b882683fe8076351 100644 --- a/Util/FilteredListBox.icl +++ b/Util/FilteredListBox.icl @@ -1,6 +1,6 @@ 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 | ymax_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: