[MAC_OS] (XPutPixel, XGetPixel)
[bpt/emacs.git] / src / mac.c
index 0a1b94e..40bbacf 100644 (file)
--- a/src/mac.c
+++ b/src/mac.c
@@ -1,5 +1,6 @@
 /* Unix emulation routines for GNU Emacs on the Mac OS.
 /* Unix emulation routines for GNU Emacs on the Mac OS.
-   Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 
@@ -15,8 +16,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 /* Contributed by Andrew Choi (akochoi@mac.com).  */
 
 
 /* Contributed by Andrew Choi (akochoi@mac.com).  */
 
@@ -24,20 +25,19 @@ Boston, MA 02111-1307, USA.  */
 
 #include <stdio.h>
 #include <errno.h>
 
 #include <stdio.h>
 #include <errno.h>
-#include <time.h>
 
 #include "lisp.h"
 #include "process.h"
 
 #include "lisp.h"
 #include "process.h"
-#include "sysselect.h"
+#undef init_process
 #include "systime.h"
 #include "systime.h"
+#include "sysselect.h"
 #include "blockinput.h"
 
 #include "macterm.h"
 
 #include "blockinput.h"
 
 #include "macterm.h"
 
-#if TARGET_API_MAC_CARBON
 #include "charset.h"
 #include "coding.h"
 #include "charset.h"
 #include "coding.h"
-#else  /* not TARGET_API_MAC_CARBON */
+#if !TARGET_API_MAC_CARBON
 #include <Files.h>
 #include <MacTypes.h>
 #include <TextUtils.h>
 #include <Files.h>
 #include <MacTypes.h>
 #include <TextUtils.h>
@@ -53,17 +53,16 @@ Boston, MA 02111-1307, USA.  */
 #include <Processes.h>
 #include <EPPC.h>
 #include <MacLocales.h>
 #include <Processes.h>
 #include <EPPC.h>
 #include <MacLocales.h>
+#include <Endian.h>
 #endif /* not TARGET_API_MAC_CARBON */
 
 #include <utime.h>
 #include <dirent.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 #endif /* not TARGET_API_MAC_CARBON */
 
 #include <utime.h>
 #include <dirent.h>
 #include <sys/types.h>
 #include <sys/stat.h>
-#include <string.h>
 #include <pwd.h>
 #include <grp.h>
 #include <sys/param.h>
 #include <pwd.h>
 #include <grp.h>
 #include <sys/param.h>
-#include <stdlib.h>
 #include <fcntl.h>
 #if __MWERKS__
 #include <unistd.h>
 #include <fcntl.h>
 #if __MWERKS__
 #include <unistd.h>
@@ -80,6 +79,8 @@ static ComponentInstance as_scripting_component;
 /* The single script context used for all script executions.  */
 static OSAID as_script_context;
 
 /* The single script context used for all script executions.  */
 static OSAID as_script_context;
 
