1 files changed, 322 insertions, 31 deletions

diff --git a/src/mac.c b/src/mac.c
index ef136ab6512..0d8c99ffb1e 100644
--- a/src/mac.c
+++ b/src/mac.c
@@ -1,5 +1,6 @@
 /* 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 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -34,10 +35,9 @@ Boston, MA 02110-1301, USA.  */
 
 #include "macterm.h"
 
-#if TARGET_API_MAC_CARBON
 #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>
@@ -53,17 +53,16 @@ Boston, MA 02110-1301, USA.  */
 #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>
-#include <string.h>
 #include <pwd.h>
 #include <grp.h>
 #include <sys/param.h>
-#include <stdlib.h>
 #include <fcntl.h>
 #if __MWERKS__
 #include <unistd.h>
@@ -1021,7 +1020,7 @@ xrm_cfproperty_list_to_value (plist)
   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;
@@ -2490,6 +2489,22 @@ chmod (const char *path, mode_t mode)
 
 
 int
+fchmod (int fd, mode_t mode)
+{
+  /* say it always succeed for now */
+  return 0;
+}
+
+
+int
+fchown (int fd, uid_t owner, gid_t group)
+{
+  /* say it always succeed for now */
+  return 0;
+}
+
+
+int
 dup (int oldd)
 {
 #ifdef __MRC__
@@ -3388,12 +3403,278 @@ initialize_applescript ()
 }
 
 
-void terminate_applescript()
+void
+terminate_applescript()
 {
   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
@@ -3484,12 +3765,12 @@ do_applescript (char *script, char **result)
 
 
 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.  */)
-  (script)
+    (script)
     Lisp_Object script;
 {
   char *result, *temp;
@@ -3529,16 +3810,15 @@ component.  */)
 
 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];
 
-  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;
@@ -3547,16 +3827,15 @@ 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,
-       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];
 
-  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;
@@ -3571,8 +3850,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
-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.
@@ -3603,7 +3882,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.  */)
-  (key, application, format, hash_bound)
+     (key, application, format, hash_bound)
      Lisp_Object key, application, format, hash_bound;
 {
   CFStringRef app_id, key_str;
@@ -3840,9 +4119,8 @@ charset string, or an integer as a CFStringEncoding value.
 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;
@@ -3862,7 +4140,11 @@ nil.  */)
   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),
@@ -3897,7 +4179,7 @@ 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.  */)
-  ()
+     ()
 {
   check_mac ();
   mac_clear_font_name_table ();
@@ -4197,8 +4479,13 @@ init_mac_osx_environment ()
      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)
@@ -4361,6 +4648,10 @@ syms_of_mac ()
 #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);