# HG changeset patch
# User YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
# Date 1134179376 0
# Node ID 2efa50cbb7cd61e3c848f6b2339bce6dd2d9aa16
# Parent  9bf079216f0e67619f95d18735fc54b9c7151dcb
(Qundecoded_file_name): New variable.
(syms_of_mac): Initialize it.
(mac_aelist_to_lisp, mac_aedesc_to_lisp): New functions.
[TARGET_API_MAC_CARBON] (create_apple_event_from_event_ref): New
function.
(Fmac_coerce_ae_data): New defun.
(syms_of_mac): Defsubr it.

diff -r 9bf079216f0e -r 2efa50cbb7cd src/mac.c
--- a/src/mac.c	Sat Dec 10 01:49:24 2005 +0000
+++ b/src/mac.c	Sat Dec 10 01:49:36 2005 +0000
@@ -259,6 +259,216 @@
 
 
 /***********************************************************************
+		  Conversions on Apple event objects
+ ***********************************************************************/
+
+static Lisp_Object Qundecoded_file_name;
+
+static Lisp_Object
+mac_aelist_to_lisp (desc_list)
+     AEDescList *desc_list;
+{
+  OSErr err;
+  long count;
+  Lisp_Object result, elem;
+  DescType desc_type;
+  Size size;
+  AEKeyword keyword;
+  AEDesc desc;
+
+  err = AECountItems (desc_list, &count);
+  if (err != noErr)
+    return Qnil;
+  result = Qnil;
+  while (count > 0)
+    {
+      err = AESizeOfNthItem (desc_list, count, &desc_type, &size);
+      if (err == noErr)
+	switch (desc_type)
+	  {
+	  case typeAEList:
+	  case typeAERecord:
+	  case typeAppleEvent:
+	    err = AEGetNthDesc (desc_list, count, typeWildCard,
+				&keyword, &desc);
+	    if (err != noErr)
+	      break;
+	    elem = mac_aelist_to_lisp (&desc);
+	    AEDisposeDesc (&desc);
+	    break;
+
+	  default:
+	    if (desc_type == typeNull)
+	      elem = Qnil;
+	    else
+	      {
+		elem = make_uninit_string (size);
+		err = AEGetNthPtr (desc_list, count, typeWildCard, &keyword,
+				   &desc_type, SDATA (elem), size, &size);
+	      }
+	    if (err != noErr)
+	      break;
+	    desc_type = EndianU32_NtoB (desc_type);
+	    elem = Fcons (make_unibyte_string ((char *) &desc_type, 4), elem);
+	    break;
+	}
+
+      if (err != noErr)
+	elem = Qnil;
+      else if (desc_list->descriptorType != typeAEList)
+	{
+	  keyword = EndianU32_NtoB (keyword);
+	  elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem);
+	}
+
+      result = Fcons (elem, result);
+      count--;
+    }
+
+  desc_type = EndianU32_NtoB (desc_list->descriptorType);
+  return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
+}
+
+Lisp_Object
+mac_aedesc_to_lisp (desc)
+     AEDesc *desc;
+{
+  OSErr err;
+  DescType desc_type = desc->descriptorType;
+  Lisp_Object result;
+
+  switch (desc_type)
+    {
+    case typeNull:
+      result = Qnil;
+      break;
+
+    case typeAEList:
+    case typeAERecord:
+    case typeAppleEvent:
+      return mac_aelist_to_lisp (desc);
+#if 0
+      /* The following one is much simpler, but creates and disposes
+	 of Apple event descriptors many times.  */
+      {
+	long count;
+	Lisp_Object elem;
+	AEKeyword keyword;
+	AEDesc desc1;
+
+	err = AECountItems (desc, &count);
+	if (err != noErr)
+	  break;
+	result = Qnil;
+	while (count > 0)
+	  {
+	    err = AEGetNthDesc (desc, count, typeWildCard, &keyword, &desc1);
+	    if (err != noErr)
+	      break;
+	    elem = mac_aedesc_to_lisp (&desc1);
+	    AEDisposeDesc (&desc1);
+	    if (desc_type != typeAEList)
+	      {
+		keyword = EndianU32_NtoB (keyword);
+		elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem);
+	      }
+	    result = Fcons (elem, result);
+	    count--;
+	  }
+      }
+#endif
+      break;
+
+    default:
+#if TARGET_API_MAC_CARBON
+      result = make_uninit_string (AEGetDescDataSize (desc));
+      err = AEGetDescData (desc, SDATA (result), SBYTES (result));
+#else
+      result = make_uninit_string (GetHandleSize (desc->dataHandle));
+      memcpy (SDATA (result), *(desc->dataHandle), SBYTES (result));
+#endif
+      break;
+    }
+
+  if (err != noErr)
+    return Qnil;
+
+  desc_type = EndianU32_NtoB (desc_type);
+  return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
+}
+
+#if TARGET_API_MAC_CARBON
+OSErr
+create_apple_event_from_event_ref (event, num_params, names,
+				   types, sizes, result)
+     EventRef event;
+     UInt32 num_params;
+     EventParamName *names;
+     EventParamType *types;
+     UInt32 *sizes;
+     AppleEvent *result;
+{
+  OSErr err;
+  static const ProcessSerialNumber psn = {0, kCurrentProcess};
+  AEAddressDesc address_desc;
+  UInt32 i;
+  CFStringRef string;
+  CFDataRef data;
+  char *buf;
+
+  err = AECreateDesc (typeProcessSerialNumber, &psn,
+		      sizeof (ProcessSerialNumber), &address_desc);
+  if (err == noErr)
+    {
+      err = AECreateAppleEvent (0, 0, /* Dummy class and ID.   */
+				&address_desc, /* NULL is not allowed
+						  on Mac OS Classic. */
+				kAutoGenerateReturnID,
+				kAnyTransactionID, result);
+      AEDisposeDesc (&address_desc);
+    }
+  if (err != noErr)
+    return err;
+
+  for (i = 0; i < num_params; i++)
+    switch (types[i])
+      {
+#ifdef MAC_OSX
+      case typeCFStringRef:
+	err = GetEventParameter (event, names[i], typeCFStringRef, NULL,
+				 sizeof (CFStringRef), NULL, &string);
+	if (err != noErr)
+	  break;
+	data = CFStringCreateExternalRepresentation (NULL, string,
+						     kCFStringEncodingUTF8,
+						     '?');
+	if (data == NULL)
+	  break;
+	/* typeUTF8Text is not available on Mac OS X 10.1.  */
+	AEPutParamPtr (result, names[i], 'utf8',
+		       CFDataGetBytePtr (data), CFDataGetLength (data));
+	CFRelease (data);
+	break;
+#endif
+
+      default:
+	buf = xmalloc (sizes[i]);
+	if (buf == NULL)
+	  break;
+	err = GetEventParameter (event, names[i], types[i], NULL,
+				 sizes[i], NULL, buf);
+	if (err == noErr)
+	  AEPutParamPtr (result, names[i], types[i], buf, sizes[i]);
+	xfree (buf);
+	break;
+      }
+
+  return noErr;
+}
+#endif
+
+
+/***********************************************************************
 	 Conversion between Lisp and Core Foundation objects
  ***********************************************************************/
 
