[PATCH] Add Carbon-specific locale-determination code; respect the locale with mac-command-key-is-meta behaviour

Aidan Kehoe kehoea at parhasard.net
Fri Oct 19 03:07:12 EDT 2007


 Ar an t-ochtú lá déag de mí Deireadh Fómhair, scríobh Sparapani, Rodney: 

 > [...] Maybe you have some other changes to checkin?  

None independent of that; but do note that this is the carbon branch, not
the trunk. 

 > In any case, I am very interested in getting this working.
 > Any thoughts?

Well, here’s a patch with the obvious compile failure fixed. If you want to
use the option key as meta, then you’ll need to call (setq
mac-command-key-is-meta nil) ; if your key layout needs option to generate
ASCII or any character necessary for the current language, as listed in the
Quail input method for that language, that character on its own will be
generated for that key, making it necessary to use the ESC prefix for meta +
thatkey; and other keys respect option as meta. 

XEmacs Trunk source patch:
Diff command:   cvs -q diff -Nu
Files affected: src/scrollbar-carbon.c
===================================================================
RCS src/intl-carbon.c
===================================================================
RCS src/event-carbon.c
===================================================================
RCS lisp/mule/mule-cmds.el
===================================================================
RCS

Index: lisp/mule/mule-cmds.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-cmds.el,v
retrieving revision 1.23.2.1
diff -u -u -r1.23.2.1 mule-cmds.el
--- lisp/mule/mule-cmds.el	2007/09/30 18:33:20	1.23.2.1
+++ lisp/mule/mule-cmds.el	2007/10/19 06:58:10
@@ -1464,17 +1464,25 @@
 	(declare-fboundp (mswindows-set-current-locale userdef)))
       ;; Unix:
       (let (locstring)
-	;; Init the POSIX locale from the environment--this calls the C
-	;; library's setlocale(3).
-	(set-current-locale "")
-	;; Can't let locstring be the result of (set-current-locale "")
-	;; because that can return a more detailed string than we know how
-	;; to handle.
-	(setq locstring (current-locale)
-	      ;; assume C lib locale and LANG env var are set correctly.
-	      ;; use them to find the langenv.
-	      langenv
- 	      (and locstring (get-language-environment-from-locale
+	(unless (and-fboundp 
+		    #'carbon-current-locale
+		  ;; If Carbon provides us with the locale string, we want
+		  ;; to use that, instead of the code that checks the
+		  ;; C environment below.
+		  (setq locstring 
+			(carbon-current-locale)))
+	  ;; Init the POSIX locale from the environment--this calls the C
+	  ;; library's setlocale(3).
+	  (set-current-locale "")
+	  ;; Can't let locstring be the result of (set-current-locale "")
+	  ;; because that can return a more detailed string than we know how
+	  ;; to handle.
+	  (setq locstring (current-locale)))
+
+	;; assume C lib locale and LANG env var are set correctly.
+	;; use them to find the langenv.
+	(setq langenv
+	      (and locstring (get-language-environment-from-locale
  			      locstring)))))
     ;; All systems:
     (unless langenv (setq langenv "English"))
@@ -1515,8 +1523,36 @@
     (setq Manual-use-rosetta-man nil))
   
   ;; Register available input methods by loading LEIM list file.
-  (load "leim-list.el" 'noerror 'nomessage 'nosuffix)
-  )
+  (load leim-list-file-name 'noerror 'nomessage 'nosuffix)
+
+  (when-boundp 'carbon-current-language-unicode-set
+    (unless carbon-current-language-unicode-set
+      (setq carbon-current-language-unicode-set
+            (make-hash-table :size 256)))
+    (loop
+      for i from #x20 to #x7e
+      do (puthash i t carbon-current-language-unicode-set))
+    (let ((input-method (get-language-info current-language-environment 'input-method)))
+      (when (assoc input-method input-method-alist)
+        (flet ((map-tree 
+                 (tree)
+                 (loop for branch in tree
+                   do
+                   (cond ((consp branch)
+                          (map-tree branch))
+                         ((or (stringp branch) (vectorp branch))
+                          (map-tree (append branch nil)))
+                         ((characterp branch)
+                          (unless (< branch #x80)
+                            (puthash (encode-char branch 'ucs) t
+                                     carbon-current-language-unicode-set))))))
+               (append-message (&rest args) ())
+               (clear-message (&rest args) ()))
+          (set-input-method input-method)
+          (loop for mapped in (mapcar #'cdr (cdr (quail-map)))
+            do
+            (map-tree mapped)))
+        (inactivate-input-method)))))
 
 ;; Code deleted: init-mule-tm (Enable the tm package by default)
 
Index: src/event-carbon.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/event-carbon.c,v
retrieving revision 1.1.2.3
diff -u -u -r1.1.2.3 event-carbon.c
--- src/event-carbon.c	2007/09/30 19:48:26	1.1.2.3
+++ src/event-carbon.c	2007/10/19 06:58:10
@@ -27,16 +27,35 @@
 
 #include "sysproc.h"
 #include "systime.h"
+#include "elhash.h"
 
 #include "console-carbon-impl.h"
 
+#ifdef DEBUG_XEMACS
+static Fixnum debug_carbon_events;
+# define DEBUG_CARBON_EVENTS(FORMAT, ...)  \
+     do { if (debug_carbon_events) stderr_out(FORMAT, __VA_ARGS__); } while (0)
+#else  /* DEBUG_XEMACS */
+# define DEBUG_CARBON_EVENTS(format, ...)
+#endif /* DEBUG_XEMACS */
+
+
+#ifdef DEBUG_XEMACS
+extern Fixnum debug_emacs_events;
+#endif 
+
 EXFUN (Funicode_to_char, 2);  /* In unicode.c.  */
 
+extern Lisp_Object Vcarbon_current_language_unicode_set;
+
 extern Lisp_Object Qcarbon_unicode;  /* From intl-carbon.c.  */
 
 extern SELECT_TYPE process_only_mask;  /* From event-unixoid.c.  */
 extern int track_mouse_down_on_scrollbar (void);  /* from scrollbar-carbon.c.  */
 
+/* true if using command key as meta key */
+Lisp_Object Vmac_command_key_is_meta;
+
 static struct event_stream *carbon_event_stream;
 
 static Lisp_Object carbon_user_event_queue;
@@ -50,8 +69,6 @@
 
 static EventLoopTimerUPP timer_proc_UPP;
 
-static int debug_carbon_events = 0;
-
 /* Used in frame-carbon.c.  */
 void carbon_enqueue_user_event (Lisp_Object);
 
@@ -250,7 +267,7 @@
 {
   int emacs_modifiers = 0;
   
-  if (modifiers & cmdKey)
+  if (modifiers & (NILP (Vmac_command_key_is_meta) ? optionKey : cmdKey))
     emacs_modifiers |= XEMACS_MOD_META;
   if (modifiers & controlKey)
     emacs_modifiers |= XEMACS_MOD_CONTROL;
@@ -343,6 +360,108 @@
     }
 }
 
+static void
+retranslate_option (EventRef keyboard_event, UInt32 modifiers,
+                    UniChar *text, UInt32 text_size)
+{
+  UInt32 new_modifiers = modifiers & ~optionKey;
+  UInt32 keycode;
+  KeyboardLayoutRef layoutRef;
+  KeyboardLayoutKind layout_kind;
+
+  GetEventParameter (keyboard_event, kEventParamKeyCode, typeUInt32, NULL,
+                     sizeof (keycode), NULL, &keycode);
+  
+  if (KLGetCurrentKeyboardLayout (&layoutRef) != noErr)
+    invalid_operation ("Can't get keyboard layout ref", Qunbound);
+  
+  if (KLGetKeyboardLayoutProperty (layoutRef, kKLKind,
+                                   (const void **)&layout_kind) != noErr)
+    invalid_operation ("Can't get keyboard layout kind", Qunbound);
+
+  /* Depending on whether KCHR or uchr keyboard layout data is
+     available, call KeyTranslate or UCKeyTranslate to determine the
+     actual character code that should be enqueued.  */
+  if (layout_kind == kKLKCHRKind)
+    {
+      void *kchr_ptr;
+      UInt16 new_keycode;
+      static UInt32 deadKeyState = 0;
+      UniChar char_code;
+
+      DEBUG_CARBON_EVENTS ("%s", "layout kind is KCHR\n");
+
+      if (KLGetKeyboardLayoutProperty (layoutRef, kKLKCHRData,
+                                       (const void **)&kchr_ptr) != noErr)
+	invalid_operation ("Can't get KCHR keyboard layout", Qunbound);
+    
+      new_keycode = new_modifiers & 0xff00;
+
+      if (GetEventKind (keyboard_event) == kEventRawKeyUp)
+	new_keycode |= (1 << 7);
+      
+      new_keycode |= (keycode & 0x7f);
+      
+      deadKeyState = 0;
+      char_code = KeyTranslate (kchr_ptr, new_keycode, &deadKeyState);
+
+      DEBUG_CARBON_EVENTS ("char_code is %x, text[0] is %x, check is %x\n",
+                           char_code, text[0], 
+                           (!NILP (Vcarbon_current_language_unicode_set) &&
+                            !NILP (Fgethash (make_int (text[0]), 
+                                             Vcarbon_current_language_unicode_set, Qnil))));
+
+      if (2 == text_size && char_code != text[0] && 
+          (!NILP (Vcarbon_current_language_unicode_set) &&
+           !NILP (Fgethash (make_int (text[0]), 
+                            Vcarbon_current_language_unicode_set, Qnil))))
+        {
+          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, are modifying event\n");
+          enqueue_input (text, text_size / 2, new_modifiers);
+        }
+      else
+        {
+          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, not modifying event\n");
+          enqueue_input (&char_code, 1, modifiers);
+        }
+    }
+  else /* layout_kind == kKLuchrKind || layout_kind == kKLKCHRuchrKind */
+    {
+      UCKeyboardLayout *layout;
+      static UInt32 deadKeyState = 0;
+      UniChar output[16];
+      UniCharCount output_length;
+
+      DEBUG_CARBON_EVENTS ("%s", "layout kind is Unicode\n");
+
+      if (KLGetKeyboardLayoutProperty (layoutRef, kKLuchrData,
+                                       (const void**)&layout) != noErr)
+	invalid_operation ("Can't get uchr keyboard layout", Qunbound);
+      
+      if (UCKeyTranslate (layout, keycode, kUCKeyActionDown, new_modifiers >> 8,
+                          LMGetKbdType (), 0, &deadKeyState, 16,
+                          &output_length, output) != noErr)
+	invalid_operation ("Can't translate key using uchr", Qunbound);
+      
+      DEBUG_CARBON_EVENTS ("output[0] is %x, text[0] is %x\n", output[0], text[0]);
+
+
+      if (2 == text_size && output[0] != text[0] && 
+          (!NILP (Vcarbon_current_language_unicode_set) &&
+           !NILP (Fgethash (make_int (text[0]), 
+                            Vcarbon_current_language_unicode_set, Qnil))))
+        {
+          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, are modifying event\n");
+          enqueue_input (text, text_size / 2, new_modifiers);
+        }
+      else
+        {
+          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, not modifying event\n");
+          enqueue_input (output, output_length, modifiers);
+        }
+    }
+}
+
 static char *ascii_to_keysymstr_table[] = {
   /*0x00*/ 0, "home", 0, "kp-enter", "end", "help", 0, 0,
   /*0x08*/ "backspace", "tab", 0, "prior", "next", "return", 0, 0,
@@ -419,34 +538,49 @@
   UniChar *text = (UniChar *)alloca_extbytes (text_size);
   if (GetEventParameter (event, kEventParamTextInputSendText, typeUnicodeText, NULL, text_size, NULL, text) != noErr)
     invalid_operation ("Can't get input text", Qunbound);
+
+  DEBUG_CARBON_EVENTS ("modifiers are %x, keycode is %x, text_size is %x\n",
+                       modifiers, keycode, text_size);
+  DEBUG_CARBON_EVENTS ("optionKey is %x\n",
+                       optionKey);
+
+  if (text_size == 2 && text[0] <= 127 && 
+      (modifiers & (controlKey | cmdKey)) && keycode_needs_retranslate[keycode])
+    {
+      retranslate_keycode (keyboard_event, modifiers);
+      return noErr;
+    }
   
+  if (NILP(Vmac_command_key_is_meta) && (modifiers & optionKey))
+    {
+      DEBUG_CARBON_EVENTS ("%s", 
+                           "command key is not meta, and the modifiers include option\n");
+      retranslate_option (keyboard_event, modifiers, text, text_size);
+      return noErr;
+    }
+
   if (text_size == 2 && text[0] <= 127)
     {
-      if ((modifiers & (controlKey | cmdKey)) && keycode_needs_retranslate[keycode])
-	retranslate_keycode (keyboard_event, modifiers);
+      char *keysymstr = ascii_to_keysymstr_table[text[0]];
+      if (keysymstr)
+        enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
       else
-	{
-	  char *keysymstr = ascii_to_keysymstr_table[text[0]];
-	  if (keysymstr)
-	    enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
-	  else
-	    {
-	      if (ascii_needs_keycode_lookup[text[0]])
-		{
-		  char *keysymstr = keycode_to_keysymstr_table[keycode];
-		  if (keysymstr)
-		    enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
-		  else
-		    enqueue_input (text, text_size / 2, modifiers);
-		}
-	      else
-		enqueue_input (text, text_size / 2, modifiers);
-	    }
-	}
+        {
+          if (ascii_needs_keycode_lookup[text[0]])
+            {
+              char *keysymstr = keycode_to_keysymstr_table[keycode];
+              if (keysymstr)
+                enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
+              else
+                enqueue_input (text, text_size / 2, modifiers);
+            }
+          else
+            enqueue_input (text, text_size / 2, modifiers);
+        }
+      return noErr;
     }
-  else
-    enqueue_input (text, text_size / 2, modifiers);
- 
+
+  enqueue_input (text, text_size / 2, modifiers);
   return noErr;
 }
 
@@ -503,8 +637,12 @@
     stderr_out ("Can't convert to event record.\n");
   
   OSErr s = AEProcessAppleEvent (&event_record);
-  if (s != noErr && debug_carbon_events)
-    stderr_out ("Apple event not processed (error = %d).\n", s);
+  
+
+  if (s != noErr)
+    {
+      DEBUG_CARBON_EVENTS ("Apple event not processed (error = %d).\n", s);
+    }
 }
 
 static void
@@ -517,9 +655,9 @@
       EventClass event_class = GetEventClass (event);
       UInt32 event_kind = GetEventKind (event);
 
-      stderr_out ("Event not sent to or ignored by target: ");
+      DEBUG_CARBON_EVENTS ("%s", "Event not sent to or ignored by target: ");
       debug_print_event (event_class, event_kind);
-      stderr_out ("\n");
+      DEBUG_CARBON_EVENTS ("%s", "\n");
     }
 }
 
@@ -922,6 +1060,10 @@
 vars_of_event_carbon (void)
 {
   /* reinit_vars_of_event_carbon (); */
+  DEFVAR_LISP ("mac-command-key-is-meta", &Vmac_command_key_is_meta /*
+Non-nil means that the command key is used as the XEmacs meta key.
+Otherwise the option key is used.  */ );
+  Vmac_command_key_is_meta = Qt;
 }
 
 void
Index: src/intl-carbon.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/intl-carbon.c,v
retrieving revision 1.1.2.3
diff -u -u -r1.1.2.3 intl-carbon.c
--- src/intl-carbon.c	2007/09/30 21:40:13	1.1.2.3
+++ src/intl-carbon.c	2007/10/19 06:58:10
@@ -20,13 +20,322 @@
 
 #include <config.h>
 #include "lisp.h"
+#include "text.h"
 
+#include <Carbon/Carbon.h>
+#include <ApplicationServices/ApplicationServices.h>
+
+Lisp_Object Vcarbon_current_language_unicode_set;
+
+#if !defined(__COREFOUNDATION_CFLOCALE__)
+typedef void* CFLocaleRef;
+#endif
+
+struct iso_lang_map
+{
+  Ascbyte*	iso_code;
+  short	mac_lang_code;
+  short	mac_script_code;
+};
+
+typedef struct iso_lang_map iso_lang_map;
+
+iso_lang_map lang_list[] = {
+  { "sq", langAlbanian, smRoman },
+  { "am", langAmharic, smEthiopic	},
+  { "ar", langArabic, smArabic },
+  { "hy", langArmenian, smArmenian},
+  { "as", langAssamese, smBengali },
+  { "ay", langAymara, smRoman},
+  { "eu", langBasque, smRoman},
+  { "bn", langBengali, smBengali },
+  { "dz", langDzongkha, smTibetan },
+  { "br", langBreton, smRoman },
+  { "bg", langBulgarian, smCyrillic },
+  { "my", langBurmese, smBurmese },
+  { "km", langKhmer, smKhmer },
+  { "ca", langCatalan, smRoman },
+  { "zh", langTradChinese, smTradChinese },
+  { "hr", langCroatian, smRoman },
+  { "cs", langCzech, smCentralEuroRoman },
+  { "da", langDanish, smRoman },
+  { "nl", langDutch, smRoman },
+  { "en", langEnglish, smRoman },
+  { "eo", langEsperanto, smRoman },
+  { "et", langEstonian, smCentralEuroRoman},
+  { "fo", langFaeroese, smRoman },
+  { "fa", langFarsi, smArabic },
+  { "fi", langFinnish, smRoman },
+  { "fr", langFrench, smRoman },
+  { "ka", langGeorgian, smGeorgian },
+  { "de", langGerman, smRoman },
+  { "el", langGreek, smGreek },
+  { "gn", langGuarani, smRoman },
+  { "gu", langGujarati, smGujarati },
+  { "he", langHebrew, smHebrew },
+  { "iw", langHebrew, smHebrew },
+  { "hu", langHungarian, smCentralEuroRoman },
+  { "is", langIcelandic, smRoman },
+  { "in", langIndonesian, smRoman },
+  { "id", langIndonesian,  smRoman },
+  { "iu", langInuktitut, smEthiopic },
+  { "ga", langIrish, smRoman },
+  { "it", langItalian, smRoman },
+  { "ja", langJapanese, smJapanese },
+  { "jw", langJavaneseRom, smRoman },
+  { "kn", langKannada, smKannada },
+  { "ks", langKashmiri, smArabic },
+  { "kk", langKazakh, smCyrillic },
+  { "ky", langKirghiz, smCyrillic },
+  { "ko", langKorean, smKorean },
+  { "ku", langKurdish, smArabic },
+  { "lo", langLao, smLao },
+  { "la", langLatin, smRoman },
+  { "lv", langLatvian, smCentralEuroRoman },
+  { "lt", langLithuanian, smCentralEuroRoman },
+  { "mk", langMacedonian, smCyrillic },
+  { "mg", langMalagasy, smRoman },
+  { "ml", langMalayalam, smMalayalam },
+  { "mt", langMaltese, smRoman },
+  { "mr", langMarathi, smDevanagari },
+  { "mo", langMoldavian, smCyrillic },
+  { "ne", langNepali, smDevanagari },
+  { "no", langNorwegian, smRoman },
+  { "or", langOriya, smOriya },
+  { "om", langOromo, smEthiopic },
+  { "ps", langPashto, smArabic },
+  { "pl", langPolish, smCentralEuroRoman },
+  { "pt", langPortuguese, smRoman },
+  { "pa", langPunjabi, smGurmukhi },
+  { "ro", langRomanian, smRoman },
+  { "ru", langRussian, smCyrillic },
+  { "sa", langSanskrit, smDevanagari },
+  { "sr", langSerbian, smCyrillic },
+  { "sd", langSindhi, smArabic },
+  { "si", langSinhalese, smSinhalese },
+  { "sk", langSlovak, smCentralEuroRoman },
+  { "sl", langSlovenian, smRoman },
+  { "so", langSomali, smRoman },
+  { "es", langSpanish, smRoman },
+  { "su", langSundaneseRom, smRoman },
+  { "sw", langSwahili, smRoman },
+  { "sv", langSwedish, smRoman },
+  { "tl", langTagalog, smRoman },
+  { "tg", langTajiki, smCyrillic },
+  { "ta", langTamil, smTamil },
+  { "tt", langTatar, smCyrillic },
+  { "te", langTelugu, smTelugu },
+  { "th", langThai, smThai },
+  { "bo", langTibetan, smTibetan },
+  { "ti", langTigrinya, smEthiopic },
+  { "tr", langTurkish, smRoman },
+  { "tk", langTurkmen, smCyrillic },
+  { "ug", langUighur, smCyrillic },
+  { "uk", langUkrainian, smCyrillic },
+  { "ur", langUrdu, smArabic },
+  { "uz", langUzbek, smCyrillic },
+  { "vi", langVietnamese, smVietnamese },
+  { "cy", langWelsh, smRoman },
+  { "ji", langYiddish, smHebrew },
+  { "yi", langYiddish, smHebrew },
+  { NULL, 0, 0}
+};
+
+struct iso_country_map
+{
+  Ascbyte* iso_code;
+  short	mac_region_code;
+};
+
+typedef struct iso_country_map iso_country_map;
+
+iso_country_map country_list[] = {
+  { "US", verUS},
+  { "EG", verArabic},
+  { "DZ", verArabic},
+  { "AU", verAustralia},
+  { "BE", verFrBelgium },
+  { "CA", verEngCanada },
+  { "CN", verChina },
+  { "HR", verYugoCroatian },
+  { "CY", verCyprus },
+  { "DK", verDenmark },
+  { "EE", verEstonia },
+  { "FI", verFinland },
+  { "FR", verFrance },
+  { "DE", verGermany },
+  { "EL", verGreece },
+  { "HU", verHungary },
+  { "IS", verIceland },
+  { "IN", verIndiaHindi},
+  { "IR", verIran },
+  { "IQ", verArabic },
+  { "IE", verIreland },
+  { "IL", verIsrael },
+  { "IT", verItaly },
+  { "JP", verJapan },
+  { "KP", verKorea },
+  { "LV", verLatvia },
+  { "LY", verArabic },
+  { "LT", verLithuania },
+  { "LU", verFrBelgiumLux },
+  { "MT", verMalta },
+  { "MA", verArabic },
+  { "NL", verNetherlands },
+  { "NO", verNorway },
+  { "PK", verPakistan },
+  { "PL", verPoland },
+  { "PT", verPortugal },
+  { "RU", verRussia },
+  { "SA", verArabic },
+  { "ES", verSpain },
+  { "SE", verSweden },
+  { "CH", verFrSwiss },
+  { "TW", verTaiwan},
+  { "TH", verThailand },
+  { "TN", verArabic},
+  { "TR", verTurkey },
+  { "GB", verBritain },
+  { NULL, 0 }
+};
+
+typedef CFLocaleRef (*fpCFLocaleCopyCurrent_type) (void);
+typedef CFStringRef (*fpCFLocaleGetIdentifier_type) (CFLocaleRef);
+
+static Ibyte *
+carbon_get_pseudo_posix_locale (short scriptCode, short langCode, short regionCode)
+{
+  int i;
+  Bytecount len;
+  int validResultFound = 0;
+  DECLARE_EISTRING (res);
+
+  /* parse language */
+  for (i=0; NULL != lang_list[i].iso_code; i++)
+    {
+      if (langCode == lang_list[i].mac_lang_code && 
+          scriptCode == lang_list[i].mac_script_code)
+        {
+          eicpy_ascii (res, lang_list[i].iso_code);
+          validResultFound = true;
+          break;
+        }
+    }
+
+  /* parse region */
+  for (i=0; NULL != country_list[i].iso_code; i++) 
+    {
+      if (regionCode==country_list[i].mac_region_code)
+        {
+          eicat_ch (res, '-');
+          eicat_ascii (res, country_list[i].iso_code);
+          validResultFound = true;
+          break;
+        }
+    }
+
+  if (validResultFound)
+    {
+      len = eilen (res);
+      return eicpyout_malloc (res, &len);
+    }
+
+  return NULL;
+}
+
 Lisp_Object Qcarbon_unicode;
 
+DEFUN ("carbon-current-locale", Fcarbon_current_locale, 0, 0, 0, /*
+Return the current OS X locale.
+
+This reflects the locale used by the Carbon programs on your system, and
+follows the POSIX format, that is, ab_BC, where ab is a language code and BC
+is a country code.
+*/
+       ())
+{
+  /* On MacOSX, the recommended way to get the user's current locale is to use
+     the CFLocale APIs.  However, these are only available on 10.3 and later.
+     So for the older systems, we have to keep using the Script Manager APIs. */
+  static int checked = 0;
+  static fpCFLocaleCopyCurrent_type fpCFLocaleCopyCurrent = NULL;
+  static fpCFLocaleGetIdentifier_type fpCFLocaleGetIdentifier = NULL;
+  Lisp_Object res = Qnil;
+
+  if (!checked)
+    {
+      CFBundleRef bundle =
+        CFBundleGetBundleWithIdentifier(CFSTR("com.apple.Carbon"));
+      if (bundle)
+        {
+          // We dynamically load these two functions and only use them if
+          // they are available (OS 10.3+).
+          fpCFLocaleCopyCurrent = (fpCFLocaleCopyCurrent_type)
+            CFBundleGetFunctionPointerForName(bundle,
+                                                CFSTR("CFLocaleCopyCurrent"));
+          fpCFLocaleGetIdentifier = (fpCFLocaleGetIdentifier_type)
+            CFBundleGetFunctionPointerForName(bundle,
+                                                CFSTR("CFLocaleGetIdentifier"));
+        }
+        checked = 1;
+    }
+
+  if (fpCFLocaleCopyCurrent)
+    {
+      // Get string representation of user's current locale
+      CFLocaleRef userLocaleRef = fpCFLocaleCopyCurrent();
+      CFStringRef userLocaleStr = fpCFLocaleGetIdentifier(userLocaleRef);
+      int size;
+      Extbyte *buf;
+
+      CFRetain(userLocaleStr);
+
+      size = CFStringGetLength(userLocaleStr);
+      size = (size + 1) * 2;
+      buf = alloca_extbytes (size);
+
+      if (!CFStringGetCString (userLocaleStr, (char *) buf, size,
+                                kCFStringEncodingUnicode))
+        {
+          signal_error (Qtext_conversion_error,
+                        "Error converting from Carbon text format for locale",
+                        Qunbound);
+        }
+
+      res = make_ext_string (buf, size - 2, Qcarbon_unicode);
+
+      CFRelease(userLocaleStr);
+      CFRelease(userLocaleRef);
+    }
+  else
+    {
+      /* Legacy MacOSX locale code */
+      long script = GetScriptManagerVariable(smSysScript);
+      long lang = GetScriptVariable(smSystemScript,smScriptLang);
+      long region = GetScriptManagerVariable(smRegionCode);
+
+      Ibyte *text = carbon_get_pseudo_posix_locale((short)script, (short)lang,
+                                                   (short)region);
+      if (text)
+        {
+          res = make_string (text, qxestrlen(text));
+        }
+    }
+  return res;
+}
+
 void
 syms_of_intl_carbon (void)
 {
+  DEFSUBR (Fcarbon_current_locale);
   DEFSYMBOL (Qcarbon_unicode);
+  DEFVAR_LISP ("carbon-current-language-unicode-set",
+               &Vcarbon_current_language_unicode_set /*
+Hash table mapping those Unicode code points needed for the current langenv to t.
+
+Can also be nil; if it is non-nil will normally include all of ASCII.
+*/);
+  Vcarbon_current_language_unicode_set = Qnil;
 }
 
 void
Index: src/scrollbar-carbon.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/scrollbar-carbon.c,v
retrieving revision 1.1.2.3
diff -u -u -r1.1.2.3 scrollbar-carbon.c
--- src/scrollbar-carbon.c	2007/09/30 19:48:31	1.1.2.3
+++ src/scrollbar-carbon.c	2007/10/19 06:58:10
@@ -307,7 +307,7 @@
 }
 
 static void
-carbon_update_scrollbar_instance_status (struct window *w, int active, int size, struct scrollbar_instance *sb)
+carbon_update_scrollbar_instance_status (struct window * UNUSED (w), int active, int size, struct scrollbar_instance *sb)
 {
   SetControlVisibility ((ControlRef) sb->scrollbar_data, active && size, TRUE);
 }

-- 
On the quay of the little Black Sea port, where the rescued pair came once
more into contact with civilization, Dobrinton was bitten by a dog which was
assumed to be mad, though it may only have been indiscriminating. (Saki)


 > 
 > Thanks,
 > 
 > Rodney
 > 
 > -----Original Message-----
 > From: Aidan Kehoe [mailto:kehoea at parhasard.net]
 > Sent: Thu 10/18/2007 4:53 PM
 > To: xemacs-patches at xemacs.org
 > Cc: Sparapani, Rodney
 > Subject: [PATCH] Add Carbon-specific locale-determination code; respect the locale with mac-command-key-is-meta behaviour
 >  
 > 
 > I don't propose to commit this right now, but I suppose it's worth posting
 > as a putative solution on the lines of
 > http://mid.gmane.org/18187.60360.900893.282407@parhasard.net . 
 > 
 > lisp/ChangeLog addition:
 > 
 > 2007-10-18  Aidan Kehoe  <kehoea at parhasard.net>
 > 
 > 	* mule/mule-cmds.el (init-locale-at-early-startup):
 > 	Use the Carbon locale if it is available.
 > 	* mule/mule-cmds.el (init-mule-at-startup):
 > 	Init carbon-current-language-unicode-set from the current language
 > 	environment's input method if necessary
 > 
 > 
 > src/ChangeLog addition:
 > 
 > 2007-10-18  Aidan Kehoe  <kehoea at parhasard.net>
 > 
 > 	* event-carbon.c:
 > 	Add much more debugging infrastructure. 
 > 	* event-carbon.c (carbon_modifiers_to_emacs_modifiers):
 > 	Support the Option key as meta. 
 > 	* event-carbon.c (retranslate_option):
 > 	Add; retranslate the option key if that is appropriate, that is,
 > 	if the character generated with option both:
 > 
 > 	1. Differs from the character generated without option and
 > 	2. Is either ASCII (because our users are programmers) or is necessary to
 > 	write the currently active language
 > 
 > 	then option + char-without-option should generate char-with-option;
 > 	otherwise option + char-without-option should generate
 > 	M-char-without-option.
 > 	
 > 	* event-carbon.c (text_input_event_handler):
 > 	* event-carbon.c (handle_apple_event):
 > 	* event-carbon.c (generic_send_event_to_target):
 > 	* event-carbon.c (vars_of_event_carbon):
 > 	Provide mac-command-key-is-meta.
 > 	
 > 	* intl-carbon.c:
 > 	* intl-carbon.c (carbon_get_pseudo_posix_locale):
 > 	New function, to pull a simulacrum of the current Carbon locale in
 > 	POSIX form based on the script, language and region codes. 
 > 	* intl-carbon.c (Fcarbon_current_locale):
 > 	New function, on the model of mswindows-current-locale; algorithm
 > 	and code based on that of Mozilla. 
 > 	* intl-carbon.c (syms_of_intl_carbon):
 > 	Make carbon-current-locale available. 
 > 	* scrollbar-carbon.c (carbon_update_scrollbar_instance_status):
 > 	First argument is unused, mark it as so for the sake of the
 > 	compiler. 
 > 
 > 
 > XEmacs Trunk source patch:
 > Diff command:   cvs -q diff -Nu
 > Files affected: src/scrollbar-carbon.c
 > ===================================================================
 > RCS src/intl-carbon.c
 > ===================================================================
 > RCS src/event-carbon.c
 > ===================================================================
 > RCS lisp/mule/mule-cmds.el
 > ===================================================================
 > RCS
 > 
 > Index: lisp/mule/mule-cmds.el
 > ===================================================================
 > RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/mule-cmds.el,v
 > retrieving revision 1.23.2.1
 > diff -u -u -r1.23.2.1 mule-cmds.el
 > --- lisp/mule/mule-cmds.el	2007/09/30 18:33:20	1.23.2.1
 > +++ lisp/mule/mule-cmds.el	2007/10/18 21:44:11
 > @@ -1464,17 +1464,25 @@
 >  	(declare-fboundp (mswindows-set-current-locale userdef)))
 >        ;; Unix:
 >        (let (locstring)
 > -	;; Init the POSIX locale from the environment--this calls the C
 > -	;; library's setlocale(3).
 > -	(set-current-locale "")
 > -	;; Can't let locstring be the result of (set-current-locale "")
 > -	;; because that can return a more detailed string than we know how
 > -	;; to handle.
 > -	(setq locstring (current-locale)
 > -	      ;; assume C lib locale and LANG env var are set correctly.
 > -	      ;; use them to find the langenv.
 > -	      langenv
 > - 	      (and locstring (get-language-environment-from-locale
 > +	(unless (and-fboundp 
 > +		    #'carbon-current-locale
 > +		  ;; If Carbon provides us with the locale string, we want
 > +		  ;; to use that, instead of the code that checks the
 > +		  ;; C environment below.
 > +		  (setq locstring 
 > +			(carbon-current-locale)))
 > +	  ;; Init the POSIX locale from the environment--this calls the C
 > +	  ;; library's setlocale(3).
 > +	  (set-current-locale "")
 > +	  ;; Can't let locstring be the result of (set-current-locale "")
 > +	  ;; because that can return a more detailed string than we know how
 > +	  ;; to handle.
 > +	  (setq locstring (current-locale)))
 > +
 > +	;; assume C lib locale and LANG env var are set correctly.
 > +	;; use them to find the langenv.
 > +	(setq langenv
 > +	      (and locstring (get-language-environment-from-locale
 >   			      locstring)))))
 >      ;; All systems:
 >      (unless langenv (setq langenv "English"))
 > @@ -1515,8 +1523,36 @@
 >      (setq Manual-use-rosetta-man nil))
 >    
 >    ;; Register available input methods by loading LEIM list file.
 > -  (load "leim-list.el" 'noerror 'nomessage 'nosuffix)
 > -  )
 > +  (load leim-list-file-name 'noerror 'nomessage 'nosuffix)
 > +
 > +  (when-boundp 'carbon-current-language-unicode-set
 > +    (unless carbon-current-language-unicode-set
 > +      (setq carbon-current-language-unicode-set
 > +            (make-hash-table :size 256)))
 > +    (loop
 > +      for i from #x20 to #x7e
 > +      do (puthash i t carbon-current-language-unicode-set))
 > +    (let ((input-method (get-language-info current-language-environment 'input-method)))
 > +      (when (assoc input-method input-method-alist)
 > +        (flet ((map-tree 
 > +                 (tree)
 > +                 (loop for branch in tree
 > +                   do
 > +                   (cond ((consp branch)
 > +                          (map-tree branch))
 > +                         ((or (stringp branch) (vectorp branch))
 > +                          (map-tree (append branch nil)))
 > +                         ((characterp branch)
 > +                          (unless (< branch #x80)
 > +                            (puthash (encode-char branch 'ucs) t
 > +                                     carbon-current-language-unicode-set))))))
 > +               (append-message (&rest args) ())
 > +               (clear-message (&rest args) ()))
 > +          (set-input-method input-method)
 > +          (loop for mapped in (mapcar #'cdr (cdr (quail-map)))
 > +            do
 > +            (map-tree mapped)))
 > +        (inactivate-input-method)))))
 >  
 >  ;; Code deleted: init-mule-tm (Enable the tm package by default)
 >  
 > Index: src/event-carbon.c
 > ===================================================================
 > RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/event-carbon.c,v
 > retrieving revision 1.1.2.3
 > diff -u -u -r1.1.2.3 event-carbon.c
 > --- src/event-carbon.c	2007/09/30 19:48:26	1.1.2.3
 > +++ src/event-carbon.c	2007/10/18 21:44:11
 > @@ -30,13 +30,31 @@
 >  
 >  #include "console-carbon-impl.h"
 >  
 > +#ifdef DEBUG_XEMACS
 > +static Fixnum debug_carbon_events;
 > +# define DEBUG_CARBON_EVENTS(FORMAT, ...)  \
 > +     do { if (debug_carbon_events) stderr_out(FORMAT, __VA_ARGS__); } while (0)
 > +#else  /* DEBUG_XEMACS */
 > +# define DEBUG_CARBON_EVENTS(format, ...)
 > +#endif /* DEBUG_XEMACS */
 > +
 > +
 > +#ifdef DEBUG_XEMACS
 > +extern Fixnum debug_emacs_events;
 > +#endif 
 > +
 >  EXFUN (Funicode_to_char, 2);  /* In unicode.c.  */
 >  
 > +extern Lisp_Object Vcarbon_current_language_unicode_set;
 > +
 >  extern Lisp_Object Qcarbon_unicode;  /* From intl-carbon.c.  */
 >  
 >  extern SELECT_TYPE process_only_mask;  /* From event-unixoid.c.  */
 >  extern int track_mouse_down_on_scrollbar (void);  /* from scrollbar-carbon.c.  */
 >  
 > +/* true if using command key as meta key */
 > +Lisp_Object Vmac_command_key_is_meta;
 > +
 >  static struct event_stream *carbon_event_stream;
 >  
 >  static Lisp_Object carbon_user_event_queue;
 > @@ -50,8 +68,6 @@
 >  
 >  static EventLoopTimerUPP timer_proc_UPP;
 >  
 > -static int debug_carbon_events = 0;
 > -
 >  /* Used in frame-carbon.c.  */
 >  void carbon_enqueue_user_event (Lisp_Object);
 >  
 > @@ -250,7 +266,7 @@
 >  {
 >    int emacs_modifiers = 0;
 >    
 > -  if (modifiers & cmdKey)
 > +  if (modifiers & (NILP (Vmac_command_key_is_meta) ? optionKey : cmdKey))
 >      emacs_modifiers |= XEMACS_MOD_META;
 >    if (modifiers & controlKey)
 >      emacs_modifiers |= XEMACS_MOD_CONTROL;
 > @@ -343,6 +359,108 @@
 >      }
 >  }
 >  
 > +static void
 > +retranslate_option (EventRef keyboard_event, UInt32 modifiers,
 > +                    UniChar *text, UInt32 text_size)
 > +{
 > +  UInt32 new_modifiers = modifiers & ~optionKey;
 > +  UInt32 keycode;
 > +  KeyboardLayoutRef layoutRef;
 > +  KeyboardLayoutKind layout_kind;
 > +
 > +  GetEventParameter (keyboard_event, kEventParamKeyCode, typeUInt32, NULL,
 > +                     sizeof (keycode), NULL, &keycode);
 > +  
 > +  if (KLGetCurrentKeyboardLayout (&layoutRef) != noErr)
 > +    invalid_operation ("Can't get keyboard layout ref", Qunbound);
 > +  
 > +  if (KLGetKeyboardLayoutProperty (layoutRef, kKLKind,
 > +                                   (const void **)&layout_kind) != noErr)
 > +    invalid_operation ("Can't get keyboard layout kind", Qunbound);
 > +
 > +  /* Depending on whether KCHR or uchr keyboard layout data is
 > +     available, call KeyTranslate or UCKeyTranslate to determine the
 > +     actual character code that should be enqueued.  */
 > +  if (layout_kind == kKLKCHRKind)
 > +    {
 > +      void *kchr_ptr;
 > +      UInt16 new_keycode;
 > +      static UInt32 deadKeyState = 0;
 > +      UniChar char_code;
 > +
 > +      DEBUG_CARBON_EVENTS ("%s", "layout kind is KCHR\n");
 > +
 > +      if (KLGetKeyboardLayoutProperty (layoutRef, kKLKCHRData,
 > +                                       (const void **)&kchr_ptr) != noErr)
 > +	invalid_operation ("Can't get KCHR keyboard layout", Qunbound);
 > +    
 > +      new_keycode = new_modifiers & 0xff00;
 > +
 > +      if (GetEventKind (keyboard_event) == kEventRawKeyUp)
 > +	new_keycode |= (1 << 7);
 > +      
 > +      new_keycode |= (keycode & 0x7f);
 > +      
 > +      deadKeyState = 0;
 > +      char_code = KeyTranslate (kchr_ptr, new_keycode, &deadKeyState);
 > +
 > +      DEBUG_CARBON_EVENTS ("char_code is %x, text[0] is %x, check is %x\n",
 > +                           char_code, text[0], 
 > +                           (!NILP (Vcarbon_current_language_unicode_set) &&
 > +                            !NILP (Fgethash (make_int (text[0]), 
 > +                                             Vcarbon_current_language_unicode_set, Qnil))));
 > +
 > +      if (2 == text_size && char_code != text[0] && 
 > +          (!NILP (Vcarbon_current_language_unicode_set) &&
 > +           !NILP (Fgethash (make_int (text[0]), 
 > +                            Vcarbon_current_language_unicode_set, Qnil))))
 > +        {
 > +          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, are modifying event\n");
 > +          enqueue_input (text, text_size / 2, new_modifiers);
 > +        }
 > +      else
 > +        {
 > +          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, not modifying event\n");
 > +          enqueue_input (&char_code, 1, modifiers);
 > +        }
 > +    }
 > +  else /* layout_kind == kKLuchrKind || layout_kind == kKLKCHRuchrKind */
 > +    {
 > +      UCKeyboardLayout *layout;
 > +      static UInt32 deadKeyState = 0;
 > +      UniChar output[16];
 > +      UniCharCount output_length;
 > +
 > +      DEBUG_CARBON_EVENTS ("%s", "layout kind is Unicode\n");
 > +
 > +      if (KLGetKeyboardLayoutProperty (layoutRef, kKLuchrData,
 > +                                       (const void**)&layout) != noErr)
 > +	invalid_operation ("Can't get uchr keyboard layout", Qunbound);
 > +      
 > +      if (UCKeyTranslate (layout, keycode, kUCKeyActionDown, new_modifiers >> 8,
 > +                          LMGetKbdType (), 0, &deadKeyState, 16,
 > +                          &output_length, output) != noErr)
 > +	invalid_operation ("Can't translate key using uchr", Qunbound);
 > +      
 > +      DEBUG_CARBON_EVENTS ("output[0] is %x, text[0] is %x\n", output[0], text[0]);
 > +
 > +
 > +      if (2 == text_size && char_code != text[0] && 
 > +          (!NILP (Vcarbon_current_language_unicode_set) &&
 > +           !NILP (Fgethash (make_int (text[0]), 
 > +                            Vcarbon_current_language_unicode_set, Qnil))))
 > +        {
 > +          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, are modifying event\n");
 > +          enqueue_input (text, text_size / 2, new_modifiers);
 > +        }
 > +      else
 > +        {
 > +          DEBUG_CARBON_EVENTS ("%s", "with a normal keylayout, not modifying event\n");
 > +          enqueue_input (&char_code, 1, modifiers);
 > +        }
 > +    }
 > +}
 > +
 >  static char *ascii_to_keysymstr_table[] = {
 >    /*0x00*/ 0, "home", 0, "kp-enter", "end", "help", 0, 0,
 >    /*0x08*/ "backspace", "tab", 0, "prior", "next", "return", 0, 0,
 > @@ -419,34 +537,49 @@
 >    UniChar *text = (UniChar *)alloca_extbytes (text_size);
 >    if (GetEventParameter (event, kEventParamTextInputSendText, typeUnicodeText, NULL, text_size, NULL, text) != noErr)
 >      invalid_operation ("Can't get input text", Qunbound);
 > +
 > +  DEBUG_CARBON_EVENTS ("modifiers are %x, keycode is %x, text_size is %x\n",
 > +                       modifiers, keycode, text_size);
 > +  DEBUG_CARBON_EVENTS ("optionKey is %x\n",
 > +                       optionKey);
 > +
 > +  if (text_size == 2 && text[0] <= 127 && 
 > +      (modifiers & (controlKey | cmdKey)) && keycode_needs_retranslate[keycode])
 > +    {
 > +      retranslate_keycode (keyboard_event, modifiers);
 > +      return noErr;
 > +    }
 >    
 > +  if (NILP(Vmac_command_key_is_meta) && (modifiers & optionKey))
 > +    {
 > +      DEBUG_CARBON_EVENTS ("%s", 
 > +                           "command key is not meta, and the modifiers include option\n");
 > +      retranslate_option (keyboard_event, modifiers, text, text_size);
 > +      return noErr;
 > +    }
 > +
 >    if (text_size == 2 && text[0] <= 127)
 >      {
 > -      if ((modifiers & (controlKey | cmdKey)) && keycode_needs_retranslate[keycode])
 > -	retranslate_keycode (keyboard_event, modifiers);
 > +      char *keysymstr = ascii_to_keysymstr_table[text[0]];
 > +      if (keysymstr)
 > +        enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
 >        else
 > -	{
 > -	  char *keysymstr = ascii_to_keysymstr_table[text[0]];
 > -	  if (keysymstr)
 > -	    enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
 > -	  else
 > -	    {
 > -	      if (ascii_needs_keycode_lookup[text[0]])
 > -		{
 > -		  char *keysymstr = keycode_to_keysymstr_table[keycode];
 > -		  if (keysymstr)
 > -		    enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
 > -		  else
 > -		    enqueue_input (text, text_size / 2, modifiers);
 > -		}
 > -	      else
 > -		enqueue_input (text, text_size / 2, modifiers);
 > -	    }
 > -	}
 > +        {
 > +          if (ascii_needs_keycode_lookup[text[0]])
 > +            {
 > +              char *keysymstr = keycode_to_keysymstr_table[keycode];
 > +              if (keysymstr)
 > +                enqueue_one_input_event (KEYSYM (keysymstr), carbon_modifiers_to_emacs_modifiers (modifiers));
 > +              else
 > +                enqueue_input (text, text_size / 2, modifiers);
 > +            }
 > +          else
 > +            enqueue_input (text, text_size / 2, modifiers);
 > +        }
 > +      return noErr;
 >      }
 > -  else
 > -    enqueue_input (text, text_size / 2, modifiers);
 > - 
 > +
 > +  enqueue_input (text, text_size / 2, modifiers);
 >    return noErr;
 >  }
 >  
 > @@ -503,8 +636,12 @@
 >      stderr_out ("Can't convert to event record.\n");
 >    
 >    OSErr s = AEProcessAppleEvent (&event_record);
 > -  if (s != noErr && debug_carbon_events)
 > -    stderr_out ("Apple event not processed (error = %d).\n", s);
 > +  
 > +
 > +  if (s != noErr)
 > +    {
 > +      DEBUG_CARBON_EVENTS ("Apple event not processed (error = %d).\n", s);
 > +    }
 >  }
 >  
 >  static void
 > @@ -517,9 +654,9 @@
 >        EventClass event_class = GetEventClass (event);
 >        UInt32 event_kind = GetEventKind (event);
 >  
 > -      stderr_out ("Event not sent to or ignored by target: ");
 > +      DEBUG_CARBON_EVENTS ("%s", "Event not sent to or ignored by target: ");
 >        debug_print_event (event_class, event_kind);
 > -      stderr_out ("\n");
 > +      DEBUG_CARBON_EVENTS ("%s", "\n");
 >      }
 >  }
 >  
 > @@ -922,6 +1059,10 @@
 >  vars_of_event_carbon (void)
 >  {
 >    /* reinit_vars_of_event_carbon (); */
 > +  DEFVAR_LISP ("mac-command-key-is-meta", &Vmac_command_key_is_meta /*
 > +Non-nil means that the command key is used as the XEmacs meta key.
 > +Otherwise the option key is used.  */ );
 > +  Vmac_command_key_is_meta = Qt;
 >  }
 >  
 >  void
 > Index: src/intl-carbon.c
 > ===================================================================
 > RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/intl-carbon.c,v
 > retrieving revision 1.1.2.3
 > diff -u -u -r1.1.2.3 intl-carbon.c
 > --- src/intl-carbon.c	2007/09/30 21:40:13	1.1.2.3
 > +++ src/intl-carbon.c	2007/10/18 21:44:12
 > @@ -20,13 +20,322 @@
 >  
 >  #include <config.h>
 >  #include "lisp.h"
 > +#include "text.h"
 >  
 > +#include <Carbon/Carbon.h>
 > +#include <ApplicationServices/ApplicationServices.h>
 > +
 > +Lisp_Object Vcarbon_current_language_unicode_set;
 > +
 > +#if !defined(__COREFOUNDATION_CFLOCALE__)
 > +typedef void* CFLocaleRef;
 > +#endif
 > +
 > +struct iso_lang_map
 > +{
 > +  Ascbyte*	iso_code;
 > +  short	mac_lang_code;
 > +  short	mac_script_code;
 > +};
 > +
 > +typedef struct iso_lang_map iso_lang_map;
 > +
 > +iso_lang_map lang_list[] = {
 > +  { "sq", langAlbanian, smRoman },
 > +  { "am", langAmharic, smEthiopic	},
 > +  { "ar", langArabic, smArabic },
 > +  { "hy", langArmenian, smArmenian},
 > +  { "as", langAssamese, smBengali },
 > +  { "ay", langAymara, smRoman},
 > +  { "eu", langBasque, smRoman},
 > +  { "bn", langBengali, smBengali },
 > +  { "dz", langDzongkha, smTibetan },
 > +  { "br", langBreton, smRoman },
 > +  { "bg", langBulgarian, smCyrillic },
 > +  { "my", langBurmese, smBurmese },
 > +  { "km", langKhmer, smKhmer },
 > +  { "ca", langCatalan, smRoman },
 > +  { "zh", langTradChinese, smTradChinese },
 > +  { "hr", langCroatian, smRoman },
 > +  { "cs", langCzech, smCentralEuroRoman },
 > +  { "da", langDanish, smRoman },
 > +  { "nl", langDutch, smRoman },
 > +  { "en", langEnglish, smRoman },
 > +  { "eo", langEsperanto, smRoman },
 > +  { "et", langEstonian, smCentralEuroRoman},
 > +  { "fo", langFaeroese, smRoman },
 > +  { "fa", langFarsi, smArabic },
 > +  { "fi", langFinnish, smRoman },
 > +  { "fr", langFrench, smRoman },
 > +  { "ka", langGeorgian, smGeorgian },
 > +  { "de", langGerman, smRoman },
 > +  { "el", langGreek, smGreek },
 > +  { "gn", langGuarani, smRoman },
 > +  { "gu", langGujarati, smGujarati },
 > +  { "he", langHebrew, smHebrew },
 > +  { "iw", langHebrew, smHebrew },
 > +  { "hu", langHungarian, smCentralEuroRoman },
 > +  { "is", langIcelandic, smRoman },
 > +  { "in", langIndonesian, smRoman },
 > +  { "id", langIndonesian,  smRoman },
 > +  { "iu", langInuktitut, smEthiopic },
 > +  { "ga", langIrish, smRoman },
 > +  { "it", langItalian, smRoman },
 > +  { "ja", langJapanese, smJapanese },
 > +  { "jw", langJavaneseRom, smRoman },
 > +  { "kn", langKannada, smKannada },
 > +  { "ks", langKashmiri, smArabic },
 > +  { "kk", langKazakh, smCyrillic },
 > +  { "ky", langKirghiz, smCyrillic },
 > +  { "ko", langKorean, smKorean },
 > +  { "ku", langKurdish, smArabic },
 > +  { "lo", langLao, smLao },
 > +  { "la", langLatin, smRoman },
 > +  { "lv", langLatvian, smCentralEuroRoman },
 > +  { "lt", langLithuanian, smCentralEuroRoman },
 > +  { "mk", langMacedonian, smCyrillic },
 > +  { "mg", langMalagasy, smRoman },
 > +  { "ml", langMalayalam, smMalayalam },
 > +  { "mt", langMaltese, smRoman },
 > +  { "mr", langMarathi, smDevanagari },
 > +  { "mo", langMoldavian, smCyrillic },
 > +  { "ne", langNepali, smDevanagari },
 > +  { "no", langNorwegian, smRoman },
 > +  { "or", langOriya, smOriya },
 > +  { "om", langOromo, smEthiopic },
 > +  { "ps", langPashto, smArabic },
 > +  { "pl", langPolish, smCentralEuroRoman },
 > +  { "pt", langPortuguese, smRoman },
 > +  { "pa", langPunjabi, smGurmukhi },
 > +  { "ro", langRomanian, smRoman },
 > +  { "ru", langRussian, smCyrillic },
 > +  { "sa", langSanskrit, smDevanagari },
 > +  { "sr", langSerbian, smCyrillic },
 > +  { "sd", langSindhi, smArabic },
 > +  { "si", langSinhalese, smSinhalese },
 > +  { "sk", langSlovak, smCentralEuroRoman },
 > +  { "sl", langSlovenian, smRoman },
 > +  { "so", langSomali, smRoman },
 > +  { "es", langSpanish, smRoman },
 > +  { "su", langSundaneseRom, smRoman },
 > +  { "sw", langSwahili, smRoman },
 > +  { "sv", langSwedish, smRoman },
 > +  { "tl", langTagalog, smRoman },
 > +  { "tg", langTajiki, smCyrillic },
 > +  { "ta", langTamil, smTamil },
 > +  { "tt", langTatar, smCyrillic },
 > +  { "te", langTelugu, smTelugu },
 > +  { "th", langThai, smThai },
 > +  { "bo", langTibetan, smTibetan },
 > +  { "ti", langTigrinya, smEthiopic },
 > +  { "tr", langTurkish, smRoman },
 > +  { "tk", langTurkmen, smCyrillic },
 > +  { "ug", langUighur, smCyrillic },
 > +  { "uk", langUkrainian, smCyrillic },
 > +  { "ur", langUrdu, smArabic },
 > +  { "uz", langUzbek, smCyrillic },
 > +  { "vi", langVietnamese, smVietnamese },
 > +  { "cy", langWelsh, smRoman },
 > +  { "ji", langYiddish, smHebrew },
 > +  { "yi", langYiddish, smHebrew },
 > +  { NULL, 0, 0}
 > +};
 > +
 > +struct iso_country_map
 > +{
 > +  Ascbyte* iso_code;
 > +  short	mac_region_code;
 > +};
 > +
 > +typedef struct iso_country_map iso_country_map;
 > +
 > +iso_country_map country_list[] = {
 > +  { "US", verUS},
 > +  { "EG", verArabic},
 > +  { "DZ", verArabic},
 > +  { "AU", verAustralia},
 > +  { "BE", verFrBelgium },
 > +  { "CA", verEngCanada },
 > +  { "CN", verChina },
 > +  { "HR", verYugoCroatian },
 > +  { "CY", verCyprus },
 > +  { "DK", verDenmark },
 > +  { "EE", verEstonia },
 > +  { "FI", verFinland },
 > +  { "FR", verFrance },
 > +  { "DE", verGermany },
 > +  { "EL", verGreece },
 > +  { "HU", verHungary },
 > +  { "IS", verIceland },
 > +  { "IN", verIndiaHindi},
 > +  { "IR", verIran },
 > +  { "IQ", verArabic },
 > +  { "IE", verIreland },
 > +  { "IL", verIsrael },
 > +  { "IT", verItaly },
 > +  { "JP", verJapan },
 > +  { "KP", verKorea },
 > +  { "LV", verLatvia },
 > +  { "LY", verArabic },
 > +  { "LT", verLithuania },
 > +  { "LU", verFrBelgiumLux },
 > +  { "MT", verMalta },
 > +  { "MA", verArabic },
 > +  { "NL", verNetherlands },
 > +  { "NO", verNorway },
 > +  { "PK", verPakistan },
 > +  { "PL", verPoland },
 > +  { "PT", verPortugal },
 > +  { "RU", verRussia },
 > +  { "SA", verArabic },
 > +  { "ES", verSpain },
 > +  { "SE", verSweden },
 > +  { "CH", verFrSwiss },
 > +  { "TW", verTaiwan},
 > +  { "TH", verThailand },
 > +  { "TN", verArabic},
 > +  { "TR", verTurkey },
 > +  { "GB", verBritain },
 > +  { NULL, 0 }
 > +};
 > +
 > +typedef CFLocaleRef (*fpCFLocaleCopyCurrent_type) (void);
 > +typedef CFStringRef (*fpCFLocaleGetIdentifier_type) (CFLocaleRef);
 > +
 > +static Ibyte *
 > +carbon_get_pseudo_posix_locale (short scriptCode, short langCode, short regionCode)
 > +{
 > +  int i;
 > +  Bytecount len;
 > +  int validResultFound = 0;
 > +  DECLARE_EISTRING (res);
 > +
 > +  /* parse language */
 > +  for (i=0; NULL != lang_list[i].iso_code; i++)
 > +    {
 > +      if (langCode == lang_list[i].mac_lang_code && 
 > +          scriptCode == lang_list[i].mac_script_code)
 > +        {
 > +          eicpy_ascii (res, lang_list[i].iso_code);
 > +          validResultFound = true;
 > +          break;
 > +        }
 > +    }
 > +
 > +  /* parse region */
 > +  for (i=0; NULL != country_list[i].iso_code; i++) 
 > +    {
 > +      if (regionCode==country_list[i].mac_region_code)
 > +        {
 > +          eicat_ch (res, '-');
 > +          eicat_ascii (res, country_list[i].iso_code);
 > +          validResultFound = true;
 > +          break;
 > +        }
 > +    }
 > +
 > +  if (validResultFound)
 > +    {
 > +      len = eilen (res);
 > +      return eicpyout_malloc (res, &len);
 > +    }
 > +
 > +  return NULL;
 > +}
 > +
 >  Lisp_Object Qcarbon_unicode;
 >  
 > +DEFUN ("carbon-current-locale", Fcarbon_current_locale, 0, 0, 0, /*
 > +Return the current OS X locale.
 > +
 > +This reflects the locale used by the Carbon programs on your system, and
 > +follows the POSIX format, that is, ab_BC, where ab is a language code and BC
 > +is a country code.
 > +*/
 > +       ())
 > +{
 > +  /* On MacOSX, the recommended way to get the user's current locale is to use
 > +     the CFLocale APIs.  However, these are only available on 10.3 and later.
 > +     So for the older systems, we have to keep using the Script Manager APIs. */
 > +  static int checked = 0;
 > +  static fpCFLocaleCopyCurrent_type fpCFLocaleCopyCurrent = NULL;
 > +  static fpCFLocaleGetIdentifier_type fpCFLocaleGetIdentifier = NULL;
 > +  Lisp_Object res = Qnil;
 > +
 > +  if (!checked)
 > +    {
 > +      CFBundleRef bundle =
 > +        CFBundleGetBundleWithIdentifier(CFSTR("com.apple.Carbon"));
 > +      if (bundle)
 > +        {
 > +          // We dynamically load these two functions and only use them if
 > +          // they are available (OS 10.3+).
 > +          fpCFLocaleCopyCurrent = (fpCFLocaleCopyCurrent_type)
 > +            CFBundleGetFunctionPointerForName(bundle,
 > +                                                CFSTR("CFLocaleCopyCurrent"));
 > +          fpCFLocaleGetIdentifier = (fpCFLocaleGetIdentifier_type)
 > +            CFBundleGetFunctionPointerForName(bundle,
 > +                                                CFSTR("CFLocaleGetIdentifier"));
 > +        }
 > +        checked = 1;
 > +    }
 > +
 > +  if (fpCFLocaleCopyCurrent)
 > +    {
 > +      // Get string representation of user's current locale
 > +      CFLocaleRef userLocaleRef = fpCFLocaleCopyCurrent();
 > +      CFStringRef userLocaleStr = fpCFLocaleGetIdentifier(userLocaleRef);
 > +      int size;
 > +      Extbyte *buf;
 > +
 > +      CFRetain(userLocaleStr);
 > +
 > +      size = CFStringGetLength(userLocaleStr);
 > +      size = (size + 1) * 2;
 > +      buf = alloca_extbytes (size);
 > +
 > +      if (!CFStringGetCString (userLocaleStr, (char *) buf, size,
 > +                                kCFStringEncodingUnicode))
 > +        {
 > +          signal_error (Qtext_conversion_error,
 > +                        "Error converting from Carbon text format for locale",
 > +                        Qunbound);
 > +        }
 > +
 > +      res = make_ext_string (buf, size - 2, Qcarbon_unicode);
 > +
 > +      CFRelease(userLocaleStr);
 > +      CFRelease(userLocaleRef);
 > +    }
 > +  else
 > +    {
 > +      /* Legacy MacOSX locale code */
 > +      long script = GetScriptManagerVariable(smSysScript);
 > +      long lang = GetScriptVariable(smSystemScript,smScriptLang);
 > +      long region = GetScriptManagerVariable(smRegionCode);
 > +
 > +      Ibyte *text = carbon_get_pseudo_posix_locale((short)script, (short)lang,
 > +                                                   (short)region);
 > +      if (text)
 > +        {
 > +          res = make_string (text, qxestrlen(text));
 > +        }
 > +    }
 > +  return res;
 > +}
 > +
 >  void
 >  syms_of_intl_carbon (void)
 >  {
 > +  DEFSUBR (Fcarbon_current_locale);
 >    DEFSYMBOL (Qcarbon_unicode);
 > +  DEFVAR_LISP ("carbon-current-language-unicode-set",
 > +               &Vcarbon_current_language_unicode_set /*
 > +Hash table mapping those Unicode code points needed for the current langenv to t.
 > +
 > +Can also be nil; if it is non-nil will normally include all of ASCII.
 > +*/);
 > +  Vcarbon_current_language_unicode_set = Qnil;
 >  }
 >  
 >  void
 > Index: src/scrollbar-carbon.c
 > ===================================================================
 > RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/scrollbar-carbon.c,v
 > retrieving revision 1.1.2.3
 > diff -u -u -r1.1.2.3 scrollbar-carbon.c
 > --- src/scrollbar-carbon.c	2007/09/30 19:48:31	1.1.2.3
 > +++ src/scrollbar-carbon.c	2007/10/18 21:44:12
 > @@ -307,7 +307,7 @@
 >  }
 >  
 >  static void
 > -carbon_update_scrollbar_instance_status (struct window *w, int active, int size, struct scrollbar_instance *sb)
 > +carbon_update_scrollbar_instance_status (struct window * UNUSED (w), int active, int size, struct scrollbar_instance *sb)
 >  {
 >    SetControlVisibility ((ControlRef) sb->scrollbar_data, active && size, TRUE);
 >  }
 > 
 > -- 
 > On the quay of the little Black Sea port, where the rescued pair came once
 > more into contact with civilization, Dobrinton was bitten by a dog which was
 > assumed to be mad, though it may only have been indiscriminating. (Saki)

-- 
On the quay of the little Black Sea port, where the rescued pair came once
more into contact with civilization, Dobrinton was bitten by a dog which was
assumed to be mad, though it may only have been indiscriminating. (Saki)



More information about the XEmacs-Beta mailing list