+static OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *));
+static OSErr fsspec_to_posix_pathname P_ ((const FSSpec *, char *, int));
 
 /* When converting from Mac to Unix pathnames, /'s in folder names are
    converted to :'s.  This function, used in copying folder names,
 
 /* When converting from Mac to Unix pathnames, /'s in folder names are
    converted to :'s.  This function, used in copying folder names,
@@ -259,6 +260,448 @@ posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen)
 }
 
 \f
 }
 
 \f
+/***********************************************************************
+                 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 = noErr;
+  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);
+}
+
+static pascal OSErr
+mac_coerce_file_name_ptr (type_code, data_ptr, data_size,
+                         to_type, handler_refcon, result)
+     DescType type_code;
+     const void *data_ptr;
+     Size data_size;
+     DescType to_type;
+     long handler_refcon;
+     AEDesc *result;
+{
+  OSErr err;
+
+  if (type_code == typeNull)
+    err = errAECoercionFail;
+  else if (type_code == to_type || to_type == typeWildCard)
+    err = AECreateDesc (TYPE_FILE_NAME, data_ptr, data_size, result);
+  else if (type_code == TYPE_FILE_NAME)
+    /* Coercion from undecoded file name.  */
+    {
+#ifdef MAC_OSX
+      CFStringRef str;
+      CFURLRef url = NULL;
+      CFDataRef data = NULL;
+
+      str = CFStringCreateWithBytes (NULL, data_ptr, data_size,
+                                    kCFStringEncodingUTF8, false);
+      if (str)
+       {
+         url = CFURLCreateWithFileSystemPath (NULL, str,
+                                              kCFURLPOSIXPathStyle, false);
+         CFRelease (str);
+       }
+      if (url)
+       {
+         data = CFURLCreateData (NULL, url, kCFStringEncodingUTF8, true);
+         CFRelease (url);
+       }
+      if (data)
+       {
+         err = AECoercePtr (typeFileURL, CFDataGetBytePtr (data),
+                            CFDataGetLength (data), to_type, result);
+         CFRelease (data);
+       }
+      else
+       err = memFullErr;
+#else
+      FSSpec fs;
+      char *buf;
+
+      buf = xmalloc (data_size + 1);
+      if (buf)
+       {
+         memcpy (buf, data_ptr, data_size);
+         buf[data_size] = '\0';
+         err = posix_pathname_to_fsspec (buf, &fs);
+         xfree (buf);
+       }
+      else
+       err = memFullErr;
+      if (err == noErr)
+       err = AECoercePtr (typeFSS, &fs, sizeof (FSSpec), to_type, result);
+#endif
+    }
+  else if (to_type == TYPE_FILE_NAME)
+    /* Coercion to undecoded file name.  */
+    {
+#ifdef MAC_OSX
+      CFURLRef url = NULL;
+      CFStringRef str = NULL;
+      CFDataRef data = NULL;
+
+      if (type_code == typeFileURL)
+       url = CFURLCreateWithBytes (NULL, data_ptr, data_size,
+                                   kCFStringEncodingUTF8, NULL);
+      else
+       {
+         AEDesc desc;
+         Size size;
+         char *buf;
+
+         err = AECoercePtr (type_code, data_ptr, data_size,
+                            typeFileURL, &desc);
+         if (err == noErr)
+           {
+             size = AEGetDescDataSize (&desc);
+             buf = xmalloc (size);
+             if (buf)
+               {
+                 err = AEGetDescData (&desc, buf, size);
+                 if (err == noErr)
+                   url = CFURLCreateWithBytes (NULL, buf, size,
+                                               kCFStringEncodingUTF8, NULL);
+                 xfree (buf);
+               }
+             AEDisposeDesc (&desc);
+           }
+       }
+      if (url)
+       {
+         str = CFURLCopyFileSystemPath (url, kCFURLPOSIXPathStyle);
+         CFRelease (url);
+       }
+      if (str)
+       {
+         data = CFStringCreateExternalRepresentation (NULL, str,
+                                                      kCFStringEncodingUTF8,
+                                                      '\0');
+         CFRelease (str);
+       }
+      if (data)
+       {
+         err = AECreateDesc (TYPE_FILE_NAME, CFDataGetBytePtr (data),
+                             CFDataGetLength (data), result);
+         CFRelease (data);
+       }
+#else
+      char file_name[MAXPATHLEN];
+
+      if (type_code == typeFSS && data_size == sizeof (FSSpec))
+       err = fsspec_to_posix_pathname (data_ptr, file_name,
+                                       sizeof (file_name) - 1);
+      else
+       {
+         AEDesc desc;
+         FSSpec fs;
+
+         err = AECoercePtr (type_code, data_ptr, data_size, typeFSS, &desc);
+         if (err == noErr)
+           {
+#if TARGET_API_MAC_CARBON
+             err = AEGetDescData (&desc, &fs, sizeof (FSSpec));
+#else
+             fs = *(FSSpec *)(*(desc.dataHandle));
+#endif
+             if (err == noErr)
+               err = fsspec_to_posix_pathname (&fs, file_name,
+                                               sizeof (file_name) - 1);
+             AEDisposeDesc (&desc);
+           }
+       }
+      if (err == noErr)
+       err = AECreateDesc (TYPE_FILE_NAME, file_name,
+                           strlen (file_name), result);
+#endif
+    }
+  else
+    abort ();
+
+  if (err != noErr)
+    return errAECoercionFail;
+  return noErr;
+}
+
+static pascal OSErr
+mac_coerce_file_name_desc (from_desc, to_type, handler_refcon, result)
+     const AEDesc *from_desc;
+     DescType to_type;
+     long handler_refcon;
+     AEDesc *result;
+{
+  OSErr err = noErr;
+  DescType from_type = from_desc->descriptorType;
+
+  if (from_type == typeNull)
+    err = errAECoercionFail;
+  else if (from_type == to_type || to_type == typeWildCard)
+    err = AEDuplicateDesc (from_desc, result);
+  else
+    {
+      char *data_ptr;
+      Size data_size;
+
+#if TARGET_API_MAC_CARBON
+      data_size = AEGetDescDataSize (from_desc);
+#else
+      data_size = GetHandleSize (from_desc->dataHandle);
+#endif
+      data_ptr = xmalloc (data_size);
+      if (data_ptr)
+       {
+#if TARGET_API_MAC_CARBON
+         err = AEGetDescData (from_desc, data_ptr, data_size);
+#else
+         memcpy (data_ptr, *(from_desc->dataHandle), data_size);
+#endif
+         if (err == noErr)
+           err = mac_coerce_file_name_ptr (from_type, data_ptr,
+                                           data_size, to_type,
+                                           handler_refcon, result);
+         xfree (data_ptr);
+       }
+      else
+       err = memFullErr;
+    }
+
+  if (err != noErr)
+    return errAECoercionFail;
+  return noErr;
+}
+
+OSErr
+init_coercion_handler ()
+{
+  OSErr err;
+
+  static AECoercePtrUPP coerce_file_name_ptrUPP = NULL;
+  static AECoerceDescUPP coerce_file_name_descUPP = NULL;
+
+  if (coerce_file_name_ptrUPP == NULL)
+    {
+      coerce_file_name_ptrUPP = NewAECoercePtrUPP (mac_coerce_file_name_ptr);
+      coerce_file_name_descUPP = NewAECoerceDescUPP (mac_coerce_file_name_desc);
+    }
+
+  err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
+                                 (AECoercionHandlerUPP)
+                                 coerce_file_name_ptrUPP, 0, false, false);
+  if (err == noErr)
+    err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
+                                   (AECoercionHandlerUPP)
+                                   coerce_file_name_ptrUPP, 0, false, false);
+  if (err == noErr)
+    err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
+                                   coerce_file_name_descUPP, 0, true, false);
+  if (err == noErr)
+    err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
+                                   coerce_file_name_descUPP, 0, true, false);
+  return err;
+}
+
+#if TARGET_API_MAC_CARBON
+OSErr
+create_apple_event_from_event_ref (event, num_params, names, types, result)
+     EventRef event;
+     UInt32 num_params;
+     EventParamName *names;
+     EventParamType *types;
+     AppleEvent *result;
+{
+  OSErr err;
+  static const ProcessSerialNumber psn = {0, kCurrentProcess};
+  AEAddressDesc address_desc;
+  UInt32 i, size;
+  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:
+       err = GetEventParameter (event, names[i], types[i], NULL,
+                                0, &size, NULL);
+       if (err != noErr)
+         break;
+       buf = xmalloc (size);
+       if (buf == NULL)
+         break;
+       err = GetEventParameter (event, names[i], types[i], NULL,
+                                size, NULL, buf);
+       if (err == noErr)
+         AEPutParamPtr (result, names[i], types[i], buf, size);
+       xfree (buf);
+       break;
+      }
+
+  return noErr;
+}
+#endif
+
+\f
 /***********************************************************************
         Conversion between Lisp and Core Foundation objects
  ***********************************************************************/
 /***********************************************************************
         Conversion between Lisp and Core Foundation objects
  ***********************************************************************/
@@ -266,7 +709,6 @@ posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen)
 #if TARGET_API_MAC_CARBON
 static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
 static Lisp_Object Qarray, Qdictionary;
 #if TARGET_API_MAC_CARBON
 static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
 static Lisp_Object Qarray, Qdictionary;
-#define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
 
 struct cfdict_context
 {
 
 struct cfdict_context
 {
@@ -337,12 +779,11 @@ cfdata_to_lisp (data)
 }
 
 
 }
 
 
-/* From CFString to a lisp string.  Never returns a unibyte string
-   (even if it only contains ASCII characters).
-   This may cause GC during code conversion. */
+/* From CFString to a lisp string.  Returns a unibyte string
+   containing a UTF-8 byte sequence.  */
 
 Lisp_Object
 
 Lisp_Object
-cfstring_to_lisp (string)
+cfstring_to_lisp_nodecode (string)
      CFStringRef string;
 {
   Lisp_Object result = Qnil;
      CFStringRef string;
 {
   Lisp_Object result = Qnil;
@@ -363,9 +804,23 @@ cfstring_to_lisp (string)
        }
     }
 
        }
     }
 
+  return result;
+}
+
+
+/* From CFString to a lisp string.  Never returns a unibyte string
+   (even if it only contains ASCII characters).
+   This may cause GC during code conversion. */
+
+Lisp_Object
+cfstring_to_lisp (string)
+     CFStringRef string;
+{
+  Lisp_Object result = cfstring_to_lisp_nodecode (string);
+
   if (!NILP (result))
     {
   if (!NILP (result))
     {
-      result = DECODE_UTF_8 (result);
+      result = code_convert_string_norecord (result, Qutf_8, 0);
       /* This may be superfluous.  Just to make sure that the result
         is a multibyte string.  */
       result = string_to_multibyte (result);
       /* This may be superfluous.  Just to make sure that the result
         is a multibyte string.  */
       result = string_to_multibyte (result);
@@ -855,9 +1310,14 @@ parse_resource_line (p)
    implemented as a hash table that maps a pair (SRC-NODE-ID .
    EDGE-LABEL) to DEST-NODE-ID.  It also holds a maximum node id used
    in the table as a value for HASHKEY_MAX_NID.  A value associated to
    implemented as a hash table that maps a pair (SRC-NODE-ID .
    EDGE-LABEL) to DEST-NODE-ID.  It also holds a maximum node id used
    in the table as a value for HASHKEY_MAX_NID.  A value associated to
-   a node is recorded as a value for the node id.  */
+   a node is recorded as a value for the node id.
+
+   A database also has a cache for past queries as a value for
+   HASHKEY_QUERY_CACHE.  It is another hash table that maps
+   "NAME-STRING\0CLASS-STRING" to the result of the query.  */
 
 #define HASHKEY_MAX_NID (make_number (0))
 
 #define HASHKEY_MAX_NID (make_number (0))
+#define HASHKEY_QUERY_CACHE (make_number (-1))
 
 static XrmDatabase
 xrm_create_database ()
 
 static XrmDatabase
 xrm_create_database ()
@@ -869,6 +1329,7 @@ xrm_create_database ()
                              make_float (DEFAULT_REHASH_THRESHOLD),
                              Qnil, Qnil, Qnil);
   Fputhash (HASHKEY_MAX_NID, make_number (0), database);
                              make_float (DEFAULT_REHASH_THRESHOLD),
                              Qnil, Qnil, Qnil);
   Fputhash (HASHKEY_MAX_NID, make_number (0), database);
+  Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
 
   return database;
 }
 
   return database;
 }
