aboutsummaryrefslogtreecommitdiff
path: root/main/Mac
diff options
context:
space:
mode:
Diffstat (limited to 'main/Mac')
-rw-r--r--main/Mac/Clean2AppleEventHandler.dcl10
-rw-r--r--main/Mac/Clean2AppleEventHandler.icl48
-rw-r--r--main/Mac/CoclSystemDependent.dcl10
-rw-r--r--main/Mac/CoclSystemDependent.icl146
-rw-r--r--main/Mac/cache_variable.dcl6
-rw-r--r--main/Mac/cache_variable.icl52
-rw-r--r--main/Mac/cae.c262
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;
+}
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 22:47:18 +0000