Mercurial > emacs

--- a/src/mac.c	Sun Apr 24 06:03:58 2005 +0000
+++ b/src/mac.c	Sun Apr 24 06:05:39 2005 +0000
@@ -31,12 +31,13 @@
 #include "sysselect.h"
 #include "systime.h"
 #include "blockinput.h"
+
+#include "macterm.h"
+
+#if TARGET_API_MAC_CARBON
 #include "charset.h"
 #include "coding.h"
-
-#include "macterm.h"
-
-#ifndef HAVE_CARBON
+#else  /* not TARGET_API_MAC_CARBON */
 #include <Files.h>
 #include <MacTypes.h>
 #include <TextUtils.h>
@@ -52,7 +53,7 @@
 #include <Processes.h>
 #include <EPPC.h>
 #include <MacLocales.h>
-#endif	/* not HAVE_CARBON */
+#endif	/* not TARGET_API_MAC_CARBON */

 #include <utime.h>
 #include <dirent.h>
@@ -68,8 +69,6 @@
 #include <unistd.h>
 #endif

-Lisp_Object QCLIPBOARD;
-
 /* The system script code. */
 static int mac_system_script_code;

@@ -331,7 +330,7 @@
 {
   CFIndex len = CFDataGetLength (data);
   Lisp_Object result = make_uninit_string (len);
-
+
   CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));

   return result;
@@ -894,7 +893,7 @@
       if (i < 0)
 	{
 	  max_nid++;
-	  XSETINT (node_id, max_nid);
+	  XSETINT (node_id, max_nid);
 	  hash_put (h, key, node_id, hash_code);
 	}
       else
@@ -3515,169 +3514,9 @@
 }