@@ -902,6 +1363,7 @@ xrm_q_put_resource (database, quarks, value)
   Fputhash (node_id, value, database);
 
   Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
   Fputhash (node_id, value, database);
 
   Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
+  Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
 }
 
 /* Merge multiple resource entries specified by DATA into a resource
 }
 
 /* Merge multiple resource entries specified by DATA into a resource
@@ -990,8 +1452,30 @@ xrm_get_resource (database, name, class)
      XrmDatabase database;
      char *name, *class;
 {
      XrmDatabase database;
      char *name, *class;
 {
-  Lisp_Object quark_name, quark_class, tmp;
-  int nn, nc;
+  Lisp_Object key, query_cache, quark_name, quark_class, tmp;
+  int i, nn, nc;
+  struct Lisp_Hash_Table *h;
+  unsigned hash_code;
+
+  nn = strlen (name);
+  nc = strlen (class);
+  key = make_uninit_string (nn + nc + 1);
+  strcpy (SDATA (key), name);
+  strncpy (SDATA (key) + nn + 1, class, nc);
+
+  query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil);
+  if (NILP (query_cache))
+    {
+      query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+                                    make_float (DEFAULT_REHASH_SIZE),
+                                    make_float (DEFAULT_REHASH_THRESHOLD),
+                                    Qnil, Qnil, Qnil);
+      Fputhash (HASHKEY_QUERY_CACHE, query_cache, database);
+    }
+  h = XHASH_TABLE (query_cache);
+  i = hash_lookup (h, key, &hash_code);
+  if (i >= 0)
+    return HASH_VALUE (h, i);
 
   quark_name = parse_resource_name (&name);
   if (*name != '\0')
 
   quark_name = parse_resource_name (&name);
   if (*name != '\0')
@@ -1010,7 +1494,11 @@ xrm_get_resource (database, name, class)
   if (nn != nc)
     return Qnil;
   else
   if (nn != nc)
     return Qnil;
   else
-    return xrm_q_get_resource (database, quark_name, quark_class);
+    {
+      tmp = xrm_q_get_resource (database, quark_name, quark_class);
+      hash_put (h, key, tmp, hash_code);
+      return tmp;
+    }
 }
 
 #if TARGET_API_MAC_CARBON
 }
 
 #if TARGET_API_MAC_CARBON
@@ -1021,7 +1509,7 @@ xrm_cfproperty_list_to_value (plist)
   CFTypeID type_id = CFGetTypeID (plist);
 
   if (type_id == CFStringGetTypeID ())
   CFTypeID type_id = CFGetTypeID (plist);
 
   if (type_id == CFStringGetTypeID ())
-      return cfstring_to_lisp (plist);
+    return cfstring_to_lisp (plist);
   else if (type_id == CFNumberGetTypeID ())
     {
       CFStringRef string;
   else if (type_id == CFNumberGetTypeID ())
     {
       CFStringRef string;
@@ -1109,7 +1597,7 @@ xrm_get_preference_database (application)
   CFSetGetValues (key_set, (const void **)keys);
   for (index = 0; index < count; index++)
     {
   CFSetGetValues (key_set, (const void **)keys);
   for (index = 0; index < count; index++)
     {
-      res_name = SDATA (cfstring_to_lisp (keys[index]));
+      res_name = SDATA (cfstring_to_lisp_nodecode (keys[index]));
       quarks = parse_resource_name (&res_name);
       if (!(NILP (quarks) || *res_name))
        {
       quarks = parse_resource_name (&res_name);
       if (!(NILP (quarks) || *res_name))
        {
@@ -1672,37 +2160,7 @@ sys_fopen (const char *name, const char *mode)
 }
 
 
 }
 
 
-long target_ticks = 0;
-
-#ifdef __MRC__
-__sigfun alarm_signal_func = (__sigfun) 0;
-#elif __MWERKS__
-__signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0;
-#else /* not __MRC__ and not __MWERKS__ */
-You lose!!!
-#endif /* not __MRC__ and not __MWERKS__ */
-
-
-/* These functions simulate SIG_ALRM.  The stub for function signal
-   stores the signal handler function in alarm_signal_func if a
-   SIG_ALRM is encountered.  check_alarm is called in XTread_socket,
-   which emacs calls periodically.  A pending alarm is represented by
-   a non-zero target_ticks value.  check_alarm calls the handler
-   function pointed to by alarm_signal_func if one has been set up and
-   an alarm is pending.  */
-
-void
-check_alarm ()
-{
-  if (target_ticks && TickCount () > target_ticks)
-    {
-      target_ticks = 0;
-      if (alarm_signal_func)
-       (*alarm_signal_func)(SIGALRM);
-    }
-}
-
-
+#include "keyboard.h"
 extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
 
 int
 extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
 
 int
