/* 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, 2007 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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). */
#include <stdio.h>
#include <errno.h>
-#include <time.h>
#include "lisp.h"
#include "process.h"
-#include "sysselect.h"
+#ifdef MAC_OSX
+#undef select
+#endif
#include "systime.h"
+#include "sysselect.h"
#include "blockinput.h"
#include "macterm.h"
-#ifndef HAVE_CARBON
+#include "charset.h"
+#include "coding.h"
+#if !TARGET_API_MAC_CARBON
#include <Files.h>
#include <MacTypes.h>
#include <TextUtils.h>
#include <Folders.h>
#include <Resources.h>
#include <Aliases.h>
-#include <FixMath.h>
#include <Timer.h>
#include <OSA.h>
#include <AppleScript.h>
-#include <Scrap.h>
#include <Events.h>
#include <Processes.h>
#include <EPPC.h>
-#endif /* not HAVE_CARBON */
+#include <MacLocales.h>
+#include <Endian.h>
+#endif /* not TARGET_API_MAC_CARBON */
#include <utime.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <string.h>
#include <pwd.h>
#include <grp.h>
#include <sys/param.h>
-#include <stdlib.h>
#include <fcntl.h>
#if __MWERKS__
#include <unistd.h>
#endif
-Lisp_Object QCLIPBOARD;
+/* The system script code. */
+static int mac_system_script_code;
+
+/* The system locale identifier string. */
+static Lisp_Object Vmac_system_locale;
/* An instance of the AppleScript component. */
static ComponentInstance as_scripting_component;
/* The single script context used for all script executions. */
static OSAID as_script_context;
+#if TARGET_API_MAC_CARBON
+static int wakeup_from_rne_enabled_p = 0;
+#define ENABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 1)
+#define DISABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 0)
+#else
+#define ENABLE_WAKEUP_FROM_RNE 0
+#define DISABLE_WAKEUP_FROM_RNE 0
+#endif
+
+#ifndef MAC_OSX
+static OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *));
+static OSErr fsspec_to_posix_pathname P_ ((const FSSpec *, char *, int));
+#endif
/* When converting from Mac to Unix pathnames, /'s in folder names are
converted to :'s. This function, used in copying folder names,
return 1;
}
+\f
+/***********************************************************************
+ Conversions on Apple event objects
+ ***********************************************************************/
+
+static Lisp_Object Qundecoded_file_name;
+
+static struct {
+ AEKeyword keyword;
+ char *name;
+ Lisp_Object symbol;
+} ae_attr_table [] =
+ {{keyTransactionIDAttr, "transaction-id"},
+ {keyReturnIDAttr, "return-id"},
+ {keyEventClassAttr, "event-class"},
+ {keyEventIDAttr, "event-id"},
+ {keyAddressAttr, "address"},
+ {keyOptionalKeywordAttr, "optional-keyword"},
+ {keyTimeoutAttr, "timeout"},
+ {keyInteractLevelAttr, "interact-level"},
+ {keyEventSourceAttr, "event-source"},
+ /* {keyMissedKeywordAttr, "missed-keyword"}, */
+ {keyOriginalAddressAttr, "original-address"},
+ {keyReplyRequestedAttr, "reply-requested"},
+ {KEY_EMACS_SUSPENSION_ID_ATTR, "emacs-suspension-id"}
+ };
+
+static Lisp_Object
+mac_aelist_to_lisp (desc_list)
+ const AEDescList *desc_list;
+{
+ OSErr err;
+ long count;
+ Lisp_Object result, elem;
+ DescType desc_type;
+ Size size;
+ AEKeyword keyword;
+ AEDesc desc;
+ int attribute_p = 0;
+
+ err = AECountItems (desc_list, &count);
+ if (err != noErr)
+ return Qnil;
+ result = Qnil;
+
+ again:
+ while (count > 0)
+ {
+ if (attribute_p)
+ {
+ keyword = ae_attr_table[count - 1].keyword;
+ err = AESizeOfAttribute (desc_list, keyword, &desc_type, &size);
+ }
+ else
+ err = AESizeOfNthItem (desc_list, count, &desc_type, &size);
+
+ if (err == noErr)
+ switch (desc_type)
+ {
+ case typeAEList:
+ case typeAERecord:
+ case typeAppleEvent:
+ if (attribute_p)
+ err = AEGetAttributeDesc (desc_list, keyword, typeWildCard,
+ &desc);
+ else
+ 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);
+ if (attribute_p)
+ err = AEGetAttributePtr (desc_list, keyword, typeWildCard,
+ &desc_type, SDATA (elem),
+ size, &size);
+ else
+ 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 || desc_list->descriptorType == typeAEList)
+ {
+ if (err != noErr)
+ elem = Qnil; /* Don't skip elements in AEList. */
+ else if (desc_list->descriptorType != typeAEList)
+ {
+ if (attribute_p)
+ elem = Fcons (ae_attr_table[count-1].symbol, elem);
+ else
+ {
+ keyword = EndianU32_NtoB (keyword);
+ elem = Fcons (make_unibyte_string ((char *) &keyword, 4),
+ elem);
+ }
+ }
+
+ result = Fcons (elem, result);
+ }
+
+ count--;
+ }
+
+ if (desc_list->descriptorType == typeAppleEvent && !attribute_p)
+ {
+ attribute_p = 1;
+ count = sizeof (ae_attr_table) / sizeof (ae_attr_table[0]);
+ goto again;
+ }
+
+ desc_type = EndianU32_NtoB (desc_list->descriptorType);
+ return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
+}
+
+Lisp_Object
+mac_aedesc_to_lisp (desc)
+ const 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);
+}
+
+OSErr
+mac_ae_put_lisp (desc, keyword_or_index, obj)
+ AEDescList *desc;
+ UInt32 keyword_or_index;
+ Lisp_Object obj;
+{
+ OSErr err;
+
+ if (!(desc->descriptorType == typeAppleEvent
+ || desc->descriptorType == typeAERecord
+ || desc->descriptorType == typeAEList))
+ return errAEWrongDataType;
+
+ if (CONSP (obj) && STRINGP (XCAR (obj)) && SBYTES (XCAR (obj)) == 4)
+ {
+ DescType desc_type1 = EndianU32_BtoN (*((UInt32 *) SDATA (XCAR (obj))));
+ Lisp_Object data = XCDR (obj), rest;
+ AEDesc desc1;
+
+ switch (desc_type1)
+ {
+ case typeNull:
+ case typeAppleEvent:
+ break;
+
+ case typeAEList:
+ case typeAERecord:
+ err = AECreateList (NULL, 0, desc_type1 == typeAERecord, &desc1);
+ if (err == noErr)
+ {
+ for (rest = data; CONSP (rest); rest = XCDR (rest))
+ {
+ UInt32 keyword_or_index1 = 0;
+ Lisp_Object elem = XCAR (rest);
+
+ if (desc_type1 == typeAERecord)
+ {
+ if (CONSP (elem) && STRINGP (XCAR (elem))
+ && SBYTES (XCAR (elem)) == 4)
+ {
+ keyword_or_index1 =
+ EndianU32_BtoN (*((UInt32 *)
+ SDATA (XCAR (elem))));
+ elem = XCDR (elem);
+ }
+ else
+ continue;
+ }
+
+ err = mac_ae_put_lisp (&desc1, keyword_or_index1, elem);
+ if (err != noErr)
+ break;
+ }
+
+ if (err == noErr)
+ {
+ if (desc->descriptorType == typeAEList)
+ err = AEPutDesc (desc, keyword_or_index, &desc1);
+ else
+ err = AEPutParamDesc (desc, keyword_or_index, &desc1);
+ }
+
+ AEDisposeDesc (&desc1);
+ }
+ return err;
+
+ default:
+ if (!STRINGP (data))
+ break;
+ if (desc->descriptorType == typeAEList)
+ err = AEPutPtr (desc, keyword_or_index, desc_type1,
+ SDATA (data), SBYTES (data));
+ else
+ err = AEPutParamPtr (desc, keyword_or_index, desc_type1,
+ SDATA (data), SBYTES (data));
+ return err;
+ }
+ }
+
+ if (desc->descriptorType == typeAEList)
+ err = AEPutPtr (desc, keyword_or_index, typeNull, NULL, 0);
+ else
+ err = AEPutParamPtr (desc, keyword_or_index, typeNull, NULL, 0);
+
+ return err;
+}
+
+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;
+
+ if (err != noErr)
+ {
+ /* Just to be paranoid ... */
+ FSRef fref;
+ char *buf;
+
+ buf = xmalloc (data_size + 1);
+ memcpy (buf, data_ptr, data_size);
+ buf[data_size] = '\0';
+ err = FSPathMakeRef (buf, &fref, NULL);
+ xfree (buf);
+ if (err == noErr)
+ err = AECoercePtr (typeFSRef, &fref, sizeof (FSRef),
+ to_type, result);
+ }
+#else
+ FSSpec fs;
+ char *buf;
+
+ buf = xmalloc (data_size + 1);
+ memcpy (buf, data_ptr, data_size);
+ buf[data_size] = '\0';
+ err = posix_pathname_to_fsspec (buf, &fs);
+ xfree (buf);
+ 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);
+ 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);
+ }
+
+ if (err != noErr)
+ {
+ /* Coercion from typeAlias to typeFileURL fails on Mac OS X
+ 10.2. In such cases, try typeFSRef as a target type. */
+ char file_name[MAXPATHLEN];
+
+ if (type_code == typeFSRef && data_size == sizeof (FSRef))
+ err = FSRefMakePath (data_ptr, file_name, sizeof (file_name));
+ else
+ {
+ AEDesc desc;
+ FSRef fref;
+
+ err = AECoercePtr (type_code, data_ptr, data_size,
+ typeFSRef, &desc);
+ if (err == noErr)
+ {
+ err = AEGetDescData (&desc, &fref, sizeof (FSRef));
+ AEDisposeDesc (&desc);
+ }
+ if (err == noErr)
+ err = FSRefMakePath (&fref, file_name, sizeof (file_name));
+ }
+ if (err == noErr)
+ err = AECreateDesc (TYPE_FILE_NAME, file_name,
+ strlen (file_name), result);
+ }
+#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
+ AEDisposeDesc (&desc);
+ }
+ if (err == noErr)
+ err = fsspec_to_posix_pathname (&fs, file_name,
+ sizeof (file_name) - 1);
+ }
+ 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 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);
+ }
+
+ 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
+static OSErr
+create_apple_event (class, id, result)
+ AEEventClass class;
+ AEEventID id;
+ AppleEvent *result;
+{
+ OSErr err;
+ static const ProcessSerialNumber psn = {0, kCurrentProcess};
+ AEAddressDesc address_desc;
+
+ err = AECreateDesc (typeProcessSerialNumber, &psn,
+ sizeof (ProcessSerialNumber), &address_desc);
+ if (err == noErr)
+ {
+ err = AECreateAppleEvent (class, id,
+ &address_desc, /* NULL is not allowed
+ on Mac OS Classic. */
+ kAutoGenerateReturnID,
+ kAnyTransactionID, result);
+ AEDisposeDesc (&address_desc);
+ }
+
+ return err;
+}
+
+OSStatus
+create_apple_event_from_event_ref (event, num_params, names, types, result)
+ EventRef event;
+ UInt32 num_params;
+ const EventParamName *names;
+ const EventParamType *types;
+ AppleEvent *result;
+{
+ OSStatus err;
+ UInt32 i, size;
+ CFStringRef string;
+ CFDataRef data;
+ char *buf = NULL;
+
+ err = create_apple_event (0, 0, result); /* Dummy class and ID. */
+ 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;
+ AEPutParamPtr (result, names[i], typeUTF8Text,
+ 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 = xrealloc (buf, size);
+ err = GetEventParameter (event, names[i], types[i], NULL,
+ size, NULL, buf);
+ if (err == noErr)
+ AEPutParamPtr (result, names[i], types[i], buf, size);
+ break;
+ }
+ if (buf)
+ xfree (buf);
+
+ return noErr;
+}
+
+OSErr
+create_apple_event_from_drag_ref (drag, num_types, types, result)
+ DragRef drag;
+ UInt32 num_types;
+ const FlavorType *types;
+ AppleEvent *result;
+{
+ OSErr err;
+ UInt16 num_items;
+ AppleEvent items;
+ long index;
+ char *buf = NULL;
+
+ err = CountDragItems (drag, &num_items);
+ if (err != noErr)
+ return err;
+ err = AECreateList (NULL, 0, false, &items);
+ if (err != noErr)
+ return err;
+
+ for (index = 1; index <= num_items; index++)
+ {
+ ItemReference item;
+ DescType desc_type = typeNull;
+ Size size;
+
+ err = GetDragItemReferenceNumber (drag, index, &item);
+ if (err == noErr)
+ {
+ int i;
+
+ for (i = 0; i < num_types; i++)
+ {
+ err = GetFlavorDataSize (drag, item, types[i], &size);
+ if (err == noErr)
+ {
+ buf = xrealloc (buf, size);
+ err = GetFlavorData (drag, item, types[i], buf, &size, 0);
+ }
+ if (err == noErr)
+ {
+ desc_type = types[i];
+ break;
+ }
+ }
+ }
+ err = AEPutPtr (&items, index, desc_type,
+ desc_type != typeNull ? buf : NULL,
+ desc_type != typeNull ? size : 0);
+ if (err != noErr)
+ break;
+ }
+ if (buf)
+ xfree (buf);
+
+ if (err == noErr)
+ {
+ err = create_apple_event (0, 0, result); /* Dummy class and ID. */
+ if (err == noErr)
+ err = AEPutParamDesc (result, keyDirectObject, &items);
+ if (err != noErr)
+ AEDisposeDesc (result);
+ }
+
+ AEDisposeDesc (&items);
+
+ return err;
+}
+#endif /* TARGET_API_MAC_CARBON */
\f
/***********************************************************************
Conversion between Lisp and Core Foundation objects
#if TARGET_API_MAC_CARBON
static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
static Lisp_Object Qarray, Qdictionary;
-extern Lisp_Object Qutf_8;
-#define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
struct cfdict_context
{
int with_tag, hash_bound;
};
-/* C string to CFString. */
+/* C string to CFString. */
CFStringRef
cfstring_create_with_utf8_cstring (c_str)
}
+/* Lisp string to CFString. */
+
+CFStringRef
+cfstring_create_with_string (s)
+ Lisp_Object s;
+{
+ CFStringRef string = NULL;
+
+ if (STRING_MULTIBYTE (s))
+ {
+ char *p, *end = SDATA (s) + SBYTES (s);
+
+ for (p = SDATA (s); p < end; p++)
+ if (!isascii (*p))
+ {
+ s = ENCODE_UTF_8 (s);
+ break;
+ }
+ string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
+ kCFStringEncodingUTF8, false);
+ }
+
+ if (string == NULL)
+ /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
+ string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
+ kCFStringEncodingMacRoman, false);
+
+ return string;
+}
+
+
/* From CFData to a lisp string. Always returns a unibyte string. */
Lisp_Object
{
CFIndex len = CFDataGetLength (data);
Lisp_Object result = make_uninit_string (len);
-
+
CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
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. */
+/* 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;
}
}
+ 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);
CFNumberRef number;
{
Lisp_Object result = Qnil;
-#if BITS_PER_EMACS_INT > 32
+#if BITS_PER_EMACS_INT > 32
SInt64 int_val;
CFNumberType emacs_int_type = kCFNumberSInt64Type;
#else
/* CFDate to a list of three integers as in a return value of
- `current-time'xo. */
+ `current-time'. */
Lisp_Object
cfdate_to_lisp (date)
CFDateRef date;
{
- static CFGregorianDate epoch_gdate = {1970, 1, 1, 0, 0, 0.0};
+ static const CFGregorianDate epoch_gdate = {1970, 1, 1, 0, 0, 0.0};
static CFAbsoluteTime epoch = 0.0, sec;
int high, low;
static void
skip_white_space (p)
- char **p;
+ const char **p;
{
/* WhiteSpace = {<space> | <horizontal tab>} */
while (*P == ' ' || *P == '\t')
static int
parse_comment (p)
- char **p;
+ const char **p;
{
/* Comment = "!" {<any character except null or newline>} */
if (*P == '!')
/* Don't interpret filename. Just skip until the newline. */
static int
parse_include_file (p)
- char **p;
+ const char **p;
{
/* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
if (*P == '#')
static char
parse_binding (p)
- char **p;
+ const char **p;
{
/* Binding = "." | "*" */
if (*P == '.' || *P == '*')
static Lisp_Object
parse_component (p)
- char **p;
+ const char **p;
{
/* Component = "?" | ComponentName
ComponentName = NameChar {NameChar}
}
else if (isalnum (*P) || *P == '_' || *P == '-')
{
- char *start = P++;
+ const char *start = P++;
while (isalnum (*P) || *P == '_' || *P == '-')
P++;
static Lisp_Object
parse_resource_name (p)
- char **p;
+ const char **p;
{
Lisp_Object result = Qnil, component;
char binding;
if (NILP (component))
return Qnil;
- result = Fcons (component, result);
- while (binding = parse_binding (p))
+ result = Fcons (component, result);
+ while ((binding = parse_binding (p)) != '\0')
{
if (binding == '*')
result = Fcons (LOOSE_BINDING, result);
else
result = Fcons (component, result);
}
-
+
/* The final component should not be '?'. */
if (EQ (component, SINGLE_COMPONENT))
return Qnil;
static Lisp_Object
parse_value (p)
- char **p;
+ const char **p;
{
char *q, *buf;
Lisp_Object seq = Qnil, result;
&& '0' <= P[1] && P[1] <= '7'
&& '0' <= P[2] && P[2] <= '7')
{
- *q++ = (P[0] - '0' << 6) + (P[1] - '0' << 3) + (P[2] - '0');
+ *q++ = ((P[0] - '0') << 6) + ((P[1] - '0') << 3) + (P[2] - '0');
P += 3;
}
else
q = buf + total_len;
for (; CONSP (seq); seq = XCDR (seq))
{
- len = SBYTES (XCAR (seq));
+ len = SBYTES (XCAR (seq));
q -= len;
memcpy (q, SDATA (XCAR (seq)), len);
}
static Lisp_Object
parse_resource_line (p)
- char **p;
+ const char **p;
{
Lisp_Object quarks, value;
An X Resource Database acts as a collection of resource names and
associated values. It is implemented as a trie on quarks. Namely,
each edge is labeled by either a string, LOOSE_BINDING, or
- SINGLE_COMPONENT. Nodes of the trie are implemented as Lisp hash
- tables, and a value associated with a resource name is recorded as
- a value for HASHKEY_TERMINAL at the hash table whose path from the
- root is the quarks of the resource name. */
+ SINGLE_COMPONENT. Each node has a node id, which is a unique
+ nonnegative integer, and the root node id is 0. A database is
+ 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 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_TERMINAL Qt /* "T"erminal */
+#define HASHKEY_MAX_NID (make_number (0))
+#define HASHKEY_QUERY_CACHE (make_number (-1))
static XrmDatabase
xrm_create_database ()
{
- return make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
- make_float (DEFAULT_REHASH_SIZE),
- make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ XrmDatabase database;
+
+ database = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil);
+ Fputhash (HASHKEY_MAX_NID, make_number (0), database);
+ Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
+
+ return database;
}
static void
XrmDatabase database;
Lisp_Object quarks, value;
{
- struct Lisp_Hash_Table *h;
+ struct Lisp_Hash_Table *h = XHASH_TABLE (database);
unsigned hash_code;
- int i;
+ int max_nid, i;
+ Lisp_Object node_id, key;
+
+ max_nid = XINT (Fgethash (HASHKEY_MAX_NID, database, Qnil));
+ XSETINT (node_id, 0);
for (; CONSP (quarks); quarks = XCDR (quarks))
{
- h = XHASH_TABLE (database);
- i = hash_lookup (h, XCAR (quarks), &hash_code);
+ key = Fcons (node_id, XCAR (quarks));
+ i = hash_lookup (h, key, &hash_code);
if (i < 0)
{
- database = xrm_create_database ();
- hash_put (h, XCAR (quarks), database, hash_code);
+ max_nid++;
+ XSETINT (node_id, max_nid);
+ hash_put (h, key, node_id, hash_code);
}
else
- database = HASH_VALUE (h, i);
+ node_id = HASH_VALUE (h, i);
}
+ Fputhash (node_id, value, database);
- Fputhash (HASHKEY_TERMINAL, 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
void
xrm_merge_string_database (database, data)
XrmDatabase database;
- char *data;
+ const char *data;
{
Lisp_Object quarks_value;
}
static Lisp_Object
-xrm_q_get_resource (database, quark_name, quark_class)
+xrm_q_get_resource_1 (database, node_id, quark_name, quark_class)
XrmDatabase database;
- Lisp_Object quark_name, quark_class;
+ Lisp_Object node_id, quark_name, quark_class;
{
struct Lisp_Hash_Table *h = XHASH_TABLE (database);
- Lisp_Object keys[3], value;
+ Lisp_Object key, labels[3], value;
int i, k;
-
+
if (!CONSP (quark_name))
- return Fgethash (HASHKEY_TERMINAL, database, Qnil);
-
+ return Fgethash (node_id, database, Qnil);
+
/* First, try tight bindings */
- keys[0] = XCAR (quark_name);
- keys[1] = XCAR (quark_class);
- keys[2] = SINGLE_COMPONENT;
+ labels[0] = XCAR (quark_name);
+ labels[1] = XCAR (quark_class);
+ labels[2] = SINGLE_COMPONENT;
- for (k = 0; k < sizeof (keys) / sizeof (*keys); k++)
+ key = Fcons (node_id, Qnil);
+ for (k = 0; k < sizeof (labels) / sizeof (*labels); k++)
{
- i = hash_lookup (h, keys[k], NULL);
+ XSETCDR (key, labels[k]);
+ i = hash_lookup (h, key, NULL);
if (i >= 0)
{
- value = xrm_q_get_resource (HASH_VALUE (h, i),
- XCDR (quark_name), XCDR (quark_class));
+ value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
+ XCDR (quark_name), XCDR (quark_class));
if (!NILP (value))
return value;
}
}
/* Then, try loose bindings */
- i = hash_lookup (h, LOOSE_BINDING, NULL);
+ XSETCDR (key, LOOSE_BINDING);
+ i = hash_lookup (h, key, NULL);
if (i >= 0)
{
- value = xrm_q_get_resource (HASH_VALUE (h, i), quark_name, quark_class);
+ value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
+ quark_name, quark_class);
if (!NILP (value))
return value;
else
- return xrm_q_get_resource (database,
- XCDR (quark_name), XCDR (quark_class));
+ return xrm_q_get_resource_1 (database, node_id,
+ XCDR (quark_name), XCDR (quark_class));
}
else
return Qnil;
}
+static Lisp_Object
+xrm_q_get_resource (database, quark_name, quark_class)
+ XrmDatabase database;
+ Lisp_Object quark_name, quark_class;
+{
+ return xrm_q_get_resource_1 (database, make_number (0),
+ quark_name, quark_class);
+}
+
/* Retrieve a resource value for the specified NAME and CLASS from the
resource database DATABASE. It corresponds to XrmGetResource. */
Lisp_Object
xrm_get_resource (database, name, class)
XrmDatabase database;
- char *name, *class;
+ const 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')
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
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;
return result;
}
else if (type_id == CFBooleanGetTypeID ())
- {
- static value_true = NULL, value_false = NULL;
-
- if (value_true == NULL)
- {
- value_true = build_string ("true");
- value_false = build_string ("false");
- }
- return CFBooleanGetValue (plist) ? value_true : value_false;
- }
+ return build_string (CFBooleanGetValue (plist) ? "true" : "false");
else if (type_id == CFDataGetTypeID ())
return cfdata_to_lisp (plist);
else
XrmDatabase
xrm_get_preference_database (application)
- char *application;
+ const char *application;
{
#if TARGET_API_MAC_CARBON
CFStringRef app_id, *keys, user_doms[2], host_doms[2];
count = CFSetGetCount (key_set);
keys = xmalloc (sizeof (CFStringRef) * count);
- if (keys == NULL)
- goto out;
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))
{
int res = open (mac_pathname, oflag);
/* if (oflag == O_WRONLY || oflag == O_RDWR) */
if (oflag & O_CREAT)
- fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
+ fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
return res;
#else /* not __MRC__ */
return open (mac_pathname, oflag);
{
#ifdef __MRC__
int result = creat (mac_pathname);
- fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
+ fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
return result;
#else /* not __MRC__ */
return creat (mac_pathname, mode);
{
#ifdef __MRC__
if (mode[0] == 'w' || mode[0] == 'a')
- fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
+ fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
#endif /* not __MRC__ */
return fopen (mac_pathname, 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. */
+extern Boolean mac_wait_next_event P_ ((EventRecord *, UInt32, Boolean));
-void
-check_alarm ()
+int
+select (nfds, rfds, wfds, efds, timeout)
+ int nfds;
+ SELECT_TYPE *rfds, *wfds, *efds;
+ EMACS_TIME *timeout;
{
- if (target_ticks && TickCount () > target_ticks)
- {
- target_ticks = 0;
- if (alarm_signal_func)
- (*alarm_signal_func)(SIGALRM);
- }
-}
-
+ OSStatus err = noErr;
-extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
+ /* Can only handle wait for keyboard input. */
+ if (nfds > 1 || wfds || efds)
+ return -1;
-int
-select (n, rfds, wfds, efds, timeout)
- int n;
- SELECT_TYPE *rfds;
- SELECT_TYPE *wfds;
- SELECT_TYPE *efds;
- struct timeval *timeout;
-{
+ /* Try detect_input_pending before ReceiveNextEvent in the same
+ BLOCK_INPUT block, in case that some input has already been read
+ asynchronously. */
+ BLOCK_INPUT;
+ ENABLE_WAKEUP_FROM_RNE;
+ if (!detect_input_pending ())
+ {
#if TARGET_API_MAC_CARBON
- OSErr err;
- EventTimeout timeout_sec =
- (timeout
- ? (EMACS_SECS (*timeout) * kEventDurationSecond
- + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
- : kEventDurationForever);
+ EventTimeout timeoutval =
+ (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;
+ if (timeoutval == 0.0)
+ err = eventLoopTimedOutErr;
else
- FD_ZERO (rfds);
- }
- return 0;
+ err = ReceiveNextEvent (0, NULL, timeoutval,
+ kEventLeaveInQueue, NULL);
#else /* not TARGET_API_MAC_CARBON */
- EventRecord e;
- UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
- ((EMACS_USECS (*timeout) * 60) / 1000000);
-
- /* Can only handle wait for keyboard input. */
- if (n > 1 || wfds || efds)
- return -1;
+ EventRecord e;
+ UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
+ ((EMACS_USECS (*timeout) * 60) / 1000000);
- /* Also return true if an event other than a keyDown has occurred.
- This causes kbd_buffer_get_event in keyboard.c to call
- 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 (sleep_time == 0)
+ err = -9875; /* eventLoopTimedOutErr */
+ else
+ {
+ 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;
+ }
+ DISABLE_WAKEUP_FROM_RNE;
+ UNBLOCK_INPUT;
- if ((tick = TickCount ()) < target_ticks)
- WaitNextEvent (0, &e, target_ticks - tick, NULL); /* Accept no event;
- just wait. by T.I. */
+ if (err == noErr)
+ {
+ /* Pretend that `select' is interrupted by a signal. */
+ detect_input_pending ();
+ errno = EINTR;
+ return -1;
+ }
+ else
+ {
+ if (rfds)
+ FD_ZERO (rfds);
+ 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 <signal.h>
+#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__
}
+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
#else
time_t mac_time = time (NULL) - CW_OR_MPW_UNIX_EPOCH_DIFF;
#endif
-
- if (timer)
- *timer = mac_time;
-
- return mac_time;
-}
-
-
-/* MPW strftime broken for "%p" format */
-#ifdef __MRC__
-#undef strftime
-#include <time.h>
-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);
+
+ if (timer)
+ *timer = mac_time;
+
+ return mac_time;
}
-#endif /* __MRC__ */
/* no subprocesses, empty wait */
}
-char *
-index (const char * str, int chr)
-{
- return strchr (str, chr);
-}
-
-
char *
mktemp (char *template)
{
}
-int
-sigsetmask (int x)
-{
- return 0;
-}
-
-
-int
-sigblock (int mask)
-{
- return 0;
-}
-
-
void
request_sigio (void)
{
/* Determine the path name of the file specified by VREFNUM, DIRID,
and NAME and place that in the buffer PATH of length
MAXPATHLEN. */
-int
+static int
path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num,
long dir_id, ConstStr255Param name)
{
}
-OSErr
+#ifndef MAC_OSX
+
+static OSErr
posix_pathname_to_fsspec (ufn, fs)
const char *ufn;
FSSpec *fs;
}
}
-OSErr
+static OSErr
fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
const FSSpec *fs;
char *ufn;
return fnfErr;
}
-#ifndef MAC_OSX
-
int
readlink (const char *path, char *buf, int bufsiz)
{
}
+int
+fchmod (int fd, mode_t mode)
+{
+ /* say it always succeed for now */
+ return 0;
+}
+
+
+int
+fchown (int fd, uid_t owner, gid_t group)
+{
+ /* say it always succeed for now */
+ return 0;
+}
+
+
int
dup (int oldd)
{
short vol_ref_num;
long dir_id;
OSErr err;
- Str255 dir_name, full_path;
- CInfoPBRec cpb;
+ Str255 full_path;
char unix_dir_name[MAXPATHLEN+1];
DIR *dir;
short vol_ref_num;
long dir_id;
OSErr err;
- Str255 dir_name, full_path;
- CInfoPBRec cpb;
+ Str255 full_path;
static char system_folder_unix_name[MAXPATHLEN+1];
DIR *dir;
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)
}
-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. */
-/* 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. */
-
-static long
-do_applescript (char *script, char **result)
+OSType
+mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
{
- AEDesc script_desc, result_desc, error_desc;
- OSErr error;
- OSAError osaerror;
- long length;
-
- *result = 0;
-
- if (!as_scripting_component)
- initialize_applescript();
-
- error = AECreateDesc (typeChar, script, strlen(script), &script_desc);
- if (error)
- return error;
-
- osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
- typeChar, kOSAModeNull, &result_desc);
-
- if (osaerror == errOSAScriptError)
+ OSType result;
+ if (NILP(arg))
{
- /* 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);
- }
+ result = defCode;
}
- else if (osaerror == noErr) /* success: retrieve resulting script value */
+ else
{
-#if TARGET_API_MAC_CARBON
- length = AEGetDescDataSize (&result_desc);
- *result = (char *) xmalloc (length + 1);
- if (*result)
- {
- AEGetDescData (&result_desc, *result, length);
- *(*result + length) = '\0';
- }
-#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);
-#endif /* not TARGET_API_MAC_CARBON */
- AEDisposeDesc (&result_desc);
+ /* 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;
+}
- AEDisposeDesc (&script_desc);
+/* Convert the 4 byte character code into a 4 byte string. */
- return osaerror;
+Lisp_Object
+mac_get_object_from_code(OSType defCode)
+{
+ UInt32 code = EndianU32_NtoB (defCode);
+
+ return make_unibyte_string ((char *)&code, 4);
}
-DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
- doc: /* Compile and execute AppleScript SCRIPT and retrieve 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)
- Lisp_Object script;
+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;
{
- char *result, *temp;
- Lisp_Object lisp_result;
- long status;
+ OSStatus status;
+#ifdef MAC_OSX
+ FSRef fref;
+#else
+ FSSpec fss;
+#endif
+ Lisp_Object result = Qnil;
+ CHECK_STRING (filename);
- CHECK_STRING (script);
+ if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
+ return Qnil;
+ }
+ filename = Fexpand_file_name (filename, Qnil);
BLOCK_INPUT;
- status = do_applescript (SDATA (script), &result);
- UNBLOCK_INPUT;
- if (status)
+#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)
{
- 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);
- }
+#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
+ }
}
- else
+ 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;
+{
+ OSStatus status;
+#ifdef MAC_OSX
+ FSRef fref;
+#else
+ FSSpec fss;
+#endif
+ 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)
{
- lisp_result = build_string (result);
- xfree (result);
- return lisp_result;
+#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-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;
+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;
{
- char posix_filename[MAXPATHLEN+1];
+ OSStatus status;
+#ifdef MAC_OSX
+ FSRef fref;
+#else
+ FSSpec fss;
+#endif
+ OSType cCode;
+ CHECK_STRING (filename);
- CHECK_STRING (mac_filename);
+ cCode = mac_get_code_from_arg(code, MAC_EMACS_CREATOR_CODE);
- if (mac_to_posix_pathname (SDATA (mac_filename), posix_filename,
- MAXPATHLEN))
- return build_string (posix_filename);
- else
+ 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
-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;
+ 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;
{
- char mac_filename[MAXPATHLEN+1];
+ OSStatus status;
+#ifdef MAC_OSX
+ FSRef fref;
+#else
+ FSSpec fss;
+#endif
+ OSType cCode;
+ CHECK_STRING (filename);
- CHECK_STRING (posix_filename);
+ cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
- if (posix_to_mac_pathname (SDATA (posix_filename), mac_filename,
- MAXPATHLEN))
- return build_string (mac_filename);
- else
+ 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
-/* set interprogram-paste-function to mac-paste-function in mac-win.el
- to enable Emacs to obtain the contents of the Mac clipboard. */
-DEFUN ("mac-paste-function", Fmac_paste_function, Smac_paste_function, 0, 0, 0,
- doc: /* Return the contents of the Mac clipboard as a string. */)
- ()
-{
-#if TARGET_API_MAC_CARBON
- OSStatus err;
- ScrapRef scrap;
- ScrapFlavorFlags sff;
- Size s;
- int i;
- char *data;
+ if (status == noErr)
+ {
+#ifdef MAC_OSX
+ FSCatalogInfo catalogInfo;
+ FSRef parentDir;
+ status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
+ &catalogInfo, NULL, NULL, &parentDir);
+#else
+ FInfo finder_info;
- BLOCK_INPUT;
- err = GetCurrentScrap (&scrap);
- if (err == noErr)
- err = GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff);
- if (err == noErr)
- err = GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s);
- if (err == noErr && (data = (char*) alloca (s)))
- err = GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data);
+ 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 (err != noErr || s == 0)
- return Qnil;
-
- /* Emacs expects clipboard contents have Unix-style eol's */
- for (i = 0; i < s; i++)
- if (data[i] == '\r')
- data[i] = '\n';
+ if (status != noErr) {
+ error ("Error while setting creator information.");
+ }
+ return Qt;
+}
- return make_string (data, s);
-#else /* not TARGET_API_MAC_CARBON */
- Lisp_Object value;
- Handle my_handle;
- long scrap_offset, rc, i;
- my_handle = NewHandle (0); /* allocate 0-length data area */
+/* 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 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. */
- rc = GetScrap (my_handle, 'TEXT', &scrap_offset);
- if (rc < 0)
- return Qnil;
+static long
+do_applescript (script, result)
+ Lisp_Object script, *result;
+{
+ AEDesc script_desc, result_desc, error_desc, *desc = NULL;
+ OSErr error;
+ OSAError osaerror;
- HLock (my_handle);
+ *result = Qnil;
- /* Emacs expects clipboard contents have Unix-style eol's */
- for (i = 0; i < rc; i++)
- if ((*my_handle)[i] == '\r')
- (*my_handle)[i] = '\n';
+ if (!as_scripting_component)
+ initialize_applescript();
- value = make_string (*my_handle, rc);
+ error = AECreateDesc (typeChar, SDATA (script), SBYTES (script),
+ &script_desc);
+ if (error)
+ return error;
- HUnlock (my_handle);
+ osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
+ typeChar, kOSAModeNull, &result_desc);
- DisposeHandle (my_handle);
+ 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;
- return value;
+ if (desc)
+ {
+#if TARGET_API_MAC_CARBON
+ *result = make_uninit_string (AEGetDescDataSize (desc));
+ AEGetDescData (desc, SDATA (*result), SBYTES (*result));
+#else /* not TARGET_API_MAC_CARBON */
+ *result = make_uninit_string (GetHandleSize (desc->dataHandle));
+ memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result));
#endif /* not TARGET_API_MAC_CARBON */
-}
+ AEDisposeDesc (desc);
+ }
+ AEDisposeDesc (&script_desc);
-/* set interprogram-cut-function to mac-cut-function in mac-win.el
- to enable Emacs to write the top of the kill-ring to the Mac clipboard. */
-DEFUN ("mac-cut-function", Fmac_cut_function, Smac_cut_function, 1, 2, 0,
- doc: /* Put the value of the string parameter to the Mac clipboard. */)
- (value, push)
- Lisp_Object value, push;
-{
- char *buf;
- int len, i;
+ return osaerror;
+}
- /* fixme: ignore the push flag for now */
- CHECK_STRING (value);
+DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
+ 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)
+ Lisp_Object script;
+{
+ Lisp_Object result;
+ long status;
- len = SCHARS (value);
- buf = (char *) alloca (len+1);
- bcopy (SDATA (value), buf, len);
- buf[len] = '\0';
+ CHECK_STRING (script);
- /* convert to Mac-style eol's before sending to clipboard */
- for (i = 0; i < len; i++)
- if (buf[i] == '\n')
- buf[i] = '\r';
+ BLOCK_INPUT;
+ status = do_applescript (script, &result);
+ UNBLOCK_INPUT;
+ if (status == 0)
+ return result;
+ else if (!STRINGP (result))
+ error ("AppleScript error %d", status);
+ else
+ error ("%s", SDATA (result));
+}
-#if TARGET_API_MAC_CARBON
- {
- ScrapRef scrap;
- BLOCK_INPUT;
- ClearCurrentScrap ();
- if (GetCurrentScrap (&scrap) != noErr)
- {
- UNBLOCK_INPUT;
- error ("cannot get current scrap");
- }
+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. */)
+ (filename)
+ Lisp_Object filename;
+{
+ char posix_filename[MAXPATHLEN+1];
- if (PutScrapFlavor (scrap, kScrapFlavorTypeText, kScrapFlavorMaskNone, len,
- buf) != noErr)
- {
- UNBLOCK_INPUT;
- error ("cannot put to scrap");
- }
- UNBLOCK_INPUT;
- }
-#else /* not TARGET_API_MAC_CARBON */
- ZeroScrap ();
- PutScrap (len, 'TEXT', buf);
-#endif /* not TARGET_API_MAC_CARBON */
+ CHECK_STRING (filename);
- return Qnil;
+ if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN))
+ return build_string (posix_filename);
+ else
+ return Qnil;
}
-DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
- 0, 1, 0,
- doc: /* Whether there is an owner for the given X Selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'. */)
- (selection)
- Lisp_Object selection;
+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. */)
+ (filename)
+ Lisp_Object filename;
{
- CHECK_SYMBOL (selection);
-
- /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
- if the clipboard currently has valid text format contents. */
+ char mac_filename[MAXPATHLEN+1];
- if (EQ (selection, QCLIPBOARD))
- {
- Lisp_Object val = Qnil;
+ CHECK_STRING (filename);
-#if TARGET_API_MAC_CARBON
- ScrapRef scrap;
- ScrapFlavorFlags sff;
+ if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN))
+ return build_string (mac_filename);
+ else
+ return Qnil;
+}
- BLOCK_INPUT;
- if (GetCurrentScrap (&scrap) == noErr)
- if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) == noErr)
- val = Qt;
- UNBLOCK_INPUT;
-#else /* not TARGET_API_MAC_CARBON */
- Handle my_handle;
- long rc, scrap_offset;
- my_handle = NewHandle (0);
+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;
- rc = GetScrap (my_handle, 'TEXT', &scrap_offset);
- if (rc >= 0)
- val = Qt;
+ 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);
- DisposeHandle (my_handle);
-#endif /* not TARGET_API_MAC_CARBON */
+ 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);
- return val;
+ 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);
}
- return Qnil;
+ UNBLOCK_INPUT;
+
+ return result;
}
+
#if TARGET_API_MAC_CARBON
-static Lisp_Object Qxml;
+static Lisp_Object Qxml, Qmime_charset;
+static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
doc: /* Return the application preference value for KEY.
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.
CFDate List of three integers date
(cf. `current-time')
CFData Unibyte string data
- CFArray Array array
+ CFArray Vector array
CFDictionary Alist or hash table dictionary
(depending on HASH-BOUND)
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;
CFPropertyListRef app_plist = NULL, plist;
Lisp_Object result = Qnil, tmp;
+ struct gcpro gcpro1, gcpro2;
if (STRINGP (key))
key = Fcons (key, Qnil);
CHECK_CONS (key);
for (tmp = key; CONSP (tmp); tmp = XCDR (tmp))
CHECK_STRING_CAR (tmp);
- if (!NILP (tmp))
- wrong_type_argument (Qlistp, key);
+ CHECK_LIST_END (tmp, key);
}
if (!NILP (application))
CHECK_STRING (application);
if (!NILP (hash_bound))
CHECK_NUMBER (hash_bound);
+ GCPRO2 (key, format);
+
BLOCK_INPUT;
app_id = kCFPreferencesCurrentApplication;
if (!NILP (application))
{
- app_id = cfstring_create_with_utf8_cstring (SDATA (application));
+ app_id = cfstring_create_with_string (application);
if (app_id == NULL)
goto out;
}
- key_str = cfstring_create_with_utf8_cstring (SDATA (XCAR (key)));
+ key_str = cfstring_create_with_string (XCAR (key));
if (key_str == NULL)
goto out;
app_plist = CFPreferencesCopyAppValue (key_str, app_id);
{
if (CFGetTypeID (plist) != CFDictionaryGetTypeID ())
break;
- key_str = cfstring_create_with_utf8_cstring (SDATA (XCAR (key)));
+ key_str = cfstring_create_with_string (XCAR (key));
if (key_str == NULL)
goto out;
plist = CFDictionaryGetValue (plist, key_str);
}
if (NILP (key))
- if (EQ (format, Qxml))
- {
- CFDataRef data = CFPropertyListCreateXMLData (NULL, plist);
- if (data == NULL)
- goto out;
- result = cfdata_to_lisp (data);
- CFRelease (data);
- }
- else
- result =
- cfproperty_list_to_lisp (plist, EQ (format, Qt),
- NILP (hash_bound) ? -1 : XINT (hash_bound));
+ {
+ if (EQ (format, Qxml))
+ {
+ CFDataRef data = CFPropertyListCreateXMLData (NULL, plist);
+ if (data == NULL)
+ goto out;
+ result = cfdata_to_lisp (data);
+ CFRelease (data);
+ }
+ else
+ result =
+ cfproperty_list_to_lisp (plist, EQ (format, Qt),
+ NILP (hash_bound) ? -1 : XINT (hash_bound));
+ }
out:
if (app_plist)
UNBLOCK_INPUT;
+ UNGCPRO;
+
return result;
}
-#endif /* TARGET_API_MAC_CARBON */
-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. */)
- ()
+static CFStringEncoding
+get_cfstring_encoding_from_lisp (obj)
+ Lisp_Object obj;
+{
+ CFStringRef iana_name;
+ CFStringEncoding encoding = kCFStringEncodingInvalidId;
+
+ if (NILP (obj))
+ return kCFStringEncodingUnicode;
+
+ if (INTEGERP (obj))
+ return XINT (obj);
+
+ if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj)))
+ {
+ Lisp_Object coding_spec, plist;
+
+ coding_spec = Fget (obj, Qcoding_system);
+ plist = XVECTOR (coding_spec)->contents[3];
+ obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset);
+ }
+
+ if (SYMBOLP (obj))
+ obj = SYMBOL_NAME (obj);
+
+ if (STRINGP (obj))
+ {
+ iana_name = cfstring_create_with_string (obj);
+ if (iana_name)
+ {
+ encoding = CFStringConvertIANACharSetNameToEncoding (iana_name);
+ CFRelease (iana_name);
+ }
+ }
+
+ return encoding;
+}
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
+static CFStringRef
+cfstring_create_normalized (str, symbol)
+ CFStringRef str;
+ Lisp_Object symbol;
+{
+ int form = -1;
+ TextEncodingVariant variant;
+ float initial_mag = 0.0;
+ CFStringRef result = NULL;
+
+ if (EQ (symbol, QNFD))
+ form = kCFStringNormalizationFormD;
+ else if (EQ (symbol, QNFKD))
+ form = kCFStringNormalizationFormKD;
+ else if (EQ (symbol, QNFC))
+ form = kCFStringNormalizationFormC;
+ else if (EQ (symbol, QNFKC))
+ form = kCFStringNormalizationFormKC;
+ else if (EQ (symbol, QHFS_plus_D))
+ {
+ variant = kUnicodeHFSPlusDecompVariant;
+ initial_mag = 1.5;
+ }
+ else if (EQ (symbol, QHFS_plus_C))
+ {
+ variant = kUnicodeHFSPlusCompVariant;
+ initial_mag = 1.0;
+ }
+
+ if (form >= 0)
+ {
+ CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str);
+
+ if (mut_str)
+ {
+ CFStringNormalize (mut_str, form);
+ result = mut_str;
+ }
+ }
+ else if (initial_mag > 0.0)
+ {
+ UnicodeToTextInfo uni = NULL;
+ UnicodeMapping map;
+ CFIndex length;
+ UniChar *in_text, *buffer = NULL, *out_buf = NULL;
+ OSStatus err = noErr;
+ ByteCount out_read, out_size, out_len;
+
+ map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
+ kUnicodeNoSubset,
+ kTextEncodingDefaultFormat);
+ map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
+ variant,
+ kTextEncodingDefaultFormat);
+ map.mappingVersion = kUnicodeUseLatestMapping;
+
+ length = CFStringGetLength (str);
+ out_size = (int)((float)length * initial_mag) * sizeof (UniChar);
+ if (out_size < 32)
+ out_size = 32;
+
+ in_text = (UniChar *)CFStringGetCharactersPtr (str);
+ if (in_text == NULL)
+ {
+ buffer = xmalloc (sizeof (UniChar) * length);
+ CFStringGetCharacters (str, CFRangeMake (0, length), buffer);
+ in_text = buffer;
+ }
+
+ if (in_text)
+ err = CreateUnicodeToTextInfo (&map, &uni);
+ while (err == noErr)
+ {
+ out_buf = xmalloc (out_size);
+ err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar),
+ in_text,
+ kUnicodeDefaultDirectionMask,
+ 0, NULL, NULL, NULL,
+ out_size, &out_read, &out_len,
+ out_buf);
+ if (err == noErr && out_read < length * sizeof (UniChar))
+ {
+ xfree (out_buf);
+ out_size += length;
+ }
+ else
+ break;
+ }
+ if (err == noErr)
+ result = CFStringCreateWithCharacters (NULL, out_buf,
+ out_len / sizeof (UniChar));
+ if (uni)
+ DisposeUnicodeToTextInfo (&uni);
+ if (out_buf)
+ xfree (out_buf);
+ if (buffer)
+ xfree (buffer);
+ }
+ else
+ {
+ result = str;
+ CFRetain (result);
+ }
+
+ return result;
+}
+#endif
+
+DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0,
+ doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
+The conversion is performed using the converter provided by the system.
+Each encoding is specified by either a coding system symbol, a mime
+charset string, or an integer as a CFStringEncoding value. An encoding
+of nil 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, return the result string, else return nil. */)
+ (string, source, target, normalization_form)
+ Lisp_Object string, source, target, normalization_form;
+{
+ Lisp_Object result = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ CFStringEncoding src_encoding, tgt_encoding;
+ CFStringRef str = NULL;
+
+ CHECK_STRING (string);
+ if (!INTEGERP (source) && !STRINGP (source))
+ CHECK_SYMBOL (source);
+ if (!INTEGERP (target) && !STRINGP (target))
+ CHECK_SYMBOL (target);
+ CHECK_SYMBOL (normalization_form);
+
+ GCPRO4 (string, source, target, normalization_form);
+
+ BLOCK_INPUT;
+
+ src_encoding = get_cfstring_encoding_from_lisp (source);
+ tgt_encoding = get_cfstring_encoding_from_lisp (target);
+
+ /* 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, !NILP (source));
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
+ if (str)
+ {
+ CFStringRef saved_str = str;
+
+ str = cfstring_create_normalized (saved_str, normalization_form);
+ CFRelease (saved_str);
+ }
+#endif
+ if (str)
+ {
+ 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);
+ }
+
+ UNBLOCK_INPUT;
+
+ UNGCPRO;
+
+ return result;
+}
+
+DEFUN ("mac-process-hi-command", Fmac_process_hi_command, Smac_process_hi_command, 1, 1, 0,
+ doc: /* Send a HI command whose ID is COMMAND-ID to the command chain.
+COMMAND-ID must be a 4-character string. Some common command IDs are
+defined in the Carbon Event Manager. */)
+ (command_id)
+ Lisp_Object command_id;
{
- check_mac ();
- mac_clear_font_name_table ();
+ OSStatus err;
+ HICommand command;
+
+ bzero (&command, sizeof (HICommand));
+ command.commandID = mac_get_code_from_arg (command_id, 0);
+
+ BLOCK_INPUT;
+ err = ProcessHICommand (&command);
+ UNBLOCK_INPUT;
+
+ if (err != noErr)
+ error ("HI command (command ID: '%s') not handled.", SDATA (command_id));
+
return Qnil;
}
+#endif /* TARGET_API_MAC_CARBON */
+
+
+static Lisp_Object
+mac_get_system_locale ()
+{
+ OSStatus 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
extern int inhibit_window_system;
extern int noninteractive;
-> Use `select'.
2. Sockets are not involved.
-> Use ReceiveNextEvent.
- 3. [If SELECT_USE_CFSOCKET is defined]
- Only the window event channel and socket read channels are
+ 3. [If SELECT_USE_CFSOCKET is set]
+ Only the window event channel and socket read/write channels are
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
- to the event queue that is also used for window events. Then
- ReceiveNextEvent can wait for both kinds of inputs.
+ event RunLoop so that the current event loop gets quit when
+ the socket becomes ready. Then ReceiveNextEvent can wait for
+ both kinds of inputs.
4. Otherwise.
-> Periodically poll the window input channel while repeatedly
executing `select' with a short timeout
(SELECT_POLLING_PERIOD_USEC microseconds). */
-#define SELECT_POLLING_PERIOD_USEC 20000
-#ifdef SELECT_USE_CFSOCKET
+#ifndef SELECT_USE_CFSOCKET
+#define SELECT_USE_CFSOCKET 1
+#endif
+
+#define SELECT_POLLING_PERIOD_USEC 100000
+#if SELECT_USE_CFSOCKET
#define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
-#define EVENT_CLASS_SOCK 'Sock'
static void
socket_callback (s, type, address, data, info)
const void *data;
void *info;
{
- EventRef event;
+ int fd = CFSocketGetNative (s);
+ SELECT_TYPE *ofds = (SELECT_TYPE *)info;
- CreateEvent (NULL, EVENT_CLASS_SOCK, 0, 0, kEventAttributeNone, &event);
- PostEventToQueue (GetCurrentEventQueue (), event, kEventPriorityStandard);
- ReleaseEvent (event);
+ if ((type == kCFSocketReadCallBack && FD_ISSET (fd, &ofds[0]))
+ || (type == kCFSocketConnectCallBack && FD_ISSET (fd, &ofds[1])))
+ QuitEventLoop (GetCurrentEventLoop ());
}
#endif /* SELECT_USE_CFSOCKET */
static int
-select_and_poll_event (n, rfds, wfds, efds, timeout)
- int n;
- SELECT_TYPE *rfds;
- SELECT_TYPE *wfds;
- SELECT_TYPE *efds;
- struct timeval *timeout;
+select_and_poll_event (nfds, rfds, wfds, efds, timeout)
+ int nfds;
+ SELECT_TYPE *rfds, *wfds, *efds;
+ EMACS_TIME *timeout;
{
- int r;
- OSErr err;
+ OSStatus err = noErr;
+ int r = 0;
- r = select (n, rfds, wfds, efds, timeout);
- if (r != -1)
+ /* Try detect_input_pending before ReceiveNextEvent in the same
+ BLOCK_INPUT block, in case that some input has already been read
+ asynchronously. */
+ BLOCK_INPUT;
+ ENABLE_WAKEUP_FROM_RNE;
+ if (!detect_input_pending ())
{
- BLOCK_INPUT;
- err = ReceiveNextEvent (0, NULL, kEventDurationNoWait,
- kEventLeaveInQueue, NULL);
- UNBLOCK_INPUT;
- if (err == noErr)
+ EMACS_TIME select_timeout;
+ EventTimeout timeoutval =
+ (timeout
+ ? (EMACS_SECS (*timeout) * kEventDurationSecond
+ + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
+ : kEventDurationForever);
+
+ EMACS_SET_SECS_USECS (select_timeout, 0, 0);
+ r = select (nfds, rfds, wfds, efds, &select_timeout);
+ if (timeoutval == 0.0)
+ err = eventLoopTimedOutErr;
+ else if (r == 0)
{
- FD_SET (0, rfds);
- r++;
+#if USE_CG_DRAWING
+ mac_prepare_for_quickdraw (NULL);
+#endif
+ err = ReceiveNextEvent (0, NULL, timeoutval,
+ kEventLeaveInQueue, NULL);
}
}
- return r;
-}
+ DISABLE_WAKEUP_FROM_RNE;
+ UNBLOCK_INPUT;
-#if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
-#undef SELECT_INVALIDATE_CFSOCKET
-#endif
+ if (r != 0)
+ return r;
+ else if (err == noErr)
+ {
+ /* Pretend that `select' is interrupted by a signal. */
+ detect_input_pending ();
+ errno = EINTR;
+ return -1;
+ }
+ else
+ return 0;
+}
int
-sys_select (n, rfds, wfds, efds, timeout)
- int n;
- SELECT_TYPE *rfds;
- SELECT_TYPE *wfds;
- SELECT_TYPE *efds;
- struct timeval *timeout;
+sys_select (nfds, rfds, wfds, efds, timeout)
+ int nfds;
+ SELECT_TYPE *rfds, *wfds, *efds;
+ EMACS_TIME *timeout;
{
- OSErr err;
- int i, r;
+ OSStatus err = noErr;
+ int r;
EMACS_TIME select_timeout;
+ static SELECT_TYPE ofds[3];
if (inhibit_window_system || noninteractive
- || rfds == NULL || !FD_ISSET (0, rfds))
- return select (n, rfds, wfds, efds, timeout);
+ || nfds < 1 || rfds == NULL || !FD_ISSET (0, rfds))
+ return select (nfds, rfds, wfds, efds, timeout);
FD_CLR (0, rfds);
+ ofds[0] = *rfds;
- if (wfds == NULL && efds == NULL)
- {
- int nsocks = 0;
- SELECT_TYPE orfds = *rfds;
+ if (wfds)
+ ofds[1] = *wfds;
+ else
+ FD_ZERO (&ofds[1]);
- EventTimeout timeout_sec =
+ if (efds)
+ ofds[2] = *efds;
+ else
+ {
+ EventTimeout timeoutval =
(timeout
? (EMACS_SECS (*timeout) * kEventDurationSecond
+ EMACS_USECS (*timeout) * kEventDurationMicrosecond)
: kEventDurationForever);
- for (i = 1; i < n; i++)
- if (FD_ISSET (i, rfds))
- nsocks++;
-
- if (nsocks == 0)
+ FD_SET (0, rfds); /* sentinel */
+ do
{
- BLOCK_INPUT;
- err = ReceiveNextEvent (0, NULL, timeout_sec,
- kEventLeaveInQueue, NULL);
- UNBLOCK_INPUT;
- if (err == noErr)
- {
- FD_SET (0, rfds);
- return 1;
- }
- else
- return 0;
+ nfds--;
}
+ while (!(FD_ISSET (nfds, rfds) || (wfds && FD_ISSET (nfds, wfds))));
+ nfds++;
+ FD_CLR (0, rfds);
+
+ if (nfds == 1)
+ return select_and_poll_event (nfds, rfds, wfds, efds, timeout);
/* Avoid initial overhead of RunLoop setup for the case that
some input is already available. */
EMACS_SET_SECS_USECS (select_timeout, 0, 0);
- r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
- if (r != 0 || timeout_sec == 0.0)
+ r = select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
+ if (r != 0 || timeoutval == 0.0)
return r;
- *rfds = orfds;
+ *rfds = ofds[0];
+ if (wfds)
+ *wfds = ofds[1];
-#ifdef SELECT_USE_CFSOCKET
- if (timeout_sec > 0 && timeout_sec <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
+#if SELECT_USE_CFSOCKET
+ if (timeoutval > 0 && timeoutval <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
goto poll_periodically;
- {
- CFRunLoopRef runloop =
- (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
- EventTypeSpec specs[] = {{EVENT_CLASS_SOCK, 0}};
-#ifdef SELECT_INVALIDATE_CFSOCKET
- CFSocketRef *shead, *s;
-#else
- CFRunLoopSourceRef *shead, *s;
-#endif
-
- BLOCK_INPUT;
-
-#ifdef SELECT_INVALIDATE_CFSOCKET
- shead = xmalloc (sizeof (CFSocketRef) * nsocks);
-#else
- shead = xmalloc (sizeof (CFRunLoopSourceRef) * nsocks);
-#endif
- s = shead;
- for (i = 1; i < n; i++)
- if (FD_ISSET (i, rfds))
- {
- CFSocketRef socket =
- CFSocketCreateWithNative (NULL, i, kCFSocketReadCallBack,
- socket_callback, NULL);
- CFRunLoopSourceRef source =
- CFSocketCreateRunLoopSource (NULL, socket, 0);
-
-#ifdef SELECT_INVALIDATE_CFSOCKET
- CFSocketSetSocketFlags (socket, 0);
-#endif
- CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode);
-#ifdef SELECT_INVALIDATE_CFSOCKET
- CFRelease (source);
- *s = socket;
-#else
- CFRelease (socket);
- *s = source;
-#endif
- s++;
- }
-
- err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL);
+ /* Try detect_input_pending before ReceiveNextEvent in the same
+ BLOCK_INPUT block, in case that some input has already been
+ read asynchronously. */
+ BLOCK_INPUT;
+ ENABLE_WAKEUP_FROM_RNE;
+ if (!detect_input_pending ())
+ {
+ int minfd, fd;
+ CFRunLoopRef runloop =
+ (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
+ static const CFSocketContext context = {0, ofds, NULL, NULL, NULL};
+ static CFMutableDictionaryRef sources;
+
+ if (sources == NULL)
+ sources =
+ CFDictionaryCreateMutable (NULL, 0, NULL,
+ &kCFTypeDictionaryValueCallBacks);
+
+ for (minfd = 1; ; minfd++) /* nfds-1 works as a sentinel. */
+ if (FD_ISSET (minfd, rfds) || (wfds && FD_ISSET (minfd, wfds)))
+ break;
- do
- {
- --s;
-#ifdef SELECT_INVALIDATE_CFSOCKET
- CFSocketInvalidate (*s);
-#else
- CFRunLoopRemoveSource (runloop, *s, kCFRunLoopDefaultMode);
+ for (fd = minfd; fd < nfds; fd++)
+ if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
+ {
+ void *key = (void *) fd;
+ CFRunLoopSourceRef source =
+ (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
+
+ if (source == NULL)
+ {
+ CFSocketRef socket =
+ CFSocketCreateWithNative (NULL, fd,
+ (kCFSocketReadCallBack
+ | kCFSocketConnectCallBack),
+ socket_callback, &context);
+
+ if (socket == NULL)
+ continue;
+ source = CFSocketCreateRunLoopSource (NULL, socket, 0);
+ CFRelease (socket);
+ if (source == NULL)
+ continue;
+ CFDictionaryAddValue (sources, key, source);
+ CFRelease (source);
+ }
+ CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode);
+ }
+
+#if USE_CG_DRAWING
+ mac_prepare_for_quickdraw (NULL);
#endif
- CFRelease (*s);
- }
- while (s != shead);
-
- xfree (shead);
+ err = ReceiveNextEvent (0, NULL, timeoutval,
+ kEventLeaveInQueue, NULL);
- if (err)
- {
- FD_ZERO (rfds);
- r = 0;
- }
- else
- {
- FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
- GetEventTypeCount (specs),
- specs);
- EMACS_SET_SECS_USECS (select_timeout, 0, 0);
- r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
- }
+ for (fd = minfd; fd < nfds; fd++)
+ if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
+ {
+ void *key = (void *) fd;
+ CFRunLoopSourceRef source =
+ (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
- UNBLOCK_INPUT;
+ CFRunLoopRemoveSource (runloop, source, kCFRunLoopDefaultMode);
+ }
+ }
+ DISABLE_WAKEUP_FROM_RNE;
+ UNBLOCK_INPUT;
- return r;
- }
+ if (err == noErr || err == eventLoopQuitErr)
+ {
+ EMACS_SET_SECS_USECS (select_timeout, 0, 0);
+ return select_and_poll_event (nfds, rfds, wfds, efds,
+ &select_timeout);
+ }
+ else
+ {
+ FD_ZERO (rfds);
+ if (wfds)
+ FD_ZERO (wfds);
+ return 0;
+ }
#endif /* SELECT_USE_CFSOCKET */
}
poll_periodically:
{
EMACS_TIME end_time, now, remaining_time;
- SELECT_TYPE orfds = *rfds, owfds, oefds;
- if (wfds)
- owfds = *wfds;
- if (efds)
- oefds = *efds;
if (timeout)
{
remaining_time = *timeout;
EMACS_SET_SECS_USECS (select_timeout, 0, SELECT_POLLING_PERIOD_USEC);
if (timeout && EMACS_TIME_LT (remaining_time, select_timeout))
select_timeout = remaining_time;
- r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
+ r = select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
if (r != 0)
return r;
- *rfds = orfds;
+ *rfds = ofds[0];
if (wfds)
- *wfds = owfds;
+ *wfds = ofds[1];
if (efds)
- *efds = oefds;
+ *efds = ofds[2];
if (timeout)
{
}
while (!timeout || EMACS_TIME_LT (now, end_time));
- FD_ZERO (rfds);
- if (wfds)
- FD_ZERO (wfds);
- if (efds)
- FD_ZERO (efds);
- return 0;
+ EMACS_SET_SECS_USECS (select_timeout, 0, 0);
+ return select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
}
}
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)
}
#endif /* MAC_OSX */
+#if TARGET_API_MAC_CARBON
+void
+mac_wakeup_from_rne ()
+{
+ if (wakeup_from_rne_enabled_p)
+ /* Post a harmless event so as to wake up from
+ ReceiveNextEvent. */
+ mac_post_mouse_moved_event ();
+}
+#endif
+
void
syms_of_mac ()
{
- QCLIPBOARD = intern ("CLIPBOARD");
- staticpro (&QCLIPBOARD);
+ 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);
-
- Qboolean = intern ("boolean");
- staticpro (&Qboolean);
+ Qstring = intern ("string"); staticpro (&Qstring);
+ Qnumber = intern ("number"); staticpro (&Qnumber);
+ Qboolean = intern ("boolean"); staticpro (&Qboolean);
+ Qdate = intern ("date"); staticpro (&Qdate);
+ Qdata = intern ("data"); staticpro (&Qdata);
+ Qarray = intern ("array"); staticpro (&Qarray);
+ Qdictionary = intern ("dictionary"); staticpro (&Qdictionary);
- Qdate = intern ("date");
- staticpro (&Qdate);
+ Qxml = intern ("xml");
+ staticpro (&Qxml);
- Qdata = intern ("data");
- staticpro (&Qdata);
+ Qmime_charset = intern ("mime-charset");
+ staticpro (&Qmime_charset);
- Qarray = intern ("array");
- staticpro (&Qarray);
+ QNFD = intern ("NFD"); staticpro (&QNFD);
+ QNFKD = intern ("NFKD"); staticpro (&QNFKD);
+ QNFC = intern ("NFC"); staticpro (&QNFC);
+ QNFKC = intern ("NFKC"); staticpro (&QNFKC);
+ QHFS_plus_D = intern ("HFS+D"); staticpro (&QHFS_plus_D);
+ QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C);
+#endif
- Qdictionary = intern ("dictionary");
- staticpro (&Qdictionary);
+ {
+ int i;
- Qxml = intern ("xml");
- staticpro (&Qxml);
-#endif
+ for (i = 0; i < sizeof (ae_attr_table) / sizeof (ae_attr_table[0]); i++)
+ {
+ ae_attr_table[i].symbol = intern (ae_attr_table[i].name);
+ staticpro (&ae_attr_table[i].symbol);
+ }
+ }
- defsubr (&Smac_paste_function);
- defsubr (&Smac_cut_function);
- defsubr (&Sx_selection_exists_p);
+ defsubr (&Smac_coerce_ae_data);
#if TARGET_API_MAC_CARBON
defsubr (&Smac_get_preference);
+ defsubr (&Smac_code_convert_string);
+ defsubr (&Smac_process_hi_command);
#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);
+
+ DEFVAR_INT ("mac-system-script-code", &mac_system_script_code,
+ doc: /* The system script code. */);
+ mac_system_script_code = (ScriptCode) GetScriptManagerVariable (smSysScript);
+
+ DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale,
+ doc: /* The system locale identifier string.
+This is not a POSIX locale ID, but an ICU locale ID. So encoding
+information is not included. */);
+ Vmac_system_locale = mac_get_system_locale ();
}
/* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff