More Editor state threading

Ed/EdLook.dcl

@@ -15,7 +15,7 @@ from StdString import String
 from StdPSt		 import PSt, IOSt
 import EdMonad
 
-editWindowLook	:: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
+editWindowLook	:: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
 
 // editWindowLook: defines the look of the editor window. This function
 //				   is used to handle update events.

Ed/EdLook.icl

@@ -15,12 +15,12 @@ trace_n _ f :== f
 // editWindowLook: updating the affected areas is done by updating
 // each of the rectangles.
 
-editWindowLook	:: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
-editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame }
-  	= trace_n ("Look",updateState) editWindowLook`
+editWindowLook	:: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
+editWindowLook editState
+  	= (editState`,editWindowLook`)
 where
-	editWindowLook` :: !*Picture -> *Picture
-	editWindowLook` picture
+//	editWindowLook` :: !*Picture -> *Picture
+	editWindowLook`  selectState updateState=:{ updArea, newFrame, oldFrame } picture
 //		# picture = traceUpdate updArea picture
 		# updArea = cleanUpdate updArea	// hack around object i/o bug...
 //		# picture = traceUpdate updArea picture
@@ -34,7 +34,7 @@ where
 	(text,ds2)				= getText ds1
 	(visible,ds3)			= getCursorVisibility ds2
 	(height,ds4)			= getCursorHeight ds3
-	(selection=:{end},_)	= getSelection ds4
+	(selection=:{end},(editState`,_))	= getSelection ds4
 
 /*
 import StdDebug,dodebug

Ed/EdMessage.dcl

@@ -7,15 +7,14 @@ definition module EdMessage
 from StdId			import Id,RId,Ids
 from StdPSt			import PSt, IOSt
 from StdReceiver	import Receiver2, R2Id, Receiver2Function, ReceiverAttribute
-from EdMonad		import EditState
+from EdMonad		import EditState, EditMonad
 
 :: EditId
 :: Message
+:: EditAction l a	:== EditMonad (PSt l) a
 
 openEditId			:: *env								-> (EditId, *env) | Ids env
 openEditReceiver	:: !EditId							-> Receiver2 Message Message EditState (PSt *l)
 
-hasEditState		:: !EditId			  !*(PSt *l)	-> *(Bool,		*PSt *l)
-getEditState		:: !EditId			  !*(PSt *l)	-> *(EditState,	*PSt *l)
-setEditState		:: !EditId !EditState !*(PSt *l)	->				*PSt *l
-
+hasEditState		:: !EditId			  			!*(PSt *l) -> *(Bool,		*PSt *l)
+appEditState		:: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)

Ed/EdMessage.icl

@@ -16,6 +16,8 @@ import EdMonad
    | MsgGet				// ask for the state
    | MsgOk				// signifies that a send operation was successful
 
+:: EditAction l a :== EditMonad (PSt l) a
+
 openEditId :: *env -> (EditId, *env) | Ids env
 openEditId pstate
   = openR2Id pstate
@@ -41,6 +43,15 @@ hasEditState editId pstate
   # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
   = (isJust maybeResp, pstate)
 
+// appEditState 
+
+appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)
+appEditState editId monad pState
+  # (editState, pState)			= getEditState editId pState
+  # (x, (editState, pState))	= monad (editState, pState)
+  #	pState						= setEditState editId editState pState
+  = (x, pState)
+
 // getEditState 
 
 getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l)

Ed/EdMonad.icl

@@ -382,7 +382,10 @@ updateLook :: EditMonad (PSt *l) nothing
 updateLook 
   = getWindowId		>>>= \windowId ->
 	getEditState	>>>= \editState ->
-	appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState)))
+	let
+		(editState,editLook)	= editWindowLook editState
+	in
+	appEnv (appPIO (setWindowLook windowId False (True,editLook)))
 
 // compute some properties of a font
 

Ed/EdState.dcl

@@ -22,7 +22,7 @@ instance Editor (PSt *p) | Editor p
 
 initEditorState		:: !KeyMapping					->	EditorState
 
-findReceiver		:: !Id			!EditorState	->	Maybe EditId
+findReceiver		:: !Id			!EditorState	->	(!Maybe EditId, !EditorState)
 addReceiver			:: Id EditId	!EditorState	->	EditorState
 removeReceiver		:: Id			!EditorState	->	EditorState
 

Ed/EdState.icl

@@ -46,10 +46,10 @@ removeReceiver windowId editorState=:{ windows }
 
 // lookup the window identification number in the global administration
 
-findReceiver :: !Id !EditorState -> Maybe EditId
-findReceiver windowId { windows }
-  | isEmpty matches = Nothing
-  | otherwise       = Just (hd matches)
+findReceiver :: !Id !EditorState -> (!Maybe EditId, !EditorState)
+findReceiver windowId (es=:{ windows })
+  | isEmpty matches = (Nothing, es)
+  | otherwise       = (Just (hd matches), es)
   where
     matches = tableLookup windowId windows
 

Ed/EdWindow.icl

@@ -24,13 +24,14 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
   // compute the view domain of the visual text
 	(viewDomain, (editState, ps))	= computeViewDomain (editState, ps)
   // setup the window attributes 
+	(editState,editLook)			= editWindowLook editState
 	windowAttrs						= atts ++		// in this order so that new attributes override default atts
 										  	[ WindowViewSize   { w = 800, h = fontInfo.FontInfo.lineHeight * 40 }
 											, WindowHMargin	   0 0
 											, WindowVMargin	   0 0
 											, WindowId		   windowId
 											, WindowViewDomain viewDomain
-											, WindowLook	   True (editWindowLook editState)
+											, WindowLook	   True editLook
 											, WindowHScroll	   (hScrollFun	   fontInfo)
 											, WindowVScroll	   (vScrollFun	   fontInfo)
 											, WindowPos		   (Fix, OffsetVector {vx=10, vy=10})
@@ -48,11 +49,12 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
   
 closeEditWindow :: !Id !*(PSt *b) -> *PSt *b | Editor b;
 closeEditWindow windowId pState
-  # (editorState,pState) 	= getEditorState pState
-  # notEdit					= isNothing (findReceiver windowId editorState)
-  | notEdit = setEditorState editorState pState
-  #	editorState				= removeReceiver windowId editorState
-	pState					= closeWindow windowId pState
+  # (editorState,pState) 		= getEditorState pState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
+  | isNothing maybeEditId
+  	= setEditorState editorState pState
+  #	editorState					= removeReceiver windowId editorState
+	pState						= closeWindow windowId pState
   = setEditorState editorState pState
 
 /**********************

Editor/EdClient.dcl

 definition module EdClient
 
 import EdMonad, EdState, EdCommon
+from EdMessage import EditAction
 
 sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
 
 message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
 
-:: EditAction l a :== EditMonad (PSt l) a
-
 // Messages
 
 msgSave		::						EditAction *l nothing

Editor/EdClient.icl

@@ -12,13 +12,13 @@ import ExtNotice, StrictList
 //sendToActiveWindow	:: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l)))
 sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
 sendToActiveWindow editAction pState
-  # (maybeId, pState)		= accPIO getActiveWindow pState
+  # (maybeId, pState)			= accPIO getActiveWindow pState
   | isNothing maybeId 
 	= (Nothing,pState)	// fail silently
-  #	windowId				= fromJust maybeId
-    (editorState,pState) 	= getEditorState pState
-    notEdit					= isNothing (findReceiver windowId editorState)
-  | notEdit
+  #	windowId					= fromJust maybeId
+    (editorState,pState) 		= getEditorState pState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
+  | isNothing maybeEditId
   	= (Nothing,pState)
   = message windowId editAction pState
 	
@@ -26,19 +26,15 @@ sendToActiveWindow editAction pState
 message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
 message windowId monad pState
   # (editorState, pState)		= getEditorState pState
-  # maybeEditId					= findReceiver windowId editorState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
   | isNothing maybeEditId
   	= (Nothing, setEditorState editorState pState)
   # editId						= fromJust maybeEditId
-  # (editState, pState)			= getEditState editId pState
-  # (x, (editState, pState))	= monad (editState, pState)
-  #	pState						= setEditState editId editState pState
+  # (x, pState)					= appEditState editId monad pState
   # pState						= setEditorState editorState pState
   = (Just x, pState)
 
 
-:: EditAction l a :== EditMonad (PSt l) a
-
 // Messages
 
 msgSave :: EditAction *l nothing

Ide/EdClient.dcl

@@ -23,15 +23,13 @@ definition module EdClient
 
 import StdMaybe, StdId, StdPSt, StdPicture, StdPrint
 from EdState	import Editor, EditorState
-from EdMessage	import EditId
+from EdMessage	import EditId, EditAction
 from EdLineText	import Text
 import EdPosition
 from EdSelection import Selection, emptySelection, lineSelection
 from EdMonad	import UndoState, EditMonad, EditState, StateM, getPathName
 import IdeState
 
-:: EditAction l a :== EditMonad (PSt l) a
-
 isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a
 				  
 // "Remote method invocations". The destination is denoted by a window identifier.

Ide/EdClient.icl

@@ -33,12 +33,10 @@ import EdText
 import IdeState, UtilNewlinesFile
 
 
-:: EditAction l a :== EditMonad (PSt l) a
-
 isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a
 isEditWin windowId pState
   # (editorState, pState)		= getEditorState pState
-  # maybeEditId					= findReceiver windowId editorState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
   # iseditwin					= not (isNothing maybeEditId)
   # pState						= setEditorState editorState pState
   = (iseditwin, pState)
@@ -46,25 +44,23 @@ isEditWin windowId pState
 message :: !Id !.(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
 message windowId monad pState
   # (editorState, pState)		= getEditorState pState
-  # maybeEditId					= findReceiver windowId editorState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
   | isNothing maybeEditId
   	= (Nothing, setEditorState editorState pState)
   # editId						= fromJust maybeEditId
-  # (editState, pState)			= getEditState editId pState
-  # (x, (editState, pState))	= monad (editState, pState)
-  #	pState						= setEditState editId editState pState
+  # (x, pState)					= appEditState editId monad pState
   # pState						= setEditorState editorState pState
   = (Just x, pState)
 
 sendToActiveWindow :: .(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
 sendToActiveWindow editAction pState
-  # (maybeId, pState)		= accPIO getActiveWindow pState
+  # (maybeId, pState)			= accPIO getActiveWindow pState
   | isNothing maybeId 
 	= (Nothing,pState)	// fail silently
-  #	windowId				= fromJust maybeId
-    (editorState,pState) 	= getEditorState pState
-    notEdit					= isNothing (findReceiver windowId editorState)
-  | notEdit
+  #	windowId					= fromJust maybeId
+    (editorState,pState) 		= getEditorState pState
+  # (maybeEditId, editorState)	= findReceiver windowId editorState
+  | isNothing maybeEditId
   	= (Nothing,pState)
   = message windowId editAction pState
 	

Ide/conswin.icl

@@ -118,9 +118,7 @@ maybe_cons_win_message2 message ps
 	= (Nothing,ps)
 
 cons_message editId monad pState
-	#	(editState, pState)			= getEditState editId pState
-	#	(x, (editState, pState))	= monad (editState, pState)
-	#!	pState						= setEditState editId editState pState
+	# (x,pState)					= appEditState editId monad pState
 	= (Just x,pState)
 
 //---
@@ -135,13 +133,14 @@ openConsoleWindow cwi text atts ps
 	# (_, (editState, ps))			= setText text (editState, ps)
 	# (fontInfo, (editState, ps))	= getFontInfo (editState, ps) 
 	# (viewDomain, (editState, ps))	= computeViewDomain (editState, ps)
+	# (editState,editLook)			= editWindowLook editState
 	# windowAttrs 
 	  = [ WindowOuterSize  	cwi.tsiz
 		, WindowHMargin	  	0 0
 		, WindowVMargin	  	0 0
 		, WindowId		  	windowId
 		, WindowViewDomain	viewDomain
-		, WindowLook		True (editWindowLook editState)
+		, WindowLook		True editLook
 		, WindowHScroll		(hScrollFun fontInfo)
 		, WindowVScroll		(vScrollFun fontInfo)
 		, WindowPos			(Fix, OffsetVector cwi.tpos)

Ide/typewin.icl

@@ -130,9 +130,7 @@ type_win_message message ps
 
 type_message :: !EditId !.(EditMonad *(PSt *b) .c) !*(PSt *b) -> *(Maybe .c,*(PSt *b))
 type_message editId monad pState
-	#	(editState, pState)			= getEditState editId pState
-	#	(x, (editState, pState))	= monad (editState, pState)
-	#!	pState						= setEditState editId editState pState
+	# (x,pState) = appEditState editId monad pState
 	= (Just x,pState)
 
 //---
@@ -147,13 +145,14 @@ openTypeWindow twi text atts ps
 	# (_, (editState, ps))			= setText text (editState, ps)
 	# (fontInfo, (editState, ps))	= getFontInfo (editState, ps) 
 	# (viewDomain, (editState, ps))	= computeViewDomain (editState, ps)
+	# (editState,editLook)			= editWindowLook editState
 	# windowAttrs 
 	  = [ WindowOuterSize  	twi.tsiz
 		, WindowHMargin	  	0 0
 		, WindowVMargin	  	0 0
 		, WindowId		  	windowId
 		, WindowViewDomain	viewDomain
-		, WindowLook		True (editWindowLook editState)
+		, WindowLook		True editLook
 		, WindowHScroll		(hScrollFun	   fontInfo)
 		, WindowVScroll		(vScrollFun	   fontInfo)
 		, WindowPos			(Fix, OffsetVector twi.tpos)