@@ -1713,25 +2171,17 @@ select (n,  rfds, wfds, efds, timeout)
   SELECT_TYPE *efds;
   struct timeval *timeout;
 {
   SELECT_TYPE *efds;
   struct timeval *timeout;
 {
-#if TARGET_API_MAC_CARBON
   OSErr err;
   OSErr err;
+#if TARGET_API_MAC_CARBON
   EventTimeout timeout_sec =
     (timeout
      ? (EMACS_SECS (*timeout) * kEventDurationSecond
        + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
      : kEventDurationForever);
 
   EventTimeout timeout_sec =
     (timeout
      ? (EMACS_SECS (*timeout) * kEventDurationSecond
        + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
      : kEventDurationForever);
 
-  if (FD_ISSET (0, rfds))
-    {
-      BLOCK_INPUT;
-      err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL);
-      UNBLOCK_INPUT;
-      if (err == noErr)
-       return 1;
-      else
-       FD_ZERO (rfds);
-    }
-  return 0;
+  BLOCK_INPUT;
+  err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL);
+  UNBLOCK_INPUT;
 #else /* not TARGET_API_MAC_CARBON */
   EventRecord e;
   UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
 #else /* not TARGET_API_MAC_CARBON */
   EventRecord e;
   UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
@@ -1746,47 +2196,62 @@ select (n,  rfds, wfds, efds, timeout)
      read_avail_input which in turn calls XTread_socket to poll for
      these events.  Otherwise these never get processed except but a
      very slow poll timer.  */
      read_avail_input which in turn calls XTread_socket to poll for
      these events.  Otherwise these never get processed except but a
      very slow poll timer.  */
-  if (FD_ISSET (0, rfds) && mac_wait_next_event (&e, sleep_time, false))
-    return 1;
-
-  return 0;
+  if (mac_wait_next_event (&e, sleep_time, false))
+    err = noErr;
+  else
+    err = -9875;               /* eventLoopTimedOutErr */
 #endif /* not TARGET_API_MAC_CARBON */
 #endif /* not TARGET_API_MAC_CARBON */
-}
-
-
-/* Called in sys_select to wait for an alarm signal to arrive.  */
-
-int
-pause ()
-{
-  EventRecord e;
-  unsigned long tick;
-
-  if (!target_ticks)  /* no alarm pending */
-    return -1;
 
 
-  if ((tick = TickCount ()) < target_ticks)
-    WaitNextEvent (0, &e, target_ticks - tick, NULL); /* Accept no event;
-                                                        just wait. by T.I. */
+  if (FD_ISSET (0, rfds))
+    if (err == noErr)
+      return 1;
+    else
+      {
+       FD_ZERO (rfds);
+       return 0;
+      }
+  else
+    if (err == noErr)
+      {
+       if (input_polling_used ())
+         {
+           /* It could be confusing if a real alarm arrives while
+              processing the fake one.  Turn it off and let the
+              handler reset it.  */
+           extern void poll_for_input_1 P_ ((void));
+           int old_poll_suppress_count = poll_suppress_count;
+           poll_suppress_count = 1;
+           poll_for_input_1 ();
+           poll_suppress_count = old_poll_suppress_count;
+         }
+       errno = EINTR;
+       return -1;
+      }
+    else
+      return 0;
+}
 
 
-  target_ticks = 0;
-  if (alarm_signal_func)
-    (*alarm_signal_func)(SIGALRM);
 
 
-  return 0;
-}
+/* Simulation of SIGALRM.  The stub for function signal stores the
+   signal handler function in alarm_signal_func if a SIGALRM is
+   encountered.  */
 
 
+#include <signal.h>
+#include "syssignal.h"
 
 
-int
-alarm (int seconds)
-{
-  long remaining = target_ticks ? (TickCount () - target_ticks) / 60 : 0;
+static TMTask mac_atimer_task;
 
 
-  target_ticks = seconds ? TickCount () + 60 * seconds : 0;
+static QElemPtr mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
 
 
-  return (remaining < 0) ? 0 : (unsigned int) remaining;
-}
+static int signal_mask = 0;
 
 
+#ifdef __MRC__
+__sigfun alarm_signal_func = (__sigfun) 0;
+#elif __MWERKS__
+__signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0;
+#else /* not __MRC__ and not __MWERKS__ */
+You lose!!!
+#endif /* not __MRC__ and not __MWERKS__ */
 
 #undef signal
 #ifdef __MRC__
 
 #undef signal
 #ifdef __MRC__
@@ -1819,6 +2284,128 @@ sys_signal (int signal_num, __signal_func_ptr signal_func)
 }
 
 
 }
 
 
+static pascal void
+mac_atimer_handler (qlink)
+     TMTaskPtr qlink;
+{
+  if (alarm_signal_func)
+    (alarm_signal_func) (SIGALRM);
+}
+
+
+static void
+set_mac_atimer (count)
+     long count;
+{
+  static TimerUPP mac_atimer_handlerUPP = NULL;
+
+  if (mac_atimer_handlerUPP == NULL)
+    mac_atimer_handlerUPP = NewTimerUPP (mac_atimer_handler);
+  mac_atimer_task.tmCount = 0;
+  mac_atimer_task.tmAddr = mac_atimer_handlerUPP;
+  mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
+  InsTime (mac_atimer_qlink);
+  if (count)
+    PrimeTime (mac_atimer_qlink, count);
+}
+
+
+int
+remove_mac_atimer (remaining_count)
+     long *remaining_count;
+{
+  if (mac_atimer_qlink)
+    {
+      RmvTime (mac_atimer_qlink);
+      if (remaining_count)
+       *remaining_count = mac_atimer_task.tmCount;
+      mac_atimer_qlink = NULL;
+
+      return 0;
+    }
+  else
+    return -1;
+}
+
+
+int
+sigblock (int mask)
+{
+  int old_mask = signal_mask;
+
+  signal_mask |= mask;
+
+  if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
+    remove_mac_atimer (NULL);
+
+  return old_mask;
+}
+
+
+int
+sigsetmask (int mask)
+{
+  int old_mask = signal_mask;
+
+  signal_mask = mask;
+
+  if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
+    if (signal_mask & sigmask (SIGALRM))
+      remove_mac_atimer (NULL);
+    else
+      set_mac_atimer (mac_atimer_task.tmCount);
+
+  return old_mask;
+}
+
+
+int
+alarm (int seconds)
+{
+  long remaining_count;
+
+  if (remove_mac_atimer (&remaining_count) == 0)
+    {
+      set_mac_atimer (seconds * 1000);
+
+      return remaining_count / 1000;
+    }
+  else
+    {
+      mac_atimer_task.tmCount = seconds * 1000;
+
+      return 0;
+    }
+}
+
+
+int
+setitimer (which, value, ovalue)
+     int which;
+     const struct itimerval *value;
+     struct itimerval *ovalue;
+{
+  long remaining_count;
+  long count = (EMACS_SECS (value->it_value) * 1000
+               + (EMACS_USECS (value->it_value) + 999) / 1000);
+
+  if (remove_mac_atimer (&remaining_count) == 0)
+    {
+      if (ovalue)
+       {
+         bzero (ovalue, sizeof (*ovalue));
+         EMACS_SET_SECS_USECS (ovalue->it_value, remaining_count / 1000,
+                               (remaining_count % 1000) * 1000);
+       }
+      set_mac_atimer (count);
+    }
+  else
+    mac_atimer_task.tmCount = count;
+
+  return 0;
+}
+
+
 /* gettimeofday should return the amount of time (in a timeval
    structure) since midnight today.  The toolbox function Microseconds
    returns the number of microseconds (in a UnsignedWide value) since
 /* gettimeofday should return the amount of time (in a timeval
    structure) since midnight today.  The toolbox function Microseconds
    returns the number of microseconds (in a UnsignedWide value) since
@@ -1946,35 +2533,6 @@ sys_time (time_t *timer)
 }
 
 
 }
 
 
-/* MPW strftime broken for "%p" format */
-#ifdef __MRC__
-#undef strftime
-#include <time.h>
-size_t
-sys_strftime (char * s, size_t maxsize, const char * format,
-             const struct tm * timeptr)
-{
-  if (strcmp (format, "%p") == 0)
-    {
-      if (maxsize < 3)
-        return 0;
-      if (timeptr->tm_hour < 12)
-        {
-          strcpy (s, "AM");
-          return 2;
-        }
-      else
-        {
-          strcpy (s, "PM");
-          return 2;
-        }
-    }
-  else
-    return strftime (s, maxsize, format, timeptr);
-}
-#endif  /* __MRC__ */
-
-
 /* no subprocesses, empty wait */
 
 int
 /* no subprocesses, empty wait */
 
 int
@@ -1992,13 +2550,6 @@ croak (char *badfunc)
 }
 
 
 }
 
 
-char *
-index (const char * str, int chr)
-{
-  return strchr (str, chr);
-}
-
-
 char *
 mktemp (char *template)
 {
 char *
 mktemp (char *template)
 {
@@ -2187,20 +2738,6 @@ sys_subshell ()
 }
 
 
 }
 
 
-int
-sigsetmask (int x)
-{
-  return 0;
-}
-
-
-int
-sigblock (int mask)
-{
-  return 0;
-}
-
-
 void
 request_sigio (void)
 {
 void
 request_sigio (void)
 {
@@ -2297,7 +2834,7 @@ path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num,
 }
 
 
 }
 
 
