diff options
| author | Camil Staps | 2015-07-01 17:36:37 +0200 |
|---|---|---|
| committer | Camil Staps | 2015-07-01 17:36:37 +0200 |
| commit | 7553b7f9d4dddc2235c137d41de8ce22547bebe3 (patch) | |
| tree | 34f8fb4b36640317d728a60586424f67f9befbe7 /osfileselect.icl | |
| parent | gitignore (diff) | |
Initial commit
Diffstat (limited to 'osfileselect.icl')
| -rw-r--r-- | osfileselect.icl | 86 |
1 files changed, 86 insertions, 0 deletions
diff --git a/osfileselect.icl b/osfileselect.icl new file mode 100644 index 0000000..5a18403 --- /dev/null +++ b/osfileselect.icl @@ -0,0 +1,86 @@ +implementation module osfileselect
+
+
+import StdBool, StdInt
+import clCrossCall_12, osevent
+from clCCall_12 import winMakeCString, winGetCStringAndFree, winReleaseCString, :: CSTR
+from commondef import fatalError
+import code from "cCrossCallFileSelectors_121.o"
+
+
+osfileselectFatalError :: String String -> .x
+osfileselectFatalError function error
+ = fatalError function "osfileselect" error
+
+
+osInitialiseFileSelectors :: !*OSToolbox -> *OSToolbox
+osInitialiseFileSelectors _
+ = code
+ {
+ .inline InstallCrossCallFileSelectors
+ ccall InstallCrossCallFileSelectors "I-I"
+ .end
+ }
+
+osSelectinputfile :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectinputfile handleOSEvent state tb
+ # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq0Cci CcRqFILEOPENDIALOG) state tb
+ # (ok,name,tb) = getinputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (pathname,tb) = winGetCStringAndFree ptr tb
+ = (True,pathname,tb)
+ getinputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getinputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectinputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+osSelectoutputfile :: !(OSEvent->.s->.s) !.s !String !String !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectoutputfile handleOSEvent state prompt filename tb
+ # (promptptr, tb) = winMakeCString prompt tb
+ # (filenameptr,tb) = winMakeCString filename tb
+ # (rcci,state, tb) = issueCleanRequest (callback handleOSEvent) (Rq2Cci CcRqFILESAVEDIALOG promptptr filenameptr) state tb
+ # tb = winReleaseCString promptptr tb
+ # tb = winReleaseCString filenameptr tb
+ # (ok,name,tb) = getoutputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getoutputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getoutputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (path,tb) = winGetCStringAndFree ptr tb
+ = (True,path,tb)
+ getoutputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getoutputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectoutputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+osSelectdirectory :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectdirectory handleOSEvent state tb
+ # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq0Cci CcRqDIRECTORYDIALOG) state tb
+ # (ok,name,tb) = getinputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (pathname,tb) = winGetCStringAndFree ptr tb
+ = (True,pathname,tb)
+ getinputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getinputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+// callback lifts a function::(OSEvent -> .s -> .s) to
+// a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox))
+callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
+callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb)
|