@@ -3887,6 +4097,116 @@
 }
 
 
+DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data, Smac_coerce_ae_data, 3, 3, 0,
+       doc: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
+Each type should be a string of length 4 or the symbol
+`undecoded-file-name'.  */)
+  (src_type, src_data, dst_type)
+     Lisp_Object src_type, src_data, dst_type;
+{
+  OSErr err;
+  Lisp_Object result = Qnil;
+  DescType src_desc_type, dst_desc_type;
+  AEDesc dst_desc;
+#ifdef MAC_OSX
+  FSRef fref;
+#else
+  FSSpec fs;
+#endif
+
+  CHECK_STRING (src_data);
+  if (EQ (src_type, Qundecoded_file_name))
+    {
+#ifdef MAC_OSX
+      src_desc_type = typeFileURL;
+#else
+      src_desc_type = typeFSS;
+#endif
+    }
+  else
+    src_desc_type = mac_get_code_from_arg (src_type, 0);
+
+  if (EQ (dst_type, Qundecoded_file_name))
+    {
+#ifdef MAC_OSX
+    dst_desc_type = typeFSRef;
+#else
+    dst_desc_type = typeFSS;
+#endif
+    }
+  else
+    dst_desc_type = mac_get_code_from_arg (dst_type, 0);
+
+  BLOCK_INPUT;
+  if (EQ (src_type, Qundecoded_file_name))
+    {
+#ifdef MAC_OSX
+      CFStringRef str;
+      CFURLRef url = NULL;
+      CFDataRef data = NULL;
+
+      str = cfstring_create_with_utf8_cstring (SDATA (src_data));
+      if (str)
+	{
+	  url = CFURLCreateWithFileSystemPath (NULL, str,
+					       kCFURLPOSIXPathStyle, false);
+	  CFRelease (str);
+	}
+      if (url)
+	{
+	  data = CFURLCreateData (NULL, url, kCFStringEncodingUTF8, true);
+	  CFRelease (url);
+	}
+      if (data)
+	err = AECoercePtr (src_desc_type, CFDataGetBytePtr (data),
+			   CFDataGetLength (data),
+			   dst_desc_type, &dst_desc);
+      else
+	err = memFullErr;
+#else
+      err = posix_pathname_to_fsspec (SDATA (src_data), &fs);
+      if (err == noErr)
+	AECoercePtr (src_desc_type, &fs, sizeof (FSSpec),
+		     dst_desc_type, &dst_desc);
+#endif
+    }
+  else
+    err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data),
+		       dst_desc_type, &dst_desc);
+
+  if (err == noErr)
+    {
+      if (EQ (dst_type, Qundecoded_file_name))
+	{
+	  char file_name[MAXPATHLEN];
+
+#ifdef MAC_OSX
+	  err = AEGetDescData (&dst_desc, &fref, sizeof (FSRef));
+	  if (err == noErr)
+	    err = FSRefMakePath (&fref, file_name, sizeof (file_name));
+#else
+#if TARGET_API_MAC_CARBON
+	  err = AEGetDescData (&dst_desc, &fs, sizeof (FSSpec));
+#else
+	  memcpy (&fs, *(dst_desc.dataHandle), sizeof (FSSpec));
+#endif
+	  if (err == noErr)
+	    err = fsspec_to_posix_pathname (&fs, file_name,
+					    sizeof (file_name) - 1);
+#endif
+	  if (err == noErr)
+	    result = make_unibyte_string (file_name, strlen (file_name));
+	}
+      else
+	result = Fcdr (mac_aedesc_to_lisp (&dst_desc));
+      AEDisposeDesc (&dst_desc);
+    }
+  UNBLOCK_INPUT;
+
+  return result;
+}
+
+
 #if TARGET_API_MAC_CARBON
 static Lisp_Object Qxml, Qmime_charset;
 static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
@@ -4676,6 +4996,9 @@
 void
 syms_of_mac ()
 {
+  Qundecoded_file_name = intern ("undecoded-file-name");
+  staticpro (&Qundecoded_file_name);
+
 #if TARGET_API_MAC_CARBON
   Qstring  = intern ("string");		staticpro (&Qstring);
   Qnumber  = intern ("number");		staticpro (&Qnumber);
@@ -4699,6 +5022,7 @@
   QHFS_plus_C = intern ("HFS+C");	staticpro (&QHFS_plus_C);
 #endif
 
+  defsubr (&Smac_coerce_ae_data);
 #if TARGET_API_MAC_CARBON
   defsubr (&Smac_get_preference);
   defsubr (&Smac_code_convert_string);