-OSErr
+static OSErr
 posix_pathname_to_fsspec (ufn, fs)
      const char *ufn;
      FSSpec *fs;
 posix_pathname_to_fsspec (ufn, fs)
      const char *ufn;
      FSSpec *fs;
@@ -2313,7 +2850,7 @@ posix_pathname_to_fsspec (ufn, fs)
     }
 }
 
     }
 }
 
-OSErr
+static OSErr
 fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
      const FSSpec *fs;
      char *ufn;
 fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
      const FSSpec *fs;
      char *ufn;
@@ -2422,18 +2959,34 @@ find_true_pathname (const char *path, char *buf, int bufsiz)
 }
 
 
 }
 
 
-mode_t
-umask (mode_t numask)
+mode_t
+umask (mode_t numask)
+{
+  static mode_t mask = 022;
+  mode_t oldmask = mask;
+  mask = numask;
+  return oldmask;
+}
+
+
+int
+chmod (const char *path, mode_t mode)
+{
+  /* say it always succeed for now */
+  return 0;
+}
+
+
+int
+fchmod (int fd, mode_t mode)
 {
 {
-  static mode_t mask = 022;
-  mode_t oldmask = mask;
-  mask = numask;
-  return oldmask;
+  /* say it always succeed for now */
+  return 0;
 }
 
 
 int
 }
 
 
 int
-chmod (const char *path, mode_t mode)
+fchown (int fd, uid_t owner, gid_t group)
 {
   /* say it always succeed for now */
   return 0;
 {
   /* say it always succeed for now */
   return 0;
@@ -2870,7 +3423,10 @@ mystrcpy (char *to, char *from)
    wildcard filename expansion.  Since we don't really have a shell on
    the Mac, this case is detected and the starting of the shell is
    by-passed.  We really need to add code here to do filename
    wildcard filename expansion.  Since we don't really have a shell on
    the Mac, this case is detected and the starting of the shell is
    by-passed.  We really need to add code here to do filename
-   expansion to support such functionality. */
+   expansion to support such functionality.
+
+   We can't use this strategy in Carbon because the High Level Event
+   APIs are not available.  */
 
 int
 run_mac_command (argv, workdir, infn, outfn, errfn)
 
 int
 run_mac_command (argv, workdir, infn, outfn, errfn)
@@ -3339,93 +3895,328 @@ initialize_applescript ()
 }
 
 
 }
 
 
-void terminate_applescript()
+void
+terminate_applescript()
 {
   OSADispose (as_scripting_component, as_script_context);
   CloseComponent (as_scripting_component);
 }
 
 {
   OSADispose (as_scripting_component, as_script_context);
   CloseComponent (as_scripting_component);
 }
 
+/* Convert a lisp string to the 4 byte character code.  */
+
+OSType
+mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
+{
+  OSType result;
+  if (NILP(arg))
+    {
+      result = defCode;
+    }
+  else
+    {
+      /* check type string */
+      CHECK_STRING(arg);
+      if (SBYTES (arg) != 4)
+       {
+         error ("Wrong argument: need string of length 4 for code");
+       }
+      result = EndianU32_BtoN (*((UInt32 *) SDATA (arg)));
+    }
+  return result;
+}
+
+/* Convert the 4 byte character code into a 4 byte string.  */
+
+Lisp_Object
+mac_get_object_from_code(OSType defCode)
+{
+  UInt32 code = EndianU32_NtoB (defCode);
+
+  return make_unibyte_string ((char *)&code, 4);
+}
+
+
+DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0,
+       doc: /* Get the creator code of FILENAME as a four character string. */)
+     (filename)
+     Lisp_Object filename;
+{
+  OSErr        status;
+#ifdef MAC_OSX
+  FSRef fref;
+#else
+  FSSpec fss;
+#endif
+  OSType cCode;
+  Lisp_Object result = Qnil;
+  CHECK_STRING (filename);
+
+  if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
+    return Qnil;
+  }
+  filename = Fexpand_file_name (filename, Qnil);
+
+  BLOCK_INPUT;
+#ifdef MAC_OSX
+  status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
+#else
+  status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
+#endif
+
+  if (status == noErr)
+    {
+#ifdef MAC_OSX
+      FSCatalogInfo catalogInfo;
+
+      status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
+                               &catalogInfo, NULL, NULL, NULL);
+#else
+      FInfo finder_info;
+
+      status = FSpGetFInfo (&fss, &finder_info);
+#endif
+      if (status == noErr)
+       {
+#ifdef MAC_OSX
+         result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator);
+#else
+         result = mac_get_object_from_code (finder_info.fdCreator);
+#endif
+       }
+    }
+  UNBLOCK_INPUT;
+  if (status != noErr) {
+    error ("Error while getting file information.");
+  }
+  return result;
+}
+
+DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0,
+       doc: /* Get the type code of FILENAME as a four character string. */)
+     (filename)
+     Lisp_Object filename;
+{
+  OSErr        status;
+#ifdef MAC_OSX
+  FSRef fref;
+#else
+  FSSpec fss;
+#endif
+  OSType cCode;
+  Lisp_Object result = Qnil;
+  CHECK_STRING (filename);
+
+  if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
+    return Qnil;
+  }
+  filename = Fexpand_file_name (filename, Qnil);
+
+  BLOCK_INPUT;
+#ifdef MAC_OSX
+  status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
+#else
+  status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
+#endif
+
+  if (status == noErr)
+    {
+#ifdef MAC_OSX
+      FSCatalogInfo catalogInfo;
+
+      status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
+                               &catalogInfo, NULL, NULL, NULL);
+#else
+      FInfo finder_info;
+
+      status = FSpGetFInfo (&fss, &finder_info);
+#endif
+      if (status == noErr)
+       {
+#ifdef MAC_OSX
+         result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType);
+#else
+         result = mac_get_object_from_code (finder_info.fdType);
+#endif
+       }
+    }
+  UNBLOCK_INPUT;
+  if (status != noErr) {
+    error ("Error while getting file information.");
+  }
+  return result;
+}
+
+DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0,
+       doc: /* Set creator code of file FILENAME to CODE.
+If non-nil, CODE must be a 4-character string.  Otherwise, 'EMAx' is
+assumed. Return non-nil if successful.  */)
+     (filename, code)
+     Lisp_Object filename, code;
+{
+  OSErr        status;
+#ifdef MAC_OSX
+  FSRef fref;
+#else
+  FSSpec fss;
+#endif
+  OSType cCode;
+  CHECK_STRING (filename);
+
+  cCode = mac_get_code_from_arg(code, 'EMAx');
+
+  if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
+    return Qnil;
+  }
+  filename = Fexpand_file_name (filename, Qnil);
+
+  BLOCK_INPUT;
+#ifdef MAC_OSX
+  status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
+#else
+  status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
+#endif
+
+  if (status == noErr)
+    {
+#ifdef MAC_OSX
+      FSCatalogInfo catalogInfo;
+      FSRef parentDir;
+      status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
+                               &catalogInfo, NULL, NULL, &parentDir);
+#else
+      FInfo finder_info;
+
+      status = FSpGetFInfo (&fss, &finder_info);
+#endif
+      if (status == noErr)
+       {
+#ifdef MAC_OSX
+       ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode;
+       status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
+       /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
+#else
+       finder_info.fdCreator = cCode;
+       status = FSpSetFInfo (&fss, &finder_info);
+#endif
+       }
+    }
+  UNBLOCK_INPUT;
+  if (status != noErr) {
+    error ("Error while setting creator information.");
+  }
+  return Qt;
+}
+
+DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0,
+       doc: /* Set file code of file FILENAME to CODE.
+CODE must be a 4-character string.  Return non-nil if successful.  */)
+     (filename, code)
+     Lisp_Object filename, code;
+{
+  OSErr        status;
+#ifdef MAC_OSX
+  FSRef fref;
+#else
+  FSSpec fss;
+#endif
+  OSType cCode;
+  CHECK_STRING (filename);
+
+  cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
+
+  if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
+    return Qnil;
+  }
+  filename = Fexpand_file_name (filename, Qnil);
+
+  BLOCK_INPUT;
+#ifdef MAC_OSX
+  status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
+#else
+  status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
+#endif
+
+  if (status == noErr)
+    {
+#ifdef MAC_OSX
+      FSCatalogInfo catalogInfo;
+      FSRef parentDir;
+      status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
+                               &catalogInfo, NULL, NULL, &parentDir);
+#else
+      FInfo finder_info;
+
+      status = FSpGetFInfo (&fss, &finder_info);
+#endif
+      if (status == noErr)
+       {
+#ifdef MAC_OSX
+       ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode;
+       status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
+       /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
+#else
+       finder_info.fdType = cCode;
+       status = FSpSetFInfo (&fss, &finder_info);
+#endif
+       }
+    }
+  UNBLOCK_INPUT;
+  if (status != noErr) {
+    error ("Error while setting creator information.");
+  }
+  return Qt;
+}
+
 
 /* Compile and execute the AppleScript SCRIPT and return the error
    status as function value.  A zero is returned if compilation and
 
 /* Compile and execute the AppleScript SCRIPT and return the error
    status as function value.  A zero is returned if compilation and
-   execution is successful, in which case RESULT returns a pointer to
-   a string containing the resulting script value.  Otherwise, the Mac
-   error code is returned and RESULT returns a pointer to an error
-   string.  In both cases the caller should deallocate the storage
-   used by the string pointed to by RESULT if it is non-NULL.  For
-   documentation on the MacOS scripting architecture, see Inside
-   Macintosh - Interapplication Communications: Scripting Components.  */
+   execution is successful, in which case *RESULT is set to a Lisp
+   string containing the resulting script value.  Otherwise, the Mac
+   error code is returned and *RESULT is set to an error Lisp string.
+   For documentation on the MacOS scripting architecture, see Inside
+   Macintosh - Interapplication Communications: Scripting
+   Components.  */
 
 static long
 
 static long
