X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/eb32b2921764763812938e96aef033e52edd38dc..c7fea3257f7198b8381dc4ec39c1a306042610ce:/src/mac.c diff --git a/src/mac.c b/src/mac.c index 0a1b94eb2c..40bbacf15c 100644 --- a/src/mac.c +++ b/src/mac.c @@ -1,5 +1,6 @@ /* Unix emulation routines for GNU Emacs on the Mac OS. - Copyright (C) 2000, 2001 Free Software Foundation, Inc. + Copyright (C) 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,8 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* Contributed by Andrew Choi (akochoi@mac.com). */ @@ -24,20 +25,19 @@ Boston, MA 02111-1307, USA. */ #include #include -#include #include "lisp.h" #include "process.h" -#include "sysselect.h" +#undef init_process #include "systime.h" +#include "sysselect.h" #include "blockinput.h" #include "macterm.h" -#if TARGET_API_MAC_CARBON #include "charset.h" #include "coding.h" -#else /* not TARGET_API_MAC_CARBON */ +#if !TARGET_API_MAC_CARBON #include #include #include @@ -53,17 +53,16 @@ Boston, MA 02111-1307, USA. */ #include #include #include +#include #endif /* not TARGET_API_MAC_CARBON */ #include #include #include #include -#include #include #include #include -#include #include #if __MWERKS__ #include @@ -80,6 +79,8 @@ static ComponentInstance as_scripting_component; /* The single script context used for all script executions. */ static OSAID as_script_context; +static OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *)); +static OSErr fsspec_to_posix_pathname P_ ((const FSSpec *, char *, int)); /* When converting from Mac to Unix pathnames, /'s in folder names are converted to :'s. This function, used in copying folder names, @@ -259,6 +260,448 @@ posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen) } +/*********************************************************************** + Conversions on Apple event objects + ***********************************************************************/ + +static Lisp_Object Qundecoded_file_name; + +static Lisp_Object +mac_aelist_to_lisp (desc_list) + AEDescList *desc_list; +{ + OSErr err; + long count; + Lisp_Object result, elem; + DescType desc_type; + Size size; + AEKeyword keyword; + AEDesc desc; + + err = AECountItems (desc_list, &count); + if (err != noErr) + return Qnil; + result = Qnil; + while (count > 0) + { + err = AESizeOfNthItem (desc_list, count, &desc_type, &size); + if (err == noErr) + switch (desc_type) + { + case typeAEList: + case typeAERecord: + case typeAppleEvent: + err = AEGetNthDesc (desc_list, count, typeWildCard, + &keyword, &desc); + if (err != noErr) + break; + elem = mac_aelist_to_lisp (&desc); + AEDisposeDesc (&desc); + break; + + default: + if (desc_type == typeNull) + elem = Qnil; + else + { + elem = make_uninit_string (size); + err = AEGetNthPtr (desc_list, count, typeWildCard, &keyword, + &desc_type, SDATA (elem), size, &size); + } + if (err != noErr) + break; + desc_type = EndianU32_NtoB (desc_type); + elem = Fcons (make_unibyte_string ((char *) &desc_type, 4), elem); + break; + } + + if (err != noErr) + elem = Qnil; + else if (desc_list->descriptorType != typeAEList) + { + keyword = EndianU32_NtoB (keyword); + elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem); + } + + result = Fcons (elem, result); + count--; + } + + desc_type = EndianU32_NtoB (desc_list->descriptorType); + return Fcons (make_unibyte_string ((char *) &desc_type, 4), result); +} + +Lisp_Object +mac_aedesc_to_lisp (desc) + AEDesc *desc; +{ + OSErr err = noErr; + DescType desc_type = desc->descriptorType; + Lisp_Object result; + + switch (desc_type) + { + case typeNull: + result = Qnil; + break; + + case typeAEList: + case typeAERecord: + case typeAppleEvent: + return mac_aelist_to_lisp (desc); +#if 0 + /* The following one is much simpler, but creates and disposes + of Apple event descriptors many times. */ + { + long count; + Lisp_Object elem; + AEKeyword keyword; + AEDesc desc1; + + err = AECountItems (desc, &count); + if (err != noErr) + break; + result = Qnil; + while (count > 0) + { + err = AEGetNthDesc (desc, count, typeWildCard, &keyword, &desc1); + if (err != noErr) + break; + elem = mac_aedesc_to_lisp (&desc1); + AEDisposeDesc (&desc1); + if (desc_type != typeAEList) + { + keyword = EndianU32_NtoB (keyword); + elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem); + } + result = Fcons (elem, result); + count--; + } + } +#endif + break; + + default: +#if TARGET_API_MAC_CARBON + result = make_uninit_string (AEGetDescDataSize (desc)); + err = AEGetDescData (desc, SDATA (result), SBYTES (result)); +#else + result = make_uninit_string (GetHandleSize (desc->dataHandle)); + memcpy (SDATA (result), *(desc->dataHandle), SBYTES (result)); +#endif + break; + } + + if (err != noErr) + return Qnil; + + desc_type = EndianU32_NtoB (desc_type); + return Fcons (make_unibyte_string ((char *) &desc_type, 4), result); +} + +static pascal OSErr +mac_coerce_file_name_ptr (type_code, data_ptr, data_size, + to_type, handler_refcon, result) + DescType type_code; + const void *data_ptr; + Size data_size; + DescType to_type; + long handler_refcon; + AEDesc *result; +{ + OSErr err; + + if (type_code == typeNull) + err = errAECoercionFail; + else if (type_code == to_type || to_type == typeWildCard) + err = AECreateDesc (TYPE_FILE_NAME, data_ptr, data_size, result); + else if (type_code == TYPE_FILE_NAME) + /* Coercion from undecoded file name. */ + { +#ifdef MAC_OSX + CFStringRef str; + CFURLRef url = NULL; + CFDataRef data = NULL; + + str = CFStringCreateWithBytes (NULL, data_ptr, data_size, + kCFStringEncodingUTF8, false); + if (str) + { + url = CFURLCreateWithFileSystemPath (NULL, str, + kCFURLPOSIXPathStyle, false); + CFRelease (str); + } + if (url) + { + data = CFURLCreateData (NULL, url, kCFStringEncodingUTF8, true); + CFRelease (url); + } + if (data) + { + err = AECoercePtr (typeFileURL, CFDataGetBytePtr (data), + CFDataGetLength (data), to_type, result); + CFRelease (data); + } + else + err = memFullErr; +#else + FSSpec fs; + char *buf; + + buf = xmalloc (data_size + 1); + if (buf) + { + memcpy (buf, data_ptr, data_size); + buf[data_size] = '\0'; + err = posix_pathname_to_fsspec (buf, &fs); + xfree (buf); + } + else + err = memFullErr; + if (err == noErr) + err = AECoercePtr (typeFSS, &fs, sizeof (FSSpec), to_type, result); +#endif + } + else if (to_type == TYPE_FILE_NAME) + /* Coercion to undecoded file name. */ + { +#ifdef MAC_OSX + CFURLRef url = NULL; + CFStringRef str = NULL; + CFDataRef data = NULL; + + if (type_code == typeFileURL) + url = CFURLCreateWithBytes (NULL, data_ptr, data_size, + kCFStringEncodingUTF8, NULL); + else + { + AEDesc desc; + Size size; + char *buf; + + err = AECoercePtr (type_code, data_ptr, data_size, + typeFileURL, &desc); + if (err == noErr) + { + size = AEGetDescDataSize (&desc); + buf = xmalloc (size); + if (buf) + { + err = AEGetDescData (&desc, buf, size); + if (err == noErr) + url = CFURLCreateWithBytes (NULL, buf, size, + kCFStringEncodingUTF8, NULL); + xfree (buf); + } + AEDisposeDesc (&desc); + } + } + if (url) + { + str = CFURLCopyFileSystemPath (url, kCFURLPOSIXPathStyle); + CFRelease (url); + } + if (str) + { + data = CFStringCreateExternalRepresentation (NULL, str, + kCFStringEncodingUTF8, + '\0'); + CFRelease (str); + } + if (data) + { + err = AECreateDesc (TYPE_FILE_NAME, CFDataGetBytePtr (data), + CFDataGetLength (data), result); + CFRelease (data); + } +#else + char file_name[MAXPATHLEN]; + + if (type_code == typeFSS && data_size == sizeof (FSSpec)) + err = fsspec_to_posix_pathname (data_ptr, file_name, + sizeof (file_name) - 1); + else + { + AEDesc desc; + FSSpec fs; + + err = AECoercePtr (type_code, data_ptr, data_size, typeFSS, &desc); + if (err == noErr) + { +#if TARGET_API_MAC_CARBON + err = AEGetDescData (&desc, &fs, sizeof (FSSpec)); +#else + fs = *(FSSpec *)(*(desc.dataHandle)); +#endif + if (err == noErr) + err = fsspec_to_posix_pathname (&fs, file_name, + sizeof (file_name) - 1); + AEDisposeDesc (&desc); + } + } + if (err == noErr) + err = AECreateDesc (TYPE_FILE_NAME, file_name, + strlen (file_name), result); +#endif + } + else + abort (); + + if (err != noErr) + return errAECoercionFail; + return noErr; +} + +static pascal OSErr +mac_coerce_file_name_desc (from_desc, to_type, handler_refcon, result) + const AEDesc *from_desc; + DescType to_type; + long handler_refcon; + AEDesc *result; +{ + OSErr err = noErr; + DescType from_type = from_desc->descriptorType; + + if (from_type == typeNull) + err = errAECoercionFail; + else if (from_type == to_type || to_type == typeWildCard) + err = AEDuplicateDesc (from_desc, result); + else + { + char *data_ptr; + Size data_size; + +#if TARGET_API_MAC_CARBON + data_size = AEGetDescDataSize (from_desc); +#else + data_size = GetHandleSize (from_desc->dataHandle); +#endif + data_ptr = xmalloc (data_size); + if (data_ptr) + { +#if TARGET_API_MAC_CARBON + err = AEGetDescData (from_desc, data_ptr, data_size); +#else + memcpy (data_ptr, *(from_desc->dataHandle), data_size); +#endif + if (err == noErr) + err = mac_coerce_file_name_ptr (from_type, data_ptr, + data_size, to_type, + handler_refcon, result); + xfree (data_ptr); + } + else + err = memFullErr; + } + + if (err != noErr) + return errAECoercionFail; + return noErr; +} + +OSErr +init_coercion_handler () +{ + OSErr err; + + static AECoercePtrUPP coerce_file_name_ptrUPP = NULL; + static AECoerceDescUPP coerce_file_name_descUPP = NULL; + + if (coerce_file_name_ptrUPP == NULL) + { + coerce_file_name_ptrUPP = NewAECoercePtrUPP (mac_coerce_file_name_ptr); + coerce_file_name_descUPP = NewAECoerceDescUPP (mac_coerce_file_name_desc); + } + + err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard, + (AECoercionHandlerUPP) + coerce_file_name_ptrUPP, 0, false, false); + if (err == noErr) + err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME, + (AECoercionHandlerUPP) + coerce_file_name_ptrUPP, 0, false, false); + if (err == noErr) + err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard, + coerce_file_name_descUPP, 0, true, false); + if (err == noErr) + err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME, + coerce_file_name_descUPP, 0, true, false); + return err; +} + +#if TARGET_API_MAC_CARBON +OSErr +create_apple_event_from_event_ref (event, num_params, names, types, result) + EventRef event; + UInt32 num_params; + EventParamName *names; + EventParamType *types; + AppleEvent *result; +{ + OSErr err; + static const ProcessSerialNumber psn = {0, kCurrentProcess}; + AEAddressDesc address_desc; + UInt32 i, size; + CFStringRef string; + CFDataRef data; + char *buf; + + err = AECreateDesc (typeProcessSerialNumber, &psn, + sizeof (ProcessSerialNumber), &address_desc); + if (err == noErr) + { + err = AECreateAppleEvent (0, 0, /* Dummy class and ID. */ + &address_desc, /* NULL is not allowed + on Mac OS Classic. */ + kAutoGenerateReturnID, + kAnyTransactionID, result); + AEDisposeDesc (&address_desc); + } + if (err != noErr) + return err; + + for (i = 0; i < num_params; i++) + switch (types[i]) + { +#ifdef MAC_OSX + case typeCFStringRef: + err = GetEventParameter (event, names[i], typeCFStringRef, NULL, + sizeof (CFStringRef), NULL, &string); + if (err != noErr) + break; + data = CFStringCreateExternalRepresentation (NULL, string, + kCFStringEncodingUTF8, + '?'); + if (data == NULL) + break; + /* typeUTF8Text is not available on Mac OS X 10.1. */ + AEPutParamPtr (result, names[i], 'utf8', + CFDataGetBytePtr (data), CFDataGetLength (data)); + CFRelease (data); + break; +#endif + + default: + err = GetEventParameter (event, names[i], types[i], NULL, + 0, &size, NULL); + if (err != noErr) + break; + buf = xmalloc (size); + if (buf == NULL) + break; + err = GetEventParameter (event, names[i], types[i], NULL, + size, NULL, buf); + if (err == noErr) + AEPutParamPtr (result, names[i], types[i], buf, size); + xfree (buf); + break; + } + + return noErr; +} +#endif + + /*********************************************************************** Conversion between Lisp and Core Foundation objects ***********************************************************************/ @@ -266,7 +709,6 @@ posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen) #if TARGET_API_MAC_CARBON static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata; static Lisp_Object Qarray, Qdictionary; -#define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0) struct cfdict_context { @@ -337,12 +779,11 @@ cfdata_to_lisp (data) } -/* From CFString to a lisp string. Never returns a unibyte string - (even if it only contains ASCII characters). - This may cause GC during code conversion. */ +/* From CFString to a lisp string. Returns a unibyte string + containing a UTF-8 byte sequence. */ Lisp_Object -cfstring_to_lisp (string) +cfstring_to_lisp_nodecode (string) CFStringRef string; { Lisp_Object result = Qnil; @@ -363,9 +804,23 @@ cfstring_to_lisp (string) } } + return result; +} + + +/* From CFString to a lisp string. Never returns a unibyte string + (even if it only contains ASCII characters). + This may cause GC during code conversion. */ + +Lisp_Object +cfstring_to_lisp (string) + CFStringRef string; +{ + Lisp_Object result = cfstring_to_lisp_nodecode (string); + if (!NILP (result)) { - result = DECODE_UTF_8 (result); + result = code_convert_string_norecord (result, Qutf_8, 0); /* This may be superfluous. Just to make sure that the result is a multibyte string. */ result = string_to_multibyte (result); @@ -855,9 +1310,14 @@ parse_resource_line (p) implemented as a hash table that maps a pair (SRC-NODE-ID . EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used in the table as a value for HASHKEY_MAX_NID. A value associated to - a node is recorded as a value for the node id. */ + a node is recorded as a value for the node id. + + A database also has a cache for past queries as a value for + HASHKEY_QUERY_CACHE. It is another hash table that maps + "NAME-STRING\0CLASS-STRING" to the result of the query. */ #define HASHKEY_MAX_NID (make_number (0)) +#define HASHKEY_QUERY_CACHE (make_number (-1)) static XrmDatabase xrm_create_database () @@ -869,6 +1329,7 @@ xrm_create_database () make_float (DEFAULT_REHASH_THRESHOLD), Qnil, Qnil, Qnil); Fputhash (HASHKEY_MAX_NID, make_number (0), database); + Fputhash (HASHKEY_QUERY_CACHE, Qnil, database); return database; } @@ -902,6 +1363,7 @@ xrm_q_put_resource (database, quarks, value) Fputhash (node_id, value, database); Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database); + Fputhash (HASHKEY_QUERY_CACHE, Qnil, database); } /* Merge multiple resource entries specified by DATA into a resource @@ -990,8 +1452,30 @@ xrm_get_resource (database, name, class) XrmDatabase database; char *name, *class; { - Lisp_Object quark_name, quark_class, tmp; - int nn, nc; + Lisp_Object key, query_cache, quark_name, quark_class, tmp; + int i, nn, nc; + struct Lisp_Hash_Table *h; + unsigned hash_code; + + nn = strlen (name); + nc = strlen (class); + key = make_uninit_string (nn + nc + 1); + strcpy (SDATA (key), name); + strncpy (SDATA (key) + nn + 1, class, nc); + + query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil); + if (NILP (query_cache)) + { + query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), + make_float (DEFAULT_REHASH_SIZE), + make_float (DEFAULT_REHASH_THRESHOLD), + Qnil, Qnil, Qnil); + Fputhash (HASHKEY_QUERY_CACHE, query_cache, database); + } + h = XHASH_TABLE (query_cache); + i = hash_lookup (h, key, &hash_code); + if (i >= 0) + return HASH_VALUE (h, i); quark_name = parse_resource_name (&name); if (*name != '\0') @@ -1010,7 +1494,11 @@ xrm_get_resource (database, name, class) if (nn != nc) return Qnil; else - return xrm_q_get_resource (database, quark_name, quark_class); + { + tmp = xrm_q_get_resource (database, quark_name, quark_class); + hash_put (h, key, tmp, hash_code); + return tmp; + } } #if TARGET_API_MAC_CARBON @@ -1021,7 +1509,7 @@ xrm_cfproperty_list_to_value (plist) CFTypeID type_id = CFGetTypeID (plist); if (type_id == CFStringGetTypeID ()) - return cfstring_to_lisp (plist); + return cfstring_to_lisp (plist); else if (type_id == CFNumberGetTypeID ()) { CFStringRef string; @@ -1109,7 +1597,7 @@ xrm_get_preference_database (application) CFSetGetValues (key_set, (const void **)keys); for (index = 0; index < count; index++) { - res_name = SDATA (cfstring_to_lisp (keys[index])); + res_name = SDATA (cfstring_to_lisp_nodecode (keys[index])); quarks = parse_resource_name (&res_name); if (!(NILP (quarks) || *res_name)) { @@ -1672,37 +2160,7 @@ sys_fopen (const char *name, const char *mode) } -long target_ticks = 0; - -#ifdef __MRC__ -__sigfun alarm_signal_func = (__sigfun) 0; -#elif __MWERKS__ -__signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0; -#else /* not __MRC__ and not __MWERKS__ */ -You lose!!! -#endif /* not __MRC__ and not __MWERKS__ */ - - -/* These functions simulate SIG_ALRM. The stub for function signal - stores the signal handler function in alarm_signal_func if a - SIG_ALRM is encountered. check_alarm is called in XTread_socket, - which emacs calls periodically. A pending alarm is represented by - a non-zero target_ticks value. check_alarm calls the handler - function pointed to by alarm_signal_func if one has been set up and - an alarm is pending. */ - -void -check_alarm () -{ - if (target_ticks && TickCount () > target_ticks) - { - target_ticks = 0; - if (alarm_signal_func) - (*alarm_signal_func)(SIGALRM); - } -} - - +#include "keyboard.h" extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean); int @@ -1713,25 +2171,17 @@ select (n, rfds, wfds, efds, timeout) SELECT_TYPE *efds; struct timeval *timeout; { -#if TARGET_API_MAC_CARBON OSErr err; +#if TARGET_API_MAC_CARBON EventTimeout timeout_sec = (timeout ? (EMACS_SECS (*timeout) * kEventDurationSecond + EMACS_USECS (*timeout) * kEventDurationMicrosecond) : kEventDurationForever); - if (FD_ISSET (0, rfds)) - { - BLOCK_INPUT; - err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL); - UNBLOCK_INPUT; - if (err == noErr) - return 1; - else - FD_ZERO (rfds); - } - return 0; + BLOCK_INPUT; + err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL); + UNBLOCK_INPUT; #else /* not TARGET_API_MAC_CARBON */ EventRecord e; UInt32 sleep_time = EMACS_SECS (*timeout) * 60 + @@ -1746,47 +2196,62 @@ select (n, rfds, wfds, efds, timeout) read_avail_input which in turn calls XTread_socket to poll for these events. Otherwise these never get processed except but a very slow poll timer. */ - if (FD_ISSET (0, rfds) && mac_wait_next_event (&e, sleep_time, false)) - return 1; - - return 0; + if (mac_wait_next_event (&e, sleep_time, false)) + err = noErr; + else + err = -9875; /* eventLoopTimedOutErr */ #endif /* not TARGET_API_MAC_CARBON */ -} - - -/* Called in sys_select to wait for an alarm signal to arrive. */ - -int -pause () -{ - EventRecord e; - unsigned long tick; - - if (!target_ticks) /* no alarm pending */ - return -1; - if ((tick = TickCount ()) < target_ticks) - WaitNextEvent (0, &e, target_ticks - tick, NULL); /* Accept no event; - just wait. by T.I. */ + if (FD_ISSET (0, rfds)) + if (err == noErr) + return 1; + else + { + FD_ZERO (rfds); + return 0; + } + else + if (err == noErr) + { + if (input_polling_used ()) + { + /* It could be confusing if a real alarm arrives while + processing the fake one. Turn it off and let the + handler reset it. */ + extern void poll_for_input_1 P_ ((void)); + int old_poll_suppress_count = poll_suppress_count; + poll_suppress_count = 1; + poll_for_input_1 (); + poll_suppress_count = old_poll_suppress_count; + } + errno = EINTR; + return -1; + } + else + return 0; +} - target_ticks = 0; - if (alarm_signal_func) - (*alarm_signal_func)(SIGALRM); - return 0; -} +/* Simulation of SIGALRM. The stub for function signal stores the + signal handler function in alarm_signal_func if a SIGALRM is + encountered. */ +#include +#include "syssignal.h" -int -alarm (int seconds) -{ - long remaining = target_ticks ? (TickCount () - target_ticks) / 60 : 0; +static TMTask mac_atimer_task; - target_ticks = seconds ? TickCount () + 60 * seconds : 0; +static QElemPtr mac_atimer_qlink = (QElemPtr) &mac_atimer_task; - return (remaining < 0) ? 0 : (unsigned int) remaining; -} +static int signal_mask = 0; +#ifdef __MRC__ +__sigfun alarm_signal_func = (__sigfun) 0; +#elif __MWERKS__ +__signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0; +#else /* not __MRC__ and not __MWERKS__ */ +You lose!!! +#endif /* not __MRC__ and not __MWERKS__ */ #undef signal #ifdef __MRC__ @@ -1819,6 +2284,128 @@ sys_signal (int signal_num, __signal_func_ptr signal_func) } +static pascal void +mac_atimer_handler (qlink) + TMTaskPtr qlink; +{ + if (alarm_signal_func) + (alarm_signal_func) (SIGALRM); +} + + +static void +set_mac_atimer (count) + long count; +{ + static TimerUPP mac_atimer_handlerUPP = NULL; + + if (mac_atimer_handlerUPP == NULL) + mac_atimer_handlerUPP = NewTimerUPP (mac_atimer_handler); + mac_atimer_task.tmCount = 0; + mac_atimer_task.tmAddr = mac_atimer_handlerUPP; + mac_atimer_qlink = (QElemPtr) &mac_atimer_task; + InsTime (mac_atimer_qlink); + if (count) + PrimeTime (mac_atimer_qlink, count); +} + + +int +remove_mac_atimer (remaining_count) + long *remaining_count; +{ + if (mac_atimer_qlink) + { + RmvTime (mac_atimer_qlink); + if (remaining_count) + *remaining_count = mac_atimer_task.tmCount; + mac_atimer_qlink = NULL; + + return 0; + } + else + return -1; +} + + +int +sigblock (int mask) +{ + int old_mask = signal_mask; + + signal_mask |= mask; + + if ((old_mask ^ signal_mask) & sigmask (SIGALRM)) + remove_mac_atimer (NULL); + + return old_mask; +} + + +int +sigsetmask (int mask) +{ + int old_mask = signal_mask; + + signal_mask = mask; + + if ((old_mask ^ signal_mask) & sigmask (SIGALRM)) + if (signal_mask & sigmask (SIGALRM)) + remove_mac_atimer (NULL); + else + set_mac_atimer (mac_atimer_task.tmCount); + + return old_mask; +} + + +int +alarm (int seconds) +{ + long remaining_count; + + if (remove_mac_atimer (&remaining_count) == 0) + { + set_mac_atimer (seconds * 1000); + + return remaining_count / 1000; + } + else + { + mac_atimer_task.tmCount = seconds * 1000; + + return 0; + } +} + + +int +setitimer (which, value, ovalue) + int which; + const struct itimerval *value; + struct itimerval *ovalue; +{ + long remaining_count; + long count = (EMACS_SECS (value->it_value) * 1000 + + (EMACS_USECS (value->it_value) + 999) / 1000); + + if (remove_mac_atimer (&remaining_count) == 0) + { + if (ovalue) + { + bzero (ovalue, sizeof (*ovalue)); + EMACS_SET_SECS_USECS (ovalue->it_value, remaining_count / 1000, + (remaining_count % 1000) * 1000); + } + set_mac_atimer (count); + } + else + mac_atimer_task.tmCount = count; + + return 0; +} + + /* gettimeofday should return the amount of time (in a timeval structure) since midnight today. The toolbox function Microseconds returns the number of microseconds (in a UnsignedWide value) since @@ -1946,35 +2533,6 @@ sys_time (time_t *timer) } -/* MPW strftime broken for "%p" format */ -#ifdef __MRC__ -#undef strftime -#include -size_t -sys_strftime (char * s, size_t maxsize, const char * format, - const struct tm * timeptr) -{ - if (strcmp (format, "%p") == 0) - { - if (maxsize < 3) - return 0; - if (timeptr->tm_hour < 12) - { - strcpy (s, "AM"); - return 2; - } - else - { - strcpy (s, "PM"); - return 2; - } - } - else - return strftime (s, maxsize, format, timeptr); -} -#endif /* __MRC__ */ - - /* no subprocesses, empty wait */ int @@ -1992,13 +2550,6 @@ croak (char *badfunc) } -char * -index (const char * str, int chr) -{ - return strchr (str, chr); -} - - char * mktemp (char *template) { @@ -2187,20 +2738,6 @@ sys_subshell () } -int -sigsetmask (int x) -{ - return 0; -} - - -int -sigblock (int mask) -{ - return 0; -} - - void request_sigio (void) { @@ -2297,7 +2834,7 @@ path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num, } -OSErr +static OSErr posix_pathname_to_fsspec (ufn, fs) const char *ufn; FSSpec *fs; @@ -2313,7 +2850,7 @@ posix_pathname_to_fsspec (ufn, fs) } } -OSErr +static OSErr fsspec_to_posix_pathname (fs, ufn, ufnbuflen) const FSSpec *fs; char *ufn; @@ -2422,18 +2959,34 @@ find_true_pathname (const char *path, char *buf, int bufsiz) } -mode_t -umask (mode_t numask) +mode_t +umask (mode_t numask) +{ + static mode_t mask = 022; + mode_t oldmask = mask; + mask = numask; + return oldmask; +} + + +int +chmod (const char *path, mode_t mode) +{ + /* say it always succeed for now */ + return 0; +} + + +int +fchmod (int fd, mode_t mode) { - static mode_t mask = 022; - mode_t oldmask = mask; - mask = numask; - return oldmask; + /* say it always succeed for now */ + return 0; } int -chmod (const char *path, mode_t mode) +fchown (int fd, uid_t owner, gid_t group) { /* say it always succeed for now */ return 0; @@ -2870,7 +3423,10 @@ mystrcpy (char *to, char *from) wildcard filename expansion. Since we don't really have a shell on the Mac, this case is detected and the starting of the shell is by-passed. We really need to add code here to do filename - expansion to support such functionality. */ + expansion to support such functionality. + + We can't use this strategy in Carbon because the High Level Event + APIs are not available. */ int run_mac_command (argv, workdir, infn, outfn, errfn) @@ -3339,93 +3895,328 @@ initialize_applescript () } -void terminate_applescript() +void +terminate_applescript() { OSADispose (as_scripting_component, as_script_context); CloseComponent (as_scripting_component); } +/* Convert a lisp string to the 4 byte character code. */ + +OSType +mac_get_code_from_arg(Lisp_Object arg, OSType defCode) +{ + OSType result; + if (NILP(arg)) + { + result = defCode; + } + else + { + /* check type string */ + CHECK_STRING(arg); + if (SBYTES (arg) != 4) + { + error ("Wrong argument: need string of length 4 for code"); + } + result = EndianU32_BtoN (*((UInt32 *) SDATA (arg))); + } + return result; +} + +/* Convert the 4 byte character code into a 4 byte string. */ + +Lisp_Object +mac_get_object_from_code(OSType defCode) +{ + UInt32 code = EndianU32_NtoB (defCode); + + return make_unibyte_string ((char *)&code, 4); +} + + +DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0, + doc: /* Get the creator code of FILENAME as a four character string. */) + (filename) + Lisp_Object filename; +{ + OSErr status; +#ifdef MAC_OSX + FSRef fref; +#else + FSSpec fss; +#endif + OSType cCode; + Lisp_Object result = Qnil; + CHECK_STRING (filename); + + if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) { + return Qnil; + } + filename = Fexpand_file_name (filename, Qnil); + + BLOCK_INPUT; +#ifdef MAC_OSX + status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL); +#else + status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss); +#endif + + if (status == noErr) + { +#ifdef MAC_OSX + FSCatalogInfo catalogInfo; + + status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo, + &catalogInfo, NULL, NULL, NULL); +#else + FInfo finder_info; + + status = FSpGetFInfo (&fss, &finder_info); +#endif + if (status == noErr) + { +#ifdef MAC_OSX + result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator); +#else + result = mac_get_object_from_code (finder_info.fdCreator); +#endif + } + } + UNBLOCK_INPUT; + if (status != noErr) { + error ("Error while getting file information."); + } + return result; +} + +DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0, + doc: /* Get the type code of FILENAME as a four character string. */) + (filename) + Lisp_Object filename; +{ + OSErr status; +#ifdef MAC_OSX + FSRef fref; +#else + FSSpec fss; +#endif + OSType cCode; + Lisp_Object result = Qnil; + CHECK_STRING (filename); + + if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) { + return Qnil; + } + filename = Fexpand_file_name (filename, Qnil); + + BLOCK_INPUT; +#ifdef MAC_OSX + status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL); +#else + status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss); +#endif + + if (status == noErr) + { +#ifdef MAC_OSX + FSCatalogInfo catalogInfo; + + status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo, + &catalogInfo, NULL, NULL, NULL); +#else + FInfo finder_info; + + status = FSpGetFInfo (&fss, &finder_info); +#endif + if (status == noErr) + { +#ifdef MAC_OSX + result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType); +#else + result = mac_get_object_from_code (finder_info.fdType); +#endif + } + } + UNBLOCK_INPUT; + if (status != noErr) { + error ("Error while getting file information."); + } + return result; +} + +DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0, + doc: /* Set creator code of file FILENAME to CODE. +If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is +assumed. Return non-nil if successful. */) + (filename, code) + Lisp_Object filename, code; +{ + OSErr status; +#ifdef MAC_OSX + FSRef fref; +#else + FSSpec fss; +#endif + OSType cCode; + CHECK_STRING (filename); + + cCode = mac_get_code_from_arg(code, 'EMAx'); + + if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) { + return Qnil; + } + filename = Fexpand_file_name (filename, Qnil); + + BLOCK_INPUT; +#ifdef MAC_OSX + status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL); +#else + status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss); +#endif + + if (status == noErr) + { +#ifdef MAC_OSX + FSCatalogInfo catalogInfo; + FSRef parentDir; + status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo, + &catalogInfo, NULL, NULL, &parentDir); +#else + FInfo finder_info; + + status = FSpGetFInfo (&fss, &finder_info); +#endif + if (status == noErr) + { +#ifdef MAC_OSX + ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode; + status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo); + /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */ +#else + finder_info.fdCreator = cCode; + status = FSpSetFInfo (&fss, &finder_info); +#endif + } + } + UNBLOCK_INPUT; + if (status != noErr) { + error ("Error while setting creator information."); + } + return Qt; +} + +DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0, + doc: /* Set file code of file FILENAME to CODE. +CODE must be a 4-character string. Return non-nil if successful. */) + (filename, code) + Lisp_Object filename, code; +{ + OSErr status; +#ifdef MAC_OSX + FSRef fref; +#else + FSSpec fss; +#endif + OSType cCode; + CHECK_STRING (filename); + + cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/ + + if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) { + return Qnil; + } + filename = Fexpand_file_name (filename, Qnil); + + BLOCK_INPUT; +#ifdef MAC_OSX + status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL); +#else + status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss); +#endif + + if (status == noErr) + { +#ifdef MAC_OSX + FSCatalogInfo catalogInfo; + FSRef parentDir; + status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo, + &catalogInfo, NULL, NULL, &parentDir); +#else + FInfo finder_info; + + status = FSpGetFInfo (&fss, &finder_info); +#endif + if (status == noErr) + { +#ifdef MAC_OSX + ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode; + status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo); + /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */ +#else + finder_info.fdType = cCode; + status = FSpSetFInfo (&fss, &finder_info); +#endif + } + } + UNBLOCK_INPUT; + if (status != noErr) { + error ("Error while setting creator information."); + } + return Qt; +} + /* Compile and execute the AppleScript SCRIPT and return the error status as function value. A zero is returned if compilation and - execution is successful, in which case RESULT returns a pointer to - a string containing the resulting script value. Otherwise, the Mac - error code is returned and RESULT returns a pointer to an error - string. In both cases the caller should deallocate the storage - used by the string pointed to by RESULT if it is non-NULL. For - documentation on the MacOS scripting architecture, see Inside - Macintosh - Interapplication Communications: Scripting Components. */ + execution is successful, in which case *RESULT is set to a Lisp + string containing the resulting script value. Otherwise, the Mac + error code is returned and *RESULT is set to an error Lisp string. + For documentation on the MacOS scripting architecture, see Inside + Macintosh - Interapplication Communications: Scripting + Components. */ static long -do_applescript (char *script, char **result) +do_applescript (script, result) + Lisp_Object script, *result; { - AEDesc script_desc, result_desc, error_desc; + AEDesc script_desc, result_desc, error_desc, *desc = NULL; OSErr error; OSAError osaerror; - long length; - *result = 0; + *result = Qnil; if (!as_scripting_component) initialize_applescript(); - error = AECreateDesc (typeChar, script, strlen(script), &script_desc); + error = AECreateDesc (typeChar, SDATA (script), SBYTES (script), + &script_desc); if (error) return error; osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript, typeChar, kOSAModeNull, &result_desc); - if (osaerror == errOSAScriptError) - { - /* error executing AppleScript: retrieve error message */ - if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar, - &error_desc)) - { -#if TARGET_API_MAC_CARBON - length = AEGetDescDataSize (&error_desc); - *result = (char *) xmalloc (length + 1); - if (*result) - { - AEGetDescData (&error_desc, *result, length); - *(*result + length) = '\0'; - } -#else /* not TARGET_API_MAC_CARBON */ - HLock (error_desc.dataHandle); - length = GetHandleSize(error_desc.dataHandle); - *result = (char *) xmalloc (length + 1); - if (*result) - { - memcpy (*result, *(error_desc.dataHandle), length); - *(*result + length) = '\0'; - } - HUnlock (error_desc.dataHandle); -#endif /* not TARGET_API_MAC_CARBON */ - AEDisposeDesc (&error_desc); - } - } - else if (osaerror == noErr) /* success: retrieve resulting script value */ + if (osaerror == noErr) + /* success: retrieve resulting script value */ + desc = &result_desc; + else if (osaerror == errOSAScriptError) + /* error executing AppleScript: retrieve error message */ + if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar, + &error_desc)) + desc = &error_desc; + + if (desc) { #if TARGET_API_MAC_CARBON - length = AEGetDescDataSize (&result_desc); - *result = (char *) xmalloc (length + 1); - if (*result) - { - AEGetDescData (&result_desc, *result, length); - *(*result + length) = '\0'; - } + *result = make_uninit_string (AEGetDescDataSize (desc)); + AEGetDescData (desc, SDATA (*result), SBYTES (*result)); #else /* not TARGET_API_MAC_CARBON */ - HLock (result_desc.dataHandle); - length = GetHandleSize(result_desc.dataHandle); - *result = (char *) xmalloc (length + 1); - if (*result) - { - memcpy (*result, *(result_desc.dataHandle), length); - *(*result + length) = '\0'; - } - HUnlock (result_desc.dataHandle); + *result = make_uninit_string (GetHandleSize (desc->dataHandle)); + memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result)); #endif /* not TARGET_API_MAC_CARBON */ - AEDisposeDesc (&result_desc); + AEDisposeDesc (desc); } AEDisposeDesc (&script_desc); @@ -3435,61 +4226,42 @@ do_applescript (char *script, char **result) DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0, - doc: /* Compile and execute AppleScript SCRIPT and retrieve and return the result. + doc: /* Compile and execute AppleScript SCRIPT and return the result. If compilation and execution are successful, the resulting script value is returned as a string. Otherwise the function aborts and displays the error message returned by the AppleScript scripting component. */) - (script) + (script) Lisp_Object script; { - char *result, *temp; - Lisp_Object lisp_result; + Lisp_Object result; long status; CHECK_STRING (script); BLOCK_INPUT; - status = do_applescript (SDATA (script), &result); + status = do_applescript (script, &result); UNBLOCK_INPUT; - if (status) - { - if (!result) - error ("AppleScript error %d", status); - else - { - /* Unfortunately only OSADoScript in do_applescript knows how - how large the resulting script value or error message is - going to be and therefore as caller memory must be - deallocated here. It is necessary to free the error - message before calling error to avoid a memory leak. */ - temp = (char *) alloca (strlen (result) + 1); - strcpy (temp, result); - xfree (result); - error (temp); - } - } + if (status == 0) + return result; + else if (!STRINGP (result)) + error ("AppleScript error %d", status); else - { - lisp_result = build_string (result); - xfree (result); - return lisp_result; - } + error ("%s", SDATA (result)); } DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix, Smac_file_name_to_posix, 1, 1, 0, - doc: /* Convert Macintosh filename to Posix form. */) - (mac_filename) - Lisp_Object mac_filename; + doc: /* Convert Macintosh FILENAME to Posix form. */) + (filename) + Lisp_Object filename; { char posix_filename[MAXPATHLEN+1]; - CHECK_STRING (mac_filename); + CHECK_STRING (filename); - if (mac_to_posix_pathname (SDATA (mac_filename), posix_filename, - MAXPATHLEN)) + if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN)) return build_string (posix_filename); else return Qnil; @@ -3498,22 +4270,63 @@ DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix, DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac, Sposix_file_name_to_mac, 1, 1, 0, - doc: /* Convert Posix filename to Mac form. */) - (posix_filename) - Lisp_Object posix_filename; + doc: /* Convert Posix FILENAME to Mac form. */) + (filename) + Lisp_Object filename; { char mac_filename[MAXPATHLEN+1]; - CHECK_STRING (posix_filename); + CHECK_STRING (filename); - if (posix_to_mac_pathname (SDATA (posix_filename), mac_filename, - MAXPATHLEN)) + if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN)) return build_string (mac_filename); else return Qnil; } +DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data, Smac_coerce_ae_data, 3, 3, 0, + doc: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE. +Each type should be a string of length 4 or the symbol +`undecoded-file-name'. */) + (src_type, src_data, dst_type) + Lisp_Object src_type, src_data, dst_type; +{ + OSErr err; + Lisp_Object result = Qnil; + DescType src_desc_type, dst_desc_type; + AEDesc dst_desc; +#ifdef MAC_OSX + FSRef fref; +#else + FSSpec fs; +#endif + + CHECK_STRING (src_data); + if (EQ (src_type, Qundecoded_file_name)) + src_desc_type = TYPE_FILE_NAME; + else + src_desc_type = mac_get_code_from_arg (src_type, 0); + + if (EQ (dst_type, Qundecoded_file_name)) + dst_desc_type = TYPE_FILE_NAME; + else + dst_desc_type = mac_get_code_from_arg (dst_type, 0); + + BLOCK_INPUT; + err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data), + dst_desc_type, &dst_desc); + if (err == noErr) + { + result = Fcdr (mac_aedesc_to_lisp (&dst_desc)); + AEDisposeDesc (&dst_desc); + } + UNBLOCK_INPUT; + + return result; +} + + #if TARGET_API_MAC_CARBON static Lisp_Object Qxml, Qmime_charset; static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C; @@ -3522,8 +4335,8 @@ DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0, doc: /* Return the application preference value for KEY. KEY is either a string specifying a preference key, or a list of key strings. If it is a list, the (i+1)-th element is used as a key for -the CFDictionary value obtained by the i-th element. If lookup is -failed at some stage, nil is returned. +the CFDictionary value obtained by the i-th element. Return nil if +lookup is failed at some stage. Optional arg APPLICATION is an application ID string. If omitted or nil, that stands for the current application. @@ -3554,7 +4367,7 @@ CFDictionary. If HASH-BOUND is a negative integer or nil, always generate alists. If HASH-BOUND >= 0, generate an alist if the number of keys in the dictionary is smaller than HASH-BOUND, and a hash table otherwise. */) - (key, application, format, hash_bound) + (key, application, format, hash_bound) Lisp_Object key, application, format, hash_bound; { CFStringRef app_id, key_str; @@ -3640,10 +4453,13 @@ get_cfstring_encoding_from_lisp (obj) CFStringRef iana_name; CFStringEncoding encoding = kCFStringEncodingInvalidId; + if (NILP (obj)) + return kCFStringEncodingUnicode; + if (INTEGERP (obj)) return XINT (obj); - if (SYMBOLP (obj) && !NILP (obj) && !NILP (Fcoding_system_p (obj))) + if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj))) { Lisp_Object coding_spec, plist; @@ -3787,19 +4603,18 @@ DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_st doc: /* Convert STRING from SOURCE encoding to TARGET encoding. The conversion is performed using the converter provided by the system. Each encoding is specified by either a coding system symbol, a mime -charset string, or an integer as a CFStringEncoding value. +charset string, or an integer as a CFStringEncoding value. Nil for +encoding means UTF-16 in native byte order, no byte order mark. On Mac OS X 10.2 and later, you can do Unicode Normalization by specifying the optional argument NORMALIZATION-FORM with a symbol NFD, NFKD, NFC, NFKC, HFS+D, or HFS+C. -On successful conversion, returns the result string, else returns -nil. */) - (string, source, target, normalization_form) +On successful conversion, return the result string, else return nil. */) + (string, source, target, normalization_form) Lisp_Object string, source, target, normalization_form; { Lisp_Object result = Qnil; CFStringEncoding src_encoding, tgt_encoding; CFStringRef str = NULL; - CFDataRef data = NULL; CHECK_STRING (string); if (!INTEGERP (source) && !STRINGP (source)) @@ -3813,11 +4628,15 @@ nil. */) src_encoding = get_cfstring_encoding_from_lisp (source); tgt_encoding = get_cfstring_encoding_from_lisp (target); - string = string_make_unibyte (string); + /* We really want string_to_unibyte, but since it doesn't exist yet, we + use string_as_unibyte which works as well, except for the fact that + it's too permissive (it doesn't check that the multibyte string only + contain single-byte chars). */ + string = Fstring_as_unibyte (string); if (src_encoding != kCFStringEncodingInvalidId && tgt_encoding != kCFStringEncodingInvalidId) str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string), - src_encoding, true); + src_encoding, !NILP (source)); #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 if (str) { @@ -3829,15 +4648,18 @@ nil. */) #endif if (str) { - data = CFStringCreateExternalRepresentation (NULL, str, - tgt_encoding, '\0'); + CFIndex str_len, buf_len; + + str_len = CFStringGetLength (str); + if (CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0, + !NILP (target), NULL, 0, &buf_len) == str_len) + { + result = make_uninit_string (buf_len); + CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0, + !NILP (target), SDATA (result), buf_len, NULL); + } CFRelease (str); } - if (data) - { - result = cfdata_to_lisp (data); - CFRelease (data); - } UNBLOCK_INPUT; @@ -3848,13 +4670,36 @@ nil. */) DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_name_table, 0, 0, 0, doc: /* Clear the font name table. */) - () + () { check_mac (); mac_clear_font_name_table (); return Qnil; } + +static Lisp_Object +mac_get_system_locale () +{ + OSErr err; + LangCode lang; + RegionCode region; + LocaleRef locale; + Str255 str; + + lang = GetScriptVariable (smSystemScript, smScriptLang); + region = GetScriptManagerVariable (smRegionCode); + err = LocaleRefFromLangOrRegionCode (lang, region, &locale); + if (err == noErr) + err = LocaleRefGetPartString (locale, kLocaleAllPartsMask, + sizeof (str), str); + if (err == noErr) + return build_string (str); + else + return Qnil; +} + + #ifdef MAC_OSX #undef select @@ -3876,7 +4721,7 @@ extern int noninteractive; involved, and timeout is not too short (greater than SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds). -> Create CFSocket for each socket and add it into the current - event RunLoop so that an `ready-to-read' event can be posted + event RunLoop so that a `ready-to-read' event can be posted to the event queue that is also used for window events. Then ReceiveNextEvent can wait for both kinds of inputs. 4. Otherwise. @@ -3984,6 +4829,9 @@ sys_select (n, rfds, wfds, efds, timeout) return 0; } +#if USE_CG_DRAWING + mac_prepare_for_quickdraw (NULL); +#endif /* Avoid initial overhead of RunLoop setup for the case that some input is already available. */ EMACS_SET_SECS_USECS (select_timeout, 0, 0); @@ -4144,12 +4992,22 @@ init_mac_osx_environment () char *p, *q; struct stat st; + /* Initialize locale related variables. */ + mac_system_script_code = + (ScriptCode) GetScriptManagerVariable (smSysScript); + Vmac_system_locale = mac_get_system_locale (); + /* Fetch the pathname of the application bundle as a C string into app_bundle_pathname. */ bundle = CFBundleGetMainBundle (); - if (!bundle) - return; + if (!bundle || CFBundleGetIdentifier (bundle) == NULL) + { + /* We could not find the bundle identifier. For now, prevent + the fatal error by bringing it up in the terminal. */ + inhibit_window_system = 1; + return; + } bundleURL = CFBundleCopyBundleURL (bundle); if (!bundleURL) @@ -4258,31 +5116,12 @@ init_mac_osx_environment () #endif /* MAC_OSX */ -static Lisp_Object -mac_get_system_locale () -{ - OSErr err; - LangCode lang; - RegionCode region; - LocaleRef locale; - Str255 str; - - lang = GetScriptVariable (smSystemScript, smScriptLang); - region = GetScriptManagerVariable (smRegionCode); - err = LocaleRefFromLangOrRegionCode (lang, region, &locale); - if (err == noErr) - err = LocaleRefGetPartString (locale, kLocaleAllPartsMask, - sizeof (str), str); - if (err == noErr) - return build_string (str); - else - return Qnil; -} - - void syms_of_mac () { + Qundecoded_file_name = intern ("undecoded-file-name"); + staticpro (&Qundecoded_file_name); + #if TARGET_API_MAC_CARBON Qstring = intern ("string"); staticpro (&Qstring); Qnumber = intern ("number"); staticpro (&Qnumber); @@ -4306,12 +5145,17 @@ syms_of_mac () QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C); #endif + defsubr (&Smac_coerce_ae_data); #if TARGET_API_MAC_CARBON defsubr (&Smac_get_preference); defsubr (&Smac_code_convert_string); #endif defsubr (&Smac_clear_font_name_table); + defsubr (&Smac_set_file_creator); + defsubr (&Smac_set_file_type); + defsubr (&Smac_get_file_creator); + defsubr (&Smac_get_file_type); defsubr (&Sdo_applescript); defsubr (&Smac_file_name_to_posix); defsubr (&Sposix_file_name_to_mac);