AppleScript (empty) → 0.1

raw patch · 8 files changed

+219/−0 lines, 8 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

• AppleScript.cabal +21/−0
• Foreign/AppleScript.hs +45/−0
• LICENSE +32/−0
• Setup.lhs +4/−0
• cbits/RunScript.c +74/−0
• examples/HelloThere.hs +19/−0
• examples/OpenLocation.hs +10/−0
• examples/TextFields.hs +14/−0

@@ -0,0 +1,21 @@+Name:			AppleScript+Version:		0.1+License:		BSD3+License-file:		LICENSE+Author:			Wouter Swierstra+Maintainer:		Wouter Swierstra <wss@cs.nott.ac.uk>+Synopsis:		Call AppleScript from Haskell.+Description:		This package enables you to compile and +			execute AppleScript from Haskell applications.+Category:		Foreign+Build-Depends:		base+Exposed-modules:	Foreign.AppleScript+Extra-source-files:	examples/HelloThere.hs+			, examples/OpenLocation.hs+			, examples/TextFields.hs+Include-Dirs: 		cbits+C-Sources: 		cbits/RunScript.c +Frameworks: 		Carbon+Ghc-Options: 		-ffi+Extensions: 		CPP, ForeignFunctionInterface+

@@ -0,0 +1,45 @@+-- | A module that enables you to compile and execute AppleScript.+module Foreign.AppleScript +  (+  appleScriptAvailable,+  execAppleScript+  ) +  where+import Data.Int+import Foreign.C.String+import System.Exit+import Control.Monad(liftM)+import Foreign+import Foreign.C++type OSStatus = Int32+data AEDesc = AEDesc++foreign import ccall "RunScript.h LowRunAppleScript" +  cLowRunAppleScript :: CString -> CLong -> Ptr AEDesc -> IO OSStatus++-- | The 'appleScriptAvailable' function checks whether or not AppleScript is+-- available on your platform.+foreign import ccall "RunScript.h AppleScriptAvailable" appleScriptAvailable :: IO Bool++-- | The 'execAppleScript' function will attempt to compile and+-- execute the AppleScript, described in the @String@ it receives as+-- its argument.  Any result of running the script is discarded. The+-- @ExitCode@ indicates whether or not any errors were encountered+-- during compilation or execution.+execAppleScript :: String -> IO ExitCode+execAppleScript script = do+  let run (cstr,len) = cLowRunAppleScript cstr (fromIntegral len) nullPtr+  osstatus <- withCStringLen script run+  return (fromOSStatus osstatus)++-- Not the world's finest functions...+noErr :: Int32+noErr = 0++fromOSStatus :: Int32 -> ExitCode+fromOSStatus n+  | n == noErr = ExitSuccess+  | otherwise  = ExitFailure (fromIntegral n)++

@@ -0,0 +1,32 @@+Copyright Wouter Swierstra 2006.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials+      provided with the distribution.++    * Neither the name of Wouter Swierstra nor the names of other+      contributors may be used to endorse or promote products+      derived from this software without specific prior written+      permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,74 @@+#include <Carbon/Carbon.h>++#include "RunScript.h"++#if ! TARGET_API_MAC_CARBON++#include <OSA.h>+#include <AppleScript.h>+#include <Gestalt.h>++#endif++#include <string.h>+++	/* AppleScriptAvailable returns true if AppleScript is available+	and the routines defined herein can be called. */+Boolean AppleScriptAvailable(void) {+	long response;+	if (Gestalt(gestaltAppleScriptAttr, &response) != noErr) response = 0; +	return ((response & (1<<gestaltAppleScriptPresent)) != 0);+}++	/* LowRunAppleScript compiles and runs an AppleScript+	provided as text in the buffer pointed to by text.  textLength+	bytes will be compiled from this buffer and run as an AppleScript+	using all of the default environment and execution settings.  If+	resultData is not NULL, then the result returned by the execution+	command will be returned as typeChar in this descriptor record+	(or typeNull if there is no result information).  If the function+	returns errOSAScriptError, then resultData will be set to a+	descriptive error message describing the error (if one is+	available).  */+OSStatus LowRunAppleScript(const void* text, long textLength, AEDesc *resultData) {+	ComponentInstance theComponent;+	AEDesc scriptTextDesc;+	OSStatus err;+	OSAID scriptID, resultID;+		/* set up locals to a known state */+	theComponent = NULL;+	AECreateDesc(typeNull, NULL, 0, &scriptTextDesc);+	scriptID = kOSANullScript;+	resultID = kOSANullScript;+		/* open the scripting component */+	theComponent = OpenDefaultComponent(kOSAComponentType,+					typeAppleScript);+	if (theComponent == NULL) { err = paramErr; goto bail; }+		/* put the script text into an aedesc */+	err = AECreateDesc(typeChar, text, textLength, &scriptTextDesc);+	if (err != noErr) goto bail;+		/* compile the script */+	err = OSACompile(theComponent, &scriptTextDesc, +					kOSAModeNull, &scriptID);+	if (err != noErr) goto bail;+		/* run the script/get the result */+	err = OSAExecute(theComponent, scriptID, kOSANullScript,+					kOSAModeNull, &resultID);+	if (resultData != NULL) {+		AECreateDesc(typeNull, NULL, 0, resultData);+		if (err == errOSAScriptError) {+			OSAScriptError(theComponent, kOSAErrorMessage,+						typeChar, resultData);+		} else if (err == noErr && resultID != kOSANullScript) {+			OSADisplay(theComponent, resultID, typeChar,+						kOSAModeNull, resultData);+		}+	}+bail:+	AEDisposeDesc(&scriptTextDesc);+	if (scriptID != kOSANullScript) OSADispose(theComponent,  scriptID);+	if (resultID != kOSANullScript) OSADispose(theComponent,  resultID);+	if (theComponent != NULL) CloseComponent(theComponent);+	return err;+}

@@ -0,0 +1,19 @@+import Foreign.AppleScript++-- Asks for your name and says hello++script nm = unlines $ +            [+            "tell application \"Finder\"",+            " delay 1",+            " set volume 4",+            " say \"Hello " ++ nm ++"\" using  \"Vicki\"",+            "end tell"+            ]+main = do+  putStrLn "What is your name?"+  nm <- getLine+  execAppleScript (script nm)+  ++  

@@ -0,0 +1,10 @@+import Foreign.AppleScript++-- open a location in the default webbrowser++main = do+  execAppleScript script++location = "http://www.cs.nott.ac.uk/~wss"++script = "open location " ++ show location

@@ -0,0 +1,14 @@+import Foreign.AppleScript++-- Opens a small dialog window with a text field++main = execAppleScript dialog++dialog = unlines $ +         [+         "tell application \"System Events\"",+         "display dialog \"What is your name?\" default answer \"\" buttons {\"OK\"} default button 1", +         "end tell"+         ] ++