-do_applescript (char *script, char **result)
+do_applescript (script, result)
+     Lisp_Object script, *result;
 {
 {
-  AEDesc script_desc, result_desc, error_desc;
+  AEDesc script_desc, result_desc, error_desc, *desc = NULL;
   OSErr error;
   OSAError osaerror;
   OSErr error;
   OSAError osaerror;
-  long length;
 
 
-  *result = 0;
+  *result = Qnil;
 
   if (!as_scripting_component)
     initialize_applescript();
 
 
   if (!as_scripting_component)
     initialize_applescript();
 
-  error = AECreateDesc (typeChar, script, strlen(script), &script_desc);
+  error = AECreateDesc (typeChar, SDATA (script), SBYTES (script),
+                       &script_desc);
   if (error)
     return error;
 
   osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
                          typeChar, kOSAModeNull, &result_desc);
 
   if (error)
     return error;
 
   osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
                          typeChar, kOSAModeNull, &result_desc);
 
-  if (osaerror == errOSAScriptError)
-    {
-      /* error executing AppleScript: retrieve error message */
-      if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar,
-                          &error_desc))
-        {
-#if TARGET_API_MAC_CARBON
-          length = AEGetDescDataSize (&error_desc);
-          *result = (char *) xmalloc (length + 1);
-          if (*result)
-            {
-              AEGetDescData (&error_desc, *result, length);
-              *(*result + length) = '\0';
-            }
-#else /* not TARGET_API_MAC_CARBON */
-          HLock (error_desc.dataHandle);
-          length = GetHandleSize(error_desc.dataHandle);
-          *result = (char *) xmalloc (length + 1);
-          if (*result)
-            {
-              memcpy (*result, *(error_desc.dataHandle), length);
-              *(*result + length) = '\0';
-            }
-          HUnlock (error_desc.dataHandle);
-#endif /* not TARGET_API_MAC_CARBON */
-          AEDisposeDesc (&error_desc);
-        }
-    }
-  else if (osaerror == noErr)  /* success: retrieve resulting script value */
+  if (osaerror == noErr)
+    /* success: retrieve resulting script value */
+    desc = &result_desc;
+  else if (osaerror == errOSAScriptError)
+    /* error executing AppleScript: retrieve error message */
+    if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar,
+                        &error_desc))
+      desc = &error_desc;
+
+  if (desc)
     {
 #if TARGET_API_MAC_CARBON
     {
 #if TARGET_API_MAC_CARBON
-      length = AEGetDescDataSize (&result_desc);
-      *result = (char *) xmalloc (length + 1);
-      if (*result)
-        {
-          AEGetDescData (&result_desc, *result, length);
-          *(*result + length) = '\0';
-        }
+      *result = make_uninit_string (AEGetDescDataSize (desc));
+      AEGetDescData (desc, SDATA (*result), SBYTES (*result));
 #else /* not TARGET_API_MAC_CARBON */
 #else /* not TARGET_API_MAC_CARBON */
-      HLock (result_desc.dataHandle);
-      length = GetHandleSize(result_desc.dataHandle);
-      *result = (char *) xmalloc (length + 1);
-      if (*result)
-        {
-          memcpy (*result, *(result_desc.dataHandle), length);
-          *(*result + length) = '\0';
-        }
-      HUnlock (result_desc.dataHandle);
+      *result = make_uninit_string (GetHandleSize (desc->dataHandle));
+      memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result));
 #endif /* not TARGET_API_MAC_CARBON */
 #endif /* not TARGET_API_MAC_CARBON */
-      AEDisposeDesc (&result_desc);
+      AEDisposeDesc (desc);
     }
 
   AEDisposeDesc (&script_desc);
     }
 
   AEDisposeDesc (&script_desc);
@@ -3435,61 +4226,42 @@ do_applescript (char *script, char **result)
 
 
 DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
 
 
 DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
-       doc: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
+       doc: /* Compile and execute AppleScript SCRIPT and return the result.
 If compilation and execution are successful, the resulting script
 value is returned as a string.  Otherwise the function aborts and
 displays the error message returned by the AppleScript scripting
 component.  */)
 If compilation and execution are successful, the resulting script
 value is returned as a string.  Otherwise the function aborts and
 displays the error message returned by the AppleScript scripting
 component.  */)
