no message

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@275 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

7 files changed, 476 insertions, 58 deletions

diff --git a/main/Mac/Clean2AppleEventHandler.dcl b/main/Mac/Clean2AppleEventHandler.dcl
new file mode 100644
index 0000000..0690b79
--- /dev/null
+++ b/main/Mac/Clean2AppleEventHandler.dcl
@@ -0,0 +1,10 @@
+definition module Clean2AppleEventHandler;
+
+from StdString import String;
+from StdFile import Files;
+from events import Event;
+
+install_apple_event_handlers :: Int;
+HandleAppleEvent :: !Event (!{#Char} *Files -> (!Int,!*Files)) !*Files -> (!Bool,!Bool,!*Files);
+
+get_apple_event_string :: !Int !String -> Int;
diff --git a/main/Mac/Clean2AppleEventHandler.icl b/main/Mac/Clean2AppleEventHandler.icl
new file mode 100644
index 0000000..8c28e2c
--- /dev/null
+++ b/main/Mac/Clean2AppleEventHandler.icl
@@ -0,0 +1,48 @@
+implementation module Clean2AppleEventHandler;
+
+import StdClass,StdBool,StdArray,StdInt,StdString,StdChar,StdFile;
+import files,events;
+
+import StdDebug,StdString;
+
+HandleAppleEvent :: !Event (!{#Char} *Files -> (!Int,!*Files)) !*Files -> (!Bool,!Bool,!*Files);
+HandleAppleEvent (b,what,message,when,p1,p2,modifiers) script_handler files
+	| what==HighLevelEvent
+		# r1=handle_apple_event2 what message when p1 p2 modifiers;		
+		# result_string=createArray r1 ' ';
+		  r=get_apple_event_string r1 result_string;
+		  
+//		| trace_t r1 && trace_t ' ' && trace_t r && trace_t ' ' && trace_t result_string && trace_t '\n' &&
+		|
+		 r==4 && result_string % (0,3) == "QUIT"
+			= (True,True,files);
+		| r >= 6 && result_string % (0, 5) == "SCRIPT"
+			# (result,files) = script_handler (result_string % (6,r-1)) files
+			= (True,False,files);
+			= (False,False,files);
+	=	(False,False,files);
+
+install_apple_event_handlers :: Int;
+install_apple_event_handlers
+	= code ()(r=D0){
+		call	.install_apple_event_handlers
+	}
+
+handle_apple_event :: !Int !Int !Int !Int !Int !Int !String -> Int;
+handle_apple_event what message when p1 p2 modifiers string
+	= code (modifiers=W,p1=W,p2=W,when=L,message=L,what=W,string=O0D0U)(r=I16D0){
+		instruction 0x38970000	|	addi	r4,r23,0
+	 	call	.handle_apple_event
+ 	}
+
+handle_apple_event2 :: !Int !Int !Int !Int !Int !Int -> Int;
+handle_apple_event2 what message when p1 p2 modifiers
+	= code {
+	 	ccall	handle_apple_event2 "GIIIIII:I"
+ 	}
+
+get_apple_event_string :: !Int !String -> Int;
+get_apple_event_string length string
+	= code {
+	 	ccall	get_apple_event_string "IS:I"
+ 	}
diff --git a/main/Mac/CoclSystemDependent.dcl b/main/Mac/CoclSystemDependent.dcl
index 319b75c..4a27e46 100644
--- a/main/Mac/CoclSystemDependent.dcl
+++ b/main/Mac/CoclSystemDependent.dcl
@@ -1,13 +1,15 @@
 // this is for the PowerMac
 definition module CoclSystemDependent
 
-from deltaIOSystem import DeviceSystem
-from deltaEventIO import InitialIO, IOState
+from StdFile import Files
 
 PathSeparator
 	:==	','
 DirectorySeparator
 	:==	':'
 
-SystemDependentDevices :: [DeviceSystem .a (IOState .a)]
-SystemDependentInitialIO :: InitialIO *s
+script_handler :: !{#Char} *Files -> (!Int,!*Files);
+
+clean2_compile :: !Int -> Int;
+
+clean2_compile_c_entry :: !Int -> Int;
diff --git a/main/Mac/CoclSystemDependent.icl b/main/Mac/CoclSystemDependent.icl
index 971105c..389bd22 100644
--- a/main/Mac/CoclSystemDependent.icl
+++ b/main/Mac/CoclSystemDependent.icl
@@ -2,68 +2,106 @@
 implementation module CoclSystemDependent
 
 import StdEnv
-import deltaIOSystem, deltaEventIO, deltaIOState
-import AppleEventDevice
-import compile
-import docommand
-import RWSDebug
+import Clean2AppleEventHandler,compile,docommand,cache_variable
+
+from Clean2AppleEventHandler import get_apple_event_string;
 
 PathSeparator
 	:==	','
 DirectorySeparator
 	:==	':'
 
-SystemDependentDevices :: [DeviceSystem .a (IOState .a)]
-SystemDependentDevices
-		=	[AppleEventSystem {openHandler = openDummy, quitHandler = Quit,
-								clipboardChangedHandler = clipboardDummy, scriptHandler = scriptHandler}];
-		where
-			openDummy filePath s io
-				=	(s, io) <<- ("open", filePath)
-			clipboardDummy s io
-				=	(s, io) <<- "clipboard"
+script_handler :: !{#Char} *Files -> (!Int,!*Files);
+script_handler script files
+	= case args of
+		["cocl":coclArgs]
+			# cache = load_state 0;
+			# (ok,cache,files) = compile coclArgs cache files;
+			->	(if ok 1 0,store_cache_or_clear_cache cache files)
+		["clear_cache"]
+			| store_state empty_cache>0
+				# (r,s) = DoCommandNullTerminated ("clear_cache" +++ "\0") 0
+				-> (r,files)
+				# (r,s) = DoCommandNullTerminated ("clear_cache" +++ "\0") 0
+				-> (r,files)
+		_
+			// +++ handle errors from docommand
+			# (r,s) = DoCommandNullTerminated (script +++ "\0") 0
+			-> (r,files)
+	where
+		args
+			=	filter ((<>) "") (map replace scriptArgs)
+		scriptArgs
+			=	splitArgs script
+
+		store_cache_or_clear_cache cache files
+			| isMember "-clear_cache" scriptArgs && store_state empty_cache>0
+				# (r,s)=DoCommandNullTerminated "clear_cache\0" 0
+				| r==0
+					= files
+					= files;
+			| store_state cache>0
+				=	files
+				=	files
+		replace s
+			| s == "\xb3" /* \xb3 == >= ligature */
+				=	"-RE"
+			| s == ">"
+				=	"-RO"
+			| s == "-clear_cache"
+				=	""
+			// otherwise
+				=	s
 
-		/*
-			scriptHandler script s io
-				# (result, env) = DoCommandNullTerminated (script +++ "\0") 17
-				| result >= 0
-					=	(s, io)
+		splitArgs s
+			=	split False 0 0 (size s) s
+		where
+			split quoted frm to n s
+				| to >= n
+					=	[s % (frm, to)]
+				| s.[to] == '\\' && to < n-1
+					=	split quoted frm (to+2) n s
+				| s.[to] == ' ' && not quoted 
+					=	[s % (frm, to-1) : split False (to+1) (to+1) n s]
+				| s.[to] == '\'' && quoted
+					=	[s % (frm, to-1) : split False (to+1) (to+1) n s]
+				| s.[to] == '\''
+					=	[s % (frm, to-1) : split True (to+1) (to+1) n s]
 				// otherwise
-					=	(s, io) <<- ("error in docommand", result, script)
-		*/
-			scriptHandler script s io
-				=	(s, appFiles (compile (processArgs script)) io) <<- ("script", processArgs script)
-				where
-					processArgs s
-						=	[replace arg \\ arg <- filter ((<>) "") (splitArgs s)]
+					=	split quoted frm (to+1) n s
+
+//import StdDebug,StdString;
+
+clean2_compiler :: !Int !*Files -> (!Int,!*Files);
+clean2_compiler length files
+	# string=createArray length ' ';
+	# r=get_apple_event_string length string;
+//	| trace_t length && trace_t ':' && trace_t r && trace_t '\n'
+//		| trace_t string
+	= script_handler (string%(6,r-1)) files;
+//			= (0,files);
+//		= (0,files);
+
+clean2_compile :: !Int -> Int;
+clean2_compile length
+	# (r,files)=clean2_compiler length create_files;
+	= r;
+
+clean2_compile_c_entry :: !Int -> Int;
+clean2_compile_c_entry r = code {
+	.d 0 1 i
+	rtn
+	centry clean2_compile e_CoclSystemDependent_sclean2_compile "I:I"
+ }
+
+::	* MyFiles = MyFiles;
 
-					replace s
-						| s == "\xb3" /* \xb3 == >= ligature */
-							=	"-RE"
-						| s == ">"
-							=	"-RO"
-						// otherwise
-							=	s
-					splitArgs s
-						=	split False 0 0 (size s) s
-					split quoted frm to n s
-						| to >= n
-							=	[s % (frm, to)]
-						| s.[to] == '\\' && to < n-1
-							=	split quoted frm (to+2) n s
-						| s.[to] == ' ' && not quoted 
-							=	[s % (frm, to-1) : split False (to+1) (to+1) n s]
-						| s.[to] == '\'' && quoted
-							=	[s % (frm, to-1) : split False (to+1) (to+1) n s]
-						| s.[to] == '\''
-							=	[s % (frm, to-1) : split True (to+1) (to+1) n s]
-						// otherwise
-							=	split quoted frm (to+1) n s
+create_myfiles = MyFiles;
 
-SystemDependentInitialIO :: InitialIO *s
-SystemDependentInitialIO
-		=	[]
+create_files :: *Files;
+create_files = cast create_myfiles;
 
-Quit :: *s (IOState *s) -> (*s, IOState *s)
-Quit s io
-	=	(s, QuitIO io)
+cast :: !*a -> *b;
+cast f = code {
+	pop_b 0
+ }
diff --git a/main/Mac/cache_variable.dcl b/main/Mac/cache_variable.dcl
new file mode 100644
index 0000000..95e1c9e
--- /dev/null
+++ b/main/Mac/cache_variable.dcl
@@ -0,0 +1,6 @@
+definition module cache_variable;
+
+import compile;
+
+store_state :: !*DclCache -> Int;
+load_state :: Int -> .DclCache;
diff --git a/main/Mac/cache_variable.icl b/main/Mac/cache_variable.icl
new file mode 100644
index 0000000..8ed2579
--- /dev/null
+++ b/main/Mac/cache_variable.icl
@@ -0,0 +1,52 @@
+implementation module cache_variable;
+
+import StdEnv;
+import compile;
+
+:: StateVariableContents = State !.DclCache | NoState;
+
+:: StateVariableRecord = {version_number::!Int,contents::!.StateVariableContents};
+
+state_variable_array :: {#StateVariableRecord};
+state_variable_array =: {{version_number=0,contents=NoState}};
+
+update_state_variable_array :: !{#StateVariableRecord} !StateVariableRecord !Int -> (!Int,!{#StateVariableRecord});
+update_state_variable_array array state_variable_record version_number
+	= code {
+		pushI 0
+		update rStateVariableRecord 1 1
+	};
+
+make_unique :: !StateVariableContents -> .StateVariableContents;
+make_unique _
+	= code {
+		fill_a 0 1
+		pop_a 1
+	};
+
+store_state :: !*DclCache -> Int;
+store_state state
+	# array = state_variable_array;
+	# {version_number,contents} = array.[0];
+	= case contents of {
+		NoState
+			# version_number=version_number+1;
+			# (version_number,array) = update_state_variable_array array {version_number=version_number,contents=State state} version_number;
+			-> version_number;
+		_
+			# version_number=version_number+1;
+			# (version_number,array) = update_state_variable_array array {version_number=version_number,contents=State state} version_number;
+			-> version_number;
+	  };
+
+load_state :: Int -> .DclCache;
+load_state version_number_argument
+	# array = state_variable_array;
+	# {version_number,contents} = array.[0];
+	= case (make_unique contents) of {
+		State state
+			# (version_number,array) = update_state_variable_array array {version_number=version_number,contents=NoState} version_number;
+			| version_number==version_number_argument
+				-> state
+				-> state
+	}; 
diff --git a/main/Mac/cae.c b/main/Mac/cae.c
new file mode 100644
index 0000000..04d6724
--- /dev/null
+++ b/main/Mac/cae.c
@@ -0,0 +1,262 @@
+
+#include <AppleEvents.h>
+#include <AERegistry.h>
+
+static char *result_string;
+static int n_free_result_string_characters;
+
+static pascal OSErr DoAEOpenApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+{
+	return noErr;
+}
+
+static int has_required_parameters (AppleEvent *theAppleEvent)
+{
+	Size actual_size;
+	DescType returned_type;
+	OSErr r;
+	
+	r=AEGetAttributePtr (theAppleEvent,keyMissedKeywordAttr,typeWildCard,&returned_type,NULL,0,&actual_size);
+	if (r==errAEDescNotFound)
+		return noErr;
+	if (r==noErr)
+		r=errAEEventNotHandled;
+	return r;
+}
+
+static pascal OSErr DoAEOpenDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent, long refCon)
+{
+	OSErr r;
+	AEDescList document_list;
+
+	if (n_free_result_string_characters<4){
+		n_free_result_string_characters=0;
+		result_string=NULL;
+		return 0;
+	}
+
+	result_string[0]='O';
+	result_string[1]='P';
+	result_string[2]='E';
+	result_string[3]='N';		
+	result_string+=4;
+	n_free_result_string_characters-=4;
+	
+	r=AEGetParamDesc (theAppleEvent,keyDirectObject,typeAEList,&document_list);
+	
+	if (r==noErr){
+		r=has_required_parameters (theAppleEvent);
+
+		if (r==noErr){
+			long n_items;
+		
+			r=AECountItems (&document_list,&n_items);
+						
+			if (r==noErr){
+				long i;
+				
+				for (i=1; i<=n_items; ++i){
+					AEKeyword keyword;
+					DescType returned_type;
+					FSSpec fss;
+					Size actual_size;
+					int n;
+
+					r=AEGetNthPtr (&document_list,i,typeFSS,&keyword,&returned_type,&fss,sizeof (FSSpec),&actual_size);
+					
+					if (r!=noErr)
+						break;
+					
+					if (n_free_result_string_characters<sizeof (FSSpec)){
+						AEDisposeDesc (&document_list);
+						n_free_result_string_characters=0;
+						result_string=NULL;
+						return 0;
+					}
+					
+					*(FSSpec*)result_string=fss;
+					result_string+=sizeof (FSSpec);
+					n_free_result_string_characters-=sizeof (FSSpec);
+				}
+			}
+		}
+	}
+
+	AEDisposeDesc (&document_list);
+
+	if (r!=noErr){
+		result_string=NULL;
+		n_free_result_string_characters=0;
+	}
+	
+	return r;
+}
+ 
+static pascal OSErr DoAEPrintDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+{
+	return errAEEventNotHandled;
+}
+ 
+static pascal OSErr DoAEQuitApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+{
+	if (n_free_result_string_characters>=4){
+		result_string[0]='Q';
+		result_string[1]='U';
+		result_string[2]='I';
+		result_string[3]='T';		
+		result_string+=4;
+		n_free_result_string_characters-=4;
+	}
+	return noErr;
+}
+
+extern pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *replyAppleEvent,long refCon);
+
+extern int clean2_compile (int);
+
+static pascal OSErr DoAEScript (AppleEvent *apple_event,AppleEvent *replyAppleEvent,long refCon)
+{
+	DescType returned_type;
+	long actual_size;
+	int error;
+	char *result_string_begin;
+
+	result_string_begin=result_string;
+	
+	if (n_free_result_string_characters>=6){
+		result_string[0]='S';
+		result_string[1]='C';
+		result_string[2]='R';
+		result_string[3]='I';
+		result_string[4]='P';
+		result_string[5]='T';
+		result_string+=6;
+		n_free_result_string_characters-=6;
+	}
+
+	error=AEGetParamPtr (apple_event,keyDirectObject,'TEXT',&returned_type,result_string,n_free_result_string_characters,&actual_size);
+
+	if (error!=noErr || actual_size > n_free_result_string_characters){
+		result_string=NULL;
+		n_free_result_string_characters=0;
+	} else
+
+	/* RWS ... : ugly, special case for Clean IDE / cg combo */
+	if (strncmp (result_string, "cg ", 3) == 0)
+	{
+		return do_script_apple_event (apple_event, replyAppleEvent, refCon);
+	}
+	/* ... RWS */
+	else if (strncmp (result_string,"cocl ",5)==0){
+		int string_length;
+		
+		result_string += actual_size;
+		string_length=result_string-result_string_begin;
+
+		result_string=NULL;
+
+		return clean2_compile (string_length);
+	}
+
+	result_string	+= actual_size;
+
+	return 1;
+}
+
+int install_apple_event_handlers (void)
+{
+	OSErr r;
+
+	r=AEInstallEventHandler (kCoreEventClass,kAEOpenApplication,NewAEEventHandlerProc (DoAEOpenApplication),0,false);
+
+	if (r==noErr)
+		r=AEInstallEventHandler (kCoreEventClass,kAEOpenDocuments,NewAEEventHandlerProc (DoAEOpenDocuments),0,false);
+
+	if (r==noErr)
+		r=AEInstallEventHandler (kCoreEventClass,kAEPrintDocuments,NewAEEventHandlerProc (DoAEPrintDocuments),0,false);
+
+	if (r==noErr)
+		r=AEInstallEventHandler (kCoreEventClass,kAEQuitApplication,NewAEEventHandlerProc (DoAEQuitApplication),0,false);
+
+	if (r==noErr)
+		r=AEInstallEventHandler (kAEMiscStandards,kAEDoScript,NewAEEventHandlerProc (DoAEScript),0,false);
+	
+	return r;
+}
+
+int handle_apple_event (EventRecord *event_p,long *clean_string)
+{	
+	char *string;
+	int string_length;
+	
+	string_length=clean_string[1];
+	string=(char*)&clean_string[2];
+
+	result_string=string;
+	n_free_result_string_characters=string_length;
+
+	AEProcessAppleEvent (event_p);
+
+	if (result_string!=NULL)
+		string_length=result_string-string;
+	else
+		string_length=0;
+	
+	result_string=NULL;
+	n_free_result_string_characters=0;
+
+	return string_length;
+}
+
+static char apple_event_string[2052];
+
+int handle_apple_event2 (int what,int message,int when,int p1,int p2,int modifiers)
+{
+	EventRecord event;
+	char *string;
+	int string_length;
+
+	event.what=what;
+	event.message=message;
+	event.when=when;
+	event.where.h=p1;
+	event.where.v=p2;
+	event.modifiers=modifiers;
+	
+	string_length=2048;
+	string=apple_event_string;
+
+	result_string=string;
+	n_free_result_string_characters=string_length;
+
+	AEProcessAppleEvent (&event);
+
+	if (result_string!=NULL)
+		string_length=result_string-string;
+	else
+		string_length=0;
+	
+	result_string=NULL;
+	n_free_result_string_characters=0;
+
+	return string_length;
+}
+
+int get_apple_event_string (int length,long *clean_string)
+{
+	char *string;
+	int string_length;
+	
+	string_length=clean_string[0];
+	string=(char*)&clean_string[1];
+
+	if (length==string_length){
+		int i;
+		
+		for (i=0; i<string_length; ++i)
+			string[i]=apple_event_string[i];
+	} else
+		string_length=0;
+
+	return string_length;
+}