support error messages of more than one line

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

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)

Util/FilteredListBox.icl

 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
@@ -275,6 +255,26 @@ where
 				# 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
 	diff (PenSize _)	(PenSize _)		= False
@@ -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}}
 
 //--
 
@@ -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: