[PATCH] Add Carbon-specific locale-determination code; respect the locale with mac-command-key-is-meta behaviour
Aidan Kehoe
kehoea at parhasard.net
Thu Oct 18 17:53:27 EDT 2007
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)
More information about the XEmacs-Patches
mailing list