-  (script)
+    (script)
     Lisp_Object script;
 {
     Lisp_Object script;
 {
-  char *result, *temp;
-  Lisp_Object lisp_result;
+  Lisp_Object result;
   long status;
 
   CHECK_STRING (script);
 
   BLOCK_INPUT;
   long status;
 
   CHECK_STRING (script);
 
   BLOCK_INPUT;
-  status = do_applescript (SDATA (script), &result);
+  status = do_applescript (script, &result);
   UNBLOCK_INPUT;
   UNBLOCK_INPUT;
-  if (status)
-    {
-      if (!result)
-        error ("AppleScript error %d", status);
-      else
-        {
-          /* Unfortunately only OSADoScript in do_applescript knows how
-             how large the resulting script value or error message is
-             going to be and therefore as caller memory must be
-             deallocated here.  It is necessary to free the error
-             message before calling error to avoid a memory leak.  */
-          temp = (char *) alloca (strlen (result) + 1);
-          strcpy (temp, result);
-          xfree (result);
-          error (temp);
-        }
-    }
+  if (status == 0)
+    return result;
+  else if (!STRINGP (result))
+    error ("AppleScript error %d", status);
   else
   else
-    {
-      lisp_result = build_string (result);
-      xfree (result);
-      return lisp_result;
-    }
+    error ("%s", SDATA (result));
 }
 
 
 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
        Smac_file_name_to_posix, 1, 1, 0,
 }
 
 
 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
        Smac_file_name_to_posix, 1, 1, 0,
-       doc: /* Convert Macintosh filename to Posix form.  */)
-     (mac_filename)
-     Lisp_Object mac_filename;
+       doc: /* Convert Macintosh FILENAME to Posix form.  */)
+     (filename)
+     Lisp_Object filename;
 {
   char posix_filename[MAXPATHLEN+1];
 
 {
   char posix_filename[MAXPATHLEN+1];
 
-  CHECK_STRING (mac_filename);
+  CHECK_STRING (filename);
 
 
-  if (mac_to_posix_pathname (SDATA (mac_filename), posix_filename,
-                          MAXPATHLEN))
+  if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN))
     return build_string (posix_filename);
   else
     return Qnil;
     return build_string (posix_filename);
   else
     return Qnil;
@@ -3498,22 +4270,63 @@ DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
 
 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac,
        Sposix_file_name_to_mac, 1, 1, 0,
 
 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac,
        Sposix_file_name_to_mac, 1, 1, 0,
-       doc: /* Convert Posix filename to Mac form.  */)
-     (posix_filename)
-     Lisp_Object posix_filename;
+       doc: /* Convert Posix FILENAME to Mac form.  */)
+     (filename)
+     Lisp_Object filename;
 {
   char mac_filename[MAXPATHLEN+1];
 
 {
   char mac_filename[MAXPATHLEN+1];
 
-  CHECK_STRING (posix_filename);
+  CHECK_STRING (filename);
 
 
-  if (posix_to_mac_pathname (SDATA (posix_filename), mac_filename,
-                          MAXPATHLEN))
+  if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN))
     return build_string (mac_filename);
   else
     return Qnil;
 }
 
 
     return build_string (mac_filename);
   else
     return Qnil;
 }
 
 
+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))
+    src_desc_type = TYPE_FILE_NAME;
+  else
+    src_desc_type = mac_get_code_from_arg (src_type, 0);
+
+  if (EQ (dst_type, Qundecoded_file_name))
+    dst_desc_type = TYPE_FILE_NAME;
+  else
+    dst_desc_type = mac_get_code_from_arg (dst_type, 0);
+
+  BLOCK_INPUT;
+  err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data),
+                    dst_desc_type, &dst_desc);
+  if (err == noErr)
+    {
+      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;
 #if TARGET_API_MAC_CARBON
 static Lisp_Object Qxml, Qmime_charset;
 static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
@@ -3522,8 +4335,8 @@ DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
        doc: /* Return the application preference value for KEY.
 KEY is either a string specifying a preference key, or a list of key
 strings.  If it is a list, the (i+1)-th element is used as a key for
        doc: /* Return the application preference value for KEY.
 KEY is either a string specifying a preference key, or a list of key
 strings.  If it is a list, the (i+1)-th element is used as a key for
-the CFDictionary value obtained by the i-th element.  If lookup is
-failed at some stage, nil is returned.
+the CFDictionary value obtained by the i-th element.  Return nil if
+lookup is failed at some stage.
 
 Optional arg APPLICATION is an application ID string.  If omitted or
 nil, that stands for the current application.
 
 Optional arg APPLICATION is an application ID string.  If omitted or
 nil, that stands for the current application.
@@ -3554,7 +4367,7 @@ CFDictionary.  If HASH-BOUND is a negative integer or nil, always
 generate alists.  If HASH-BOUND >= 0, generate an alist if the number
 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
 otherwise.  */)
 generate alists.  If HASH-BOUND >= 0, generate an alist if the number
 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
 otherwise.  */)
-  (key, application, format, hash_bound)
+     (key, application, format, hash_bound)
      Lisp_Object key, application, format, hash_bound;
 {
   CFStringRef app_id, key_str;
      Lisp_Object key, application, format, hash_bound;
 {
   CFStringRef app_id, key_str;
@@ -3640,10 +4453,13 @@ get_cfstring_encoding_from_lisp (obj)
   CFStringRef iana_name;
   CFStringEncoding encoding = kCFStringEncodingInvalidId;
 
   CFStringRef iana_name;
   CFStringEncoding encoding = kCFStringEncodingInvalidId;
 
+  if (NILP (obj))
+    return kCFStringEncodingUnicode;
+
   if (INTEGERP (obj))
     return XINT (obj);
 
   if (INTEGERP (obj))
     return XINT (obj);
 
-  if (SYMBOLP (obj) && !NILP (obj) && !NILP (Fcoding_system_p (obj)))
+  if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj)))
     {
       Lisp_Object coding_spec, plist;
 
     {
       Lisp_Object coding_spec, plist;
 
@@ -3787,19 +4603,18 @@ DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_st
        doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
 The conversion is performed using the converter provided by the system.
 Each encoding is specified by either a coding system symbol, a mime
        doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
 The conversion is performed using the converter provided by the system.
 Each encoding is specified by either a coding system symbol, a mime
-charset string, or an integer as a CFStringEncoding value.
+charset string, or an integer as a CFStringEncoding value.  Nil for
+encoding means UTF-16 in native byte order, no byte order mark.
 On Mac OS X 10.2 and later, you can do Unicode Normalization by
 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
 NFKD, NFC, NFKC, HFS+D, or HFS+C.
 On Mac OS X 10.2 and later, you can do Unicode Normalization by
 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
 NFKD, NFC, NFKC, HFS+D, or HFS+C.
-On successful conversion, returns the result string, else returns
-nil.  */)
-  (string, source, target, normalization_form)
+On successful conversion, return the result string, else return nil.  */)
+     (string, source, target, normalization_form)
      Lisp_Object string, source, target, normalization_form;
 {
   Lisp_Object result = Qnil;
   CFStringEncoding src_encoding, tgt_encoding;
   CFStringRef str = NULL;
      Lisp_Object string, source, target, normalization_form;
 {
   Lisp_Object result = Qnil;
   CFStringEncoding src_encoding, tgt_encoding;
   CFStringRef str = NULL;
-  CFDataRef data = NULL;
 
   CHECK_STRING (string);
   if (!INTEGERP (source) && !STRINGP (source))
 
   CHECK_STRING (string);
   if (!INTEGERP (source) && !STRINGP (source))
@@ -3813,11 +4628,15 @@ nil.  */)
   src_encoding = get_cfstring_encoding_from_lisp (source);
   tgt_encoding = get_cfstring_encoding_from_lisp (target);
 
   src_encoding = get_cfstring_encoding_from_lisp (source);
   tgt_encoding = get_cfstring_encoding_from_lisp (target);
 
-  string = string_make_unibyte (string);
+  /* We really want string_to_unibyte, but since it doesn't exist yet, we
+     use string_as_unibyte which works as well, except for the fact that
+     it's too permissive (it doesn't check that the multibyte string only
+     contain single-byte chars).  */
+  string = Fstring_as_unibyte (string);
   if (src_encoding != kCFStringEncodingInvalidId
       && tgt_encoding != kCFStringEncodingInvalidId)
     str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
   if (src_encoding != kCFStringEncodingInvalidId
       && tgt_encoding != kCFStringEncodingInvalidId)
     str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
-                                  src_encoding, true);
+                                  src_encoding, !NILP (source));
 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
   if (str)
     {
 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
   if (str)
     {
@@ -3829,15 +4648,18 @@ nil.  */)
 #endif
   if (str)
     {
 #endif
   if (str)
     {
-      data = CFStringCreateExternalRepresentation (NULL, str,
-                                                  tgt_encoding, '\0');
+      CFIndex str_len, buf_len;
+
+      str_len = CFStringGetLength (str);
+      if (CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
+                           !NILP (target), NULL, 0, &buf_len) == str_len)
+       {
+         result = make_uninit_string (buf_len);
+         CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
+                           !NILP (target), SDATA (result), buf_len, NULL);
+       }
       CFRelease (str);
     }
       CFRelease (str);
     }