-/* set interprogram-paste-function to mac-paste-function in mac-win.el
-   to enable Emacs to obtain the contents of the Mac clipboard. */
-DEFUN ("mac-paste-function", Fmac_paste_function, Smac_paste_function, 0, 0, 0,
-       doc: /* Return the contents of the Mac clipboard as a string.  */)
-     ()
-{
 #if TARGET_API_MAC_CARBON
-  OSStatus err;
-  ScrapRef scrap;
-  ScrapFlavorFlags sff;
-  Size s;
-  int i;
-  char *data;
-
-  BLOCK_INPUT;
-  err = GetCurrentScrap (&scrap);
-  if (err == noErr)
-    err = GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff);
-  if (err == noErr)
-    err = GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s);
-  if (err == noErr && (data = (char*) alloca (s)))
-    err = GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data);
-  UNBLOCK_INPUT;
-  if (err != noErr || s == 0)
-    return Qnil;
-
-  /* Emacs expects clipboard contents have Unix-style eol's */
-  for (i = 0; i < s; i++)
-    if (data[i] == '\r')
-      data[i] = '\n';
-
-  return make_string (data, s);
-#else /* not TARGET_API_MAC_CARBON */
-  Lisp_Object value;
-  Handle my_handle;
-  long scrap_offset, rc, i;
-
-  my_handle = NewHandle (0);  /* allocate 0-length data area */
-
-  rc = GetScrap (my_handle, 'TEXT', &scrap_offset);
-  if (rc < 0)
-    return Qnil;
-
-  HLock (my_handle);
-
-  /* Emacs expects clipboard contents have Unix-style eol's */
-  for (i = 0; i < rc; i++)
-    if ((*my_handle)[i] == '\r')
-      (*my_handle)[i] = '\n';
-
-  value = make_string (*my_handle, rc);
-
-  HUnlock (my_handle);
-
-  DisposeHandle (my_handle);
-
-  return value;
-#endif /* not TARGET_API_MAC_CARBON */
-}
-
-
-/* set interprogram-cut-function to mac-cut-function in mac-win.el
-   to enable Emacs to write the top of the kill-ring to the Mac clipboard. */
-DEFUN ("mac-cut-function", Fmac_cut_function, Smac_cut_function, 1, 2, 0,
-       doc: /* Put the value of the string parameter to the Mac clipboard.  */)
-  (value, push)
-    Lisp_Object value, push;
-{
-  char *buf;
-  int len, i;
-
-  /* fixme: ignore the push flag for now */
-
-  CHECK_STRING (value);
-
-  len = SCHARS (value);
-  buf = (char *) alloca (len+1);
-  bcopy (SDATA (value), buf, len);
-  buf[len] = '\0';
-
-  /* convert to Mac-style eol's before sending to clipboard */
-  for (i = 0; i < len; i++)
-    if (buf[i] == '\n')
-      buf[i] = '\r';
-
-#if TARGET_API_MAC_CARBON
-  {
-    ScrapRef scrap;
-
-    BLOCK_INPUT;
-    ClearCurrentScrap ();
-    if (GetCurrentScrap (&scrap) != noErr)
-      {
-	UNBLOCK_INPUT;
-	error ("cannot get current scrap");
-      }
-
-    if (PutScrapFlavor (scrap, kScrapFlavorTypeText, kScrapFlavorMaskNone, len,
-			buf) != noErr)
-      {
-	UNBLOCK_INPUT;
-	error ("cannot put to scrap");
-      }
-    UNBLOCK_INPUT;
-  }
-#else /* not TARGET_API_MAC_CARBON */
-  ZeroScrap ();
-  PutScrap (len, 'TEXT', buf);
-#endif /* not TARGET_API_MAC_CARBON */
-
-  return Qnil;
-}
-
-
-DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
-       0, 1, 0,
-       doc: /* Whether there is an owner for the given X Selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'.  */)
-  (selection)
-     Lisp_Object selection;
-{
-  CHECK_SYMBOL (selection);
-
-  /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
-     if the clipboard currently has valid text format contents. */
-
-  if (EQ (selection, QCLIPBOARD))
-    {
-      Lisp_Object val = Qnil;
-
-#if TARGET_API_MAC_CARBON
-      ScrapRef scrap;
-      ScrapFlavorFlags sff;
-
-      BLOCK_INPUT;
-      if (GetCurrentScrap (&scrap) == noErr)
-        if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) == noErr)
-          val = Qt;
-      UNBLOCK_INPUT;
-#else /* not TARGET_API_MAC_CARBON */
-      Handle my_handle;
-      long rc, scrap_offset;
-
-      my_handle = NewHandle (0);
-
-      rc = GetScrap (my_handle, 'TEXT', &scrap_offset);
-      if (rc >= 0)
-        val = Qt;
-
-      DisposeHandle (my_handle);
-#endif /* not TARGET_API_MAC_CARBON */
-
-      return val;
-    }
-  return Qnil;
-}
-
-#if TARGET_API_MAC_CARBON
-static Lisp_Object Qxml;
+static Lisp_Object Qxml, Qmime_charset;
+static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;

 DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
        doc: /* Return the application preference value for KEY.
@@ -3792,6 +3631,218 @@

   return result;
 }
+
+
+static CFStringEncoding
+get_cfstring_encoding_from_lisp (obj)
+     Lisp_Object obj;
+{
+  CFStringRef iana_name;
+  CFStringEncoding encoding = kCFStringEncodingInvalidId;
+
+  if (INTEGERP (obj))
+    return XINT (obj);
+
+  if (SYMBOLP (obj) && !NILP (obj) && !NILP (Fcoding_system_p (obj)))
+    {
+      Lisp_Object coding_spec, plist;
+
+      coding_spec = Fget (obj, Qcoding_system);
+      plist = XVECTOR (coding_spec)->contents[3];
+      obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset);
+    }
+
+  if (SYMBOLP (obj))
+    obj = SYMBOL_NAME (obj);
+
+  if (STRINGP (obj))
+    {
+      iana_name = cfstring_create_with_string (obj);
+      if (iana_name)
+	{
+	  encoding = CFStringConvertIANACharSetNameToEncoding (iana_name);
+	  CFRelease (iana_name);
+	}
+    }
+
+  return encoding;
+}
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
+static CFStringRef
+cfstring_create_normalized (str, symbol)
+     CFStringRef str;
+     Lisp_Object symbol;
+{
+  int form = -1;
+  TextEncodingVariant variant;
+  float initial_mag = 0.0;
+  CFStringRef result = NULL;
+
+  if (EQ (symbol, QNFD))
+    form = kCFStringNormalizationFormD;
+  else if (EQ (symbol, QNFKD))
+    form = kCFStringNormalizationFormKD;
+  else if (EQ (symbol, QNFC))
+    form = kCFStringNormalizationFormC;
+  else if (EQ (symbol, QNFKC))
+    form = kCFStringNormalizationFormKC;
+  else if (EQ (symbol, QHFS_plus_D))
+    {
+      variant = kUnicodeHFSPlusDecompVariant;
+      initial_mag = 1.5;
+    }
+  else if (EQ (symbol, QHFS_plus_C))
+    {
+      variant = kUnicodeHFSPlusCompVariant;
+      initial_mag = 1.0;
+    }
+
+  if (form >= 0)
+    {
+      CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str);
+
+      if (mut_str)
+	{
+	  CFStringNormalize (mut_str, form);
+	  result = mut_str;
+	}
+    }
+  else if (initial_mag > 0.0)
+    {
+      UnicodeToTextInfo uni = NULL;
+      UnicodeMapping map;
+      CFIndex length;
+      UniChar *in_text, *buffer = NULL, *out_buf = NULL;
+      OSErr err = noErr;
+      ByteCount out_read, out_size, out_len;
+
+      map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
+						kUnicodeNoSubset,
+						kTextEncodingDefaultFormat);
+      map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
+					      variant,
+					      kTextEncodingDefaultFormat);
+      map.mappingVersion = kUnicodeUseLatestMapping;
+
+      length = CFStringGetLength (str);
+      out_size = (int)((float)length * initial_mag) * sizeof (UniChar);
+      if (out_size < 32)
+	out_size = 32;
+
+      in_text = (UniChar *)CFStringGetCharactersPtr (str);
+      if (in_text == NULL)
+	{
+	  buffer = xmalloc (sizeof (UniChar) * length);
+	  if (buffer)
+	    {
+	      CFStringGetCharacters (str, CFRangeMake (0, length), buffer);
+	      in_text = buffer;
+	    }
+	}
+
+      if (in_text)
+	err = CreateUnicodeToTextInfo(&map, &uni);
+      while (err == noErr)
+	{
+	  out_buf = xmalloc (out_size);
+	  if (out_buf == NULL)
+	    err = mFulErr;
+	  else
+	    err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar),
+					    in_text,
+					    kUnicodeDefaultDirectionMask,
+					    0, NULL, NULL, NULL,
+					    out_size, &out_read, &out_len,
+					    out_buf);
+	  if (err == noErr && out_read < length * sizeof (UniChar))
+	    {
+	      xfree (out_buf);
+	      out_size += length;
+	    }
+	  else
+	    break;
+	}
+      if (err == noErr)
+	result = CFStringCreateWithCharacters (NULL, out_buf,
+					       out_len / sizeof (UniChar));
+      if (uni)
+	DisposeUnicodeToTextInfo (&uni);
+      if (out_buf)
+	xfree (out_buf);
+      if (buffer)
+	xfree (buffer);
+    }
+  else
+    {
+      result = str;
+      CFRetain (result);
+    }
+
+  return result;
+}
+#endif
+
+DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0,
+       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.
+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)
+     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_SYMBOL (source);
+  if (!INTEGERP (target) && !STRINGP (target))
+    CHECK_SYMBOL (target);
+  CHECK_SYMBOL (normalization_form);
+
+  BLOCK_INPUT;
+
+  src_encoding = get_cfstring_encoding_from_lisp (source);
+  tgt_encoding = get_cfstring_encoding_from_lisp (target);
+
+  string = string_make_unibyte (string);
+  if (src_encoding != kCFStringEncodingInvalidId
+      && tgt_encoding != kCFStringEncodingInvalidId)
+    str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
+				   src_encoding, true);
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
+  if (str)
+    {
+      CFStringRef saved_str = str;
+
+      str = cfstring_create_normalized (saved_str, normalization_form);
+      CFRelease (saved_str);
+    }
+#endif
+  if (str)
+    {
+      data = CFStringCreateExternalRepresentation (NULL, str,
+						   tgt_encoding, '\0');
+      CFRelease (str);
+    }
+  if (data)
+    {
+      result = cfdata_to_lisp (data);
+      CFRelease (data);
+    }
+
+  UNBLOCK_INPUT;
+
+  return result;
+}
 #endif	/* TARGET_API_MAC_CARBON */


@@ -4232,9 +4283,6 @@
 void
 syms_of_mac ()
 {
-  QCLIPBOARD = intern ("CLIPBOARD");
-  staticpro (&QCLIPBOARD);
-
 #if TARGET_API_MAC_CARBON
   Qstring  = intern ("string");		staticpro (&Qstring);
   Qnumber  = intern ("number");		staticpro (&Qnumber);
@@ -4246,13 +4294,21 @@

   Qxml = intern ("xml");
   staticpro (&Qxml);
+
+  Qmime_charset = intern ("mime-charset");
+  staticpro (&Qmime_charset);
+
+  QNFD  = intern ("NFD");		staticpro (&QNFD);
+  QNFKD = intern ("NFKD");		staticpro (&QNFKD);
+  QNFC  = intern ("NFC");		staticpro (&QNFC);
+  QNFKC = intern ("NFKC");		staticpro (&QNFKC);
+  QHFS_plus_D = intern ("HFS+D");	staticpro (&QHFS_plus_D);
+  QHFS_plus_C = intern ("HFS+C");	staticpro (&QHFS_plus_C);
 #endif

-  defsubr (&Smac_paste_function);
-  defsubr (&Smac_cut_function);
-  defsubr (&Sx_selection_exists_p);
 #if TARGET_API_MAC_CARBON
   defsubr (&Smac_get_preference);
+  defsubr (&Smac_code_convert_string);
 #endif
   defsubr (&Smac_clear_font_name_table);