[Emacs-diffs] Changes to emacs/src/mac.c

[YAMAMOTO Mitsuharu]

Index: emacs/src/mac.c
diff -c emacs/src/mac.c:1.33 emacs/src/mac.c:1.34
*** emacs/src/mac.c:1.33        Sat Apr 16 03:03:02 2005
--- emacs/src/mac.c     Sun Apr 24 06:05:39 2005
***************
*** 31,42 ****
  #include "sysselect.h"
  #include "systime.h"
  #include "blockinput.h"
- #include "charset.h"
- #include "coding.h"
  
  #include "macterm.h"
  
! #ifndef HAVE_CARBON
  #include <Files.h>
  #include <MacTypes.h>
  #include <TextUtils.h>
--- 31,43 ----
  #include "sysselect.h"
  #include "systime.h"
  #include "blockinput.h"
  
  #include "macterm.h"
  
! #if TARGET_API_MAC_CARBON
! #include "charset.h"
! #include "coding.h"
! #else  /* not TARGET_API_MAC_CARBON */
  #include <Files.h>
  #include <MacTypes.h>
  #include <TextUtils.h>
***************
*** 52,58 ****
  #include <Processes.h>
  #include <EPPC.h>
  #include <MacLocales.h>
! #endif        /* not HAVE_CARBON */
  
  #include <utime.h>
  #include <dirent.h>
--- 53,59 ----
  #include <Processes.h>
  #include <EPPC.h>
  #include <MacLocales.h>
! #endif        /* not TARGET_API_MAC_CARBON */
  
  #include <utime.h>
  #include <dirent.h>
***************
*** 68,75 ****
  #include <unistd.h>
  #endif
  
- Lisp_Object QCLIPBOARD;
- 
  /* The system script code. */
  static int mac_system_script_code;
  
--- 69,74 ----
***************
*** 331,337 ****
  {
    CFIndex len = CFDataGetLength (data);
    Lisp_Object result = make_uninit_string (len);
!   
    CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
  
    return result;
--- 330,336 ----
  {
    CFIndex len = CFDataGetLength (data);
    Lisp_Object result = make_uninit_string (len);
! 
    CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
  
    return result;
***************
*** 894,900 ****
        if (i < 0)
        {
          max_nid++;
!         XSETINT (node_id, max_nid); 
          hash_put (h, key, node_id, hash_code);
        }
        else
--- 893,899 ----
        if (i < 0)
        {
          max_nid++;
!         XSETINT (node_id, max_nid);
          hash_put (h, key, node_id, hash_code);
        }
        else
***************
*** 3515,3683 ****
  }
  
  
- /* 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;
  
  DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 
0,
         doc: /* Return the application preference value for KEY.
--- 3514,3522 ----
  }
  
  
  #if TARGET_API_MAC_CARBON
! 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,3797 ****
--- 3631,3848 ----
  
    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,4240 ****
  void
  syms_of_mac ()
  {
-   QCLIPBOARD = intern ("CLIPBOARD");
-   staticpro (&QCLIPBOARD);
- 
  #if TARGET_API_MAC_CARBON
    Qstring  = intern ("string");               staticpro (&Qstring);
    Qnumber  = intern ("number");               staticpro (&Qnumber);
--- 4283,4288 ----
***************
*** 4246,4258 ****
  
    Qxml = intern ("xml");
    staticpro (&Qxml);
  #endif
  
-   defsubr (&Smac_paste_function);
-   defsubr (&Smac_cut_function);
-   defsubr (&Sx_selection_exists_p);
  #if TARGET_API_MAC_CARBON
    defsubr (&Smac_get_preference);
  #endif
    defsubr (&Smac_clear_font_name_table);
  
--- 4294,4314 ----
  
    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
  
  #if TARGET_API_MAC_CARBON
    defsubr (&Smac_get_preference);
+   defsubr (&Smac_code_convert_string);
  #endif
    defsubr (&Smac_clear_font_name_table);