-  if (data)
-    {
-      result = cfdata_to_lisp (data);
-      CFRelease (data);
-    }
 
   UNBLOCK_INPUT;
 
 
   UNBLOCK_INPUT;
 
@@ -3848,13 +4670,36 @@ nil.  */)
 
 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_name_table, 0, 0, 0,
        doc: /* Clear the font name table.  */)
 
 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_name_table, 0, 0, 0,
        doc: /* Clear the font name table.  */)
-  ()
+     ()
 {
   check_mac ();
   mac_clear_font_name_table ();
   return Qnil;
 }
 
 {
   check_mac ();
   mac_clear_font_name_table ();
   return Qnil;
 }
 
+
+static Lisp_Object
+mac_get_system_locale ()
+{
+  OSErr err;
+  LangCode lang;
+  RegionCode region;
+  LocaleRef locale;
+  Str255 str;
+
+  lang = GetScriptVariable (smSystemScript, smScriptLang);
+  region = GetScriptManagerVariable (smRegionCode);
+  err = LocaleRefFromLangOrRegionCode (lang, region, &locale);
+  if (err == noErr)
+    err = LocaleRefGetPartString (locale, kLocaleAllPartsMask,
+                                 sizeof (str), str);
+  if (err == noErr)
+    return build_string (str);
+  else
+    return Qnil;
+}
+
+
 #ifdef MAC_OSX
 #undef select
 
 #ifdef MAC_OSX
 #undef select
 
@@ -3876,7 +4721,7 @@ extern int noninteractive;
       involved, and timeout is not too short (greater than
       SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
       -> Create CFSocket for each socket and add it into the current
       involved, and timeout is not too short (greater than
       SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
       -> Create CFSocket for each socket and add it into the current
-         event RunLoop so that an `ready-to-read' event can be posted
+         event RunLoop so that a `ready-to-read' event can be posted
          to the event queue that is also used for window events.  Then
          ReceiveNextEvent can wait for both kinds of inputs.
    4. Otherwise.
          to the event queue that is also used for window events.  Then
          ReceiveNextEvent can wait for both kinds of inputs.
    4. Otherwise.
@@ -3984,6 +4829,9 @@ sys_select (n, rfds, wfds, efds, timeout)
            return 0;
        }
 
            return 0;
        }
 
+#if USE_CG_DRAWING
+      mac_prepare_for_quickdraw (NULL);
+#endif
       /* Avoid initial overhead of RunLoop setup for the case that
         some input is already available.  */
       EMACS_SET_SECS_USECS (select_timeout, 0, 0);
       /* Avoid initial overhead of RunLoop setup for the case that
         some input is already available.  */
       EMACS_SET_SECS_USECS (select_timeout, 0, 0);
@@ -4144,12 +4992,22 @@ init_mac_osx_environment ()
   char *p, *q;
   struct stat st;
 
   char *p, *q;
   struct stat st;
 
+  /* Initialize locale related variables.  */
+  mac_system_script_code =
+    (ScriptCode) GetScriptManagerVariable (smSysScript);
+  Vmac_system_locale = mac_get_system_locale ();
+
   /* Fetch the pathname of the application bundle as a C string into
      app_bundle_pathname.  */
 
   bundle = CFBundleGetMainBundle ();
   /* Fetch the pathname of the application bundle as a C string into
      app_bundle_pathname.  */
 
   bundle = CFBundleGetMainBundle ();
-  if (!bundle)
-    return;
+  if (!bundle || CFBundleGetIdentifier (bundle) == NULL)
+    {
+      /* We could not find the bundle identifier.  For now, prevent
+        the fatal error by bringing it up in the terminal. */
+      inhibit_window_system = 1;
+      return;
+    }
 
   bundleURL = CFBundleCopyBundleURL (bundle);
   if (!bundleURL)
 
   bundleURL = CFBundleCopyBundleURL (bundle);
   if (!bundleURL)
@@ -4258,31 +5116,12 @@ init_mac_osx_environment ()
 #endif /* MAC_OSX */
 
 
 #endif /* MAC_OSX */
 
 
-static Lisp_Object
-mac_get_system_locale ()
-{
-  OSErr err;
-  LangCode lang;
-  RegionCode region;
-  LocaleRef locale;
-  Str255 str;
-
-  lang = GetScriptVariable (smSystemScript, smScriptLang);
-  region = GetScriptManagerVariable (smRegionCode);
-  err = LocaleRefFromLangOrRegionCode (lang, region, &locale);
-  if (err == noErr)
-    err = LocaleRefGetPartString (locale, kLocaleAllPartsMask,
-                                 sizeof (str), str);
-  if (err == noErr)
-    return build_string (str);
-  else
-    return Qnil;
-}
-
-
 void
 syms_of_mac ()
 {
 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);
 #if TARGET_API_MAC_CARBON
   Qstring  = intern ("string");                staticpro (&Qstring);
   Qnumber  = intern ("number");                staticpro (&Qnumber);
@@ -4306,12 +5145,17 @@ syms_of_mac ()
   QHFS_plus_C = intern ("HFS+C");      staticpro (&QHFS_plus_C);
 #endif
 
   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);
 #endif
   defsubr (&Smac_clear_font_name_table);
 
 #if TARGET_API_MAC_CARBON
   defsubr (&Smac_get_preference);
   defsubr (&Smac_code_convert_string);
 #endif
   defsubr (&Smac_clear_font_name_table);
 
+  defsubr (&Smac_set_file_creator);
+  defsubr (&Smac_set_file_type);
+  defsubr (&Smac_get_file_creator);
+  defsubr (&Smac_get_file_type);
   defsubr (&Sdo_applescript);
   defsubr (&Smac_file_name_to_posix);
   defsubr (&Sposix_file_name_to_mac);
   defsubr (&Sdo_applescript);
   defsubr (&Smac_file_name_to_posix);
   defsubr (&Sposix_file_name_to_mac);