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

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

Thanks, Rodney -----Original Message----- From: Aidan Kehoe [mailto:kehoea＠parhasard.net] Sent: Thu 10/18/2007 4:53 PM To: xemacs-patches(a)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(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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)