#include <stdio.h>
#include <errno.h>
-#include <utime.h>
-#include <dirent.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <string.h>
-#include <pwd.h>
-#include <sys/param.h>
-#include <stdlib.h>
-#if __MWERKS__
-#include <unistd.h>
-#endif
+#include <time.h>
-#ifdef MAC_OSX
-#undef mktime
-#undef DEBUG
-#undef free
-#undef malloc
-#undef realloc
-#undef init_process
-#include <Carbon/Carbon.h>
-#undef free
-#define free unexec_free
-#undef malloc
-#define malloc unexec_malloc
-#undef realloc
-#define realloc unexec_realloc
-#undef init_process
-#define init_process emacs_init_process
-#else /* not MAC_OSX */
+#include "lisp.h"
+#include "process.h"
+#include "sysselect.h"
+#include "systime.h"
+#include "blockinput.h"
+#include "charset.h"
+#include "coding.h"
+
+#include "macterm.h"
+
+#ifndef HAVE_CARBON
#include <Files.h>
#include <MacTypes.h>
#include <TextUtils.h>
#include <OSA.h>
#include <AppleScript.h>
#include <Scrap.h>
-#endif /* not MAC_OSX */
+#include <Events.h>
+#include <Processes.h>
+#include <EPPC.h>
+#include <MacLocales.h>
+#endif /* not HAVE_CARBON */
-#include "lisp.h"
-#include "process.h"
-#include "sysselect.h"
-#include "systime.h"
+#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. */
int l2 = strlen (s2);
char *p = s1 + l1;
int i;
-
+
strncat (s1, s2, n);
for (i = 0; i < l2; i++)
{
/* Convert a Mac pathname to Posix form. A Mac full pathname is one
that does not begin with a ':' and contains at least one ':'. A Mac
- full pathname causes an '/' to be prepended to the Posix pathname.
+ full pathname causes a '/' to be prepended to the Posix pathname.
The algorithm for the rest of the pathname is as follows:
For each segment between two ':',
if it is non-null, copy as is and then add a '/' at the end,
otherwise, insert a "../" into the Posix pathname.
Returns 1 if successful; 0 if fails. */
-
+
int
mac_to_posix_pathname (const char *mfn, char *ufn, int ufnbuflen)
{
const char *p, *q, *pe;
-
+
strcpy (ufn, "");
-
+
if (*mfn == '\0')
return 1;
-
+
p = strchr (mfn, ':');
if (p != 0 && p != mfn) /* full pathname */
strcat (ufn, "/");
-
+
p = mfn;
if (*p == ':')
p++;
p = pe;
}
}
-
+
return 1;
}
/* Convert a Posix pathname to Mac form. Approximately reverse of the
above in algorithm. */
-
+
int
posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen)
{
const char *p, *q, *pe;
char expanded_pathname[MAXPATHLEN+1];
-
+
strcpy (mfn, "");
-
+
if (*ufn == '\0')
return 1;
p = ufn;
-
+
/* Check for and handle volume names. Last comparison: strangely
somewhere "/.emacs" is passed. A temporary fix for now. */
if (*p == '/' && strchr (p+1, '/') == NULL && strcmp (p, "/.emacs") != 0)
strcat (expanded_pathname, p);
p = expanded_pathname;
/* now p points to the pathname with emacs dir prefix */
- }
+ }
else if (*p != '/') /* relative pathname */
strcat (mfn, ":");
-
+
if (*p == '/')
p++;
p = pe;
}
}
-
+
return 1;
}
+\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;
+#define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
+
+struct cfdict_context
+{
+ Lisp_Object *result;
+ int with_tag, hash_bound;
+};
+
+/* C string to CFString. */
+
+CFStringRef
+cfstring_create_with_utf8_cstring (c_str)
+ const char *c_str;
+{
+ CFStringRef str;
+
+ str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingUTF8);
+ if (str == NULL)
+ /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
+ str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingMacRoman);
+
+ return 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
+cfdata_to_lisp (data)
+ CFDataRef data;
+{
+ 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. */
+
+Lisp_Object
+cfstring_to_lisp (string)
+ CFStringRef string;
+{
+ Lisp_Object result = Qnil;
+ const char *s = CFStringGetCStringPtr (string, kCFStringEncodingUTF8);
+
+ if (s)
+ result = make_unibyte_string (s, strlen (s));
+ else
+ {
+ CFDataRef data =
+ CFStringCreateExternalRepresentation (NULL, string,
+ kCFStringEncodingUTF8, '?');
+
+ if (data)
+ {
+ result = cfdata_to_lisp (data);
+ CFRelease (data);
+ }
+ }
+
+ if (!NILP (result))
+ {
+ result = DECODE_UTF_8 (result);
+ /* This may be superfluous. Just to make sure that the result
+ is a multibyte string. */
+ result = string_to_multibyte (result);
+ }
+
+ return result;
+}
+
+
+/* CFNumber to a lisp integer or a lisp float. */
+
+Lisp_Object
+cfnumber_to_lisp (number)
+ CFNumberRef number;
+{
+ Lisp_Object result = Qnil;
+#if BITS_PER_EMACS_INT > 32
+ SInt64 int_val;
+ CFNumberType emacs_int_type = kCFNumberSInt64Type;
+#else
+ SInt32 int_val;
+ CFNumberType emacs_int_type = kCFNumberSInt32Type;
+#endif
+ double float_val;
+
+ if (CFNumberGetValue (number, emacs_int_type, &int_val)
+ && !FIXNUM_OVERFLOW_P (int_val))
+ result = make_number (int_val);
+ else
+ if (CFNumberGetValue (number, kCFNumberDoubleType, &float_val))
+ result = make_float (float_val);
+ return result;
+}
+
+
+/* CFDate to a list of three integers as in a return value of
+ `current-time'. */
+
+Lisp_Object
+cfdate_to_lisp (date)
+ CFDateRef date;
+{
+ static const CFGregorianDate epoch_gdate = {1970, 1, 1, 0, 0, 0.0};
+ static CFAbsoluteTime epoch = 0.0, sec;
+ int high, low;
+
+ if (epoch == 0.0)
+ epoch = CFGregorianDateGetAbsoluteTime (epoch_gdate, NULL);
+
+ sec = CFDateGetAbsoluteTime (date) - epoch;
+ high = sec / 65536.0;
+ low = sec - high * 65536.0;
+
+ return list3 (make_number (high), make_number (low), make_number (0));
+}
+
+
+/* CFBoolean to a lisp symbol, `t' or `nil'. */
+
+Lisp_Object
+cfboolean_to_lisp (boolean)
+ CFBooleanRef boolean;
+{
+ return CFBooleanGetValue (boolean) ? Qt : Qnil;
+}
+
+
+/* Any Core Foundation object to a (lengthy) lisp string. */
+
+Lisp_Object
+cfobject_desc_to_lisp (object)
+ CFTypeRef object;
+{
+ Lisp_Object result = Qnil;
+ CFStringRef desc = CFCopyDescription (object);
+
+ if (desc)
+ {
+ result = cfstring_to_lisp (desc);
+ CFRelease (desc);
+ }
+
+ return result;
+}
+
+
+/* Callback functions for cfproperty_list_to_lisp. */
+
+static void
+cfdictionary_add_to_list (key, value, context)
+ const void *key;
+ const void *value;
+ void *context;
+{
+ struct cfdict_context *cxt = (struct cfdict_context *)context;
+
+ *cxt->result =
+ Fcons (Fcons (cfstring_to_lisp (key),
+ cfproperty_list_to_lisp (value, cxt->with_tag,
+ cxt->hash_bound)),
+ *cxt->result);
+}
+
+static void
+cfdictionary_puthash (key, value, context)
+ const void *key;
+ const void *value;
+ void *context;
+{
+ Lisp_Object lisp_key = cfstring_to_lisp (key);
+ struct cfdict_context *cxt = (struct cfdict_context *)context;
+ struct Lisp_Hash_Table *h = XHASH_TABLE (*(cxt->result));
+ unsigned hash_code;
+
+ hash_lookup (h, lisp_key, &hash_code);
+ hash_put (h, lisp_key,
+ cfproperty_list_to_lisp (value, cxt->with_tag, cxt->hash_bound),
+ hash_code);
+}
+
+
+/* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
+ non-zero, a symbol that represents the type of the original Core
+ Foundation object is prepended. HASH_BOUND specifies which kinds
+ of the lisp objects, alists or hash tables, are used as the targets
+ of the conversion from CFDictionary. If HASH_BOUND is negative,
+ 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. */
+
+Lisp_Object
+cfproperty_list_to_lisp (plist, with_tag, hash_bound)
+ CFPropertyListRef plist;
+ int with_tag, hash_bound;
+{
+ CFTypeID type_id = CFGetTypeID (plist);
+ Lisp_Object tag = Qnil, result = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (tag, result);
+
+ if (type_id == CFStringGetTypeID ())
+ {
+ tag = Qstring;
+ result = cfstring_to_lisp (plist);
+ }
+ else if (type_id == CFNumberGetTypeID ())
+ {
+ tag = Qnumber;
+ result = cfnumber_to_lisp (plist);
+ }
+ else if (type_id == CFBooleanGetTypeID ())
+ {
+ tag = Qboolean;
+ result = cfboolean_to_lisp (plist);
+ }
+ else if (type_id == CFDateGetTypeID ())
+ {
+ tag = Qdate;
+ result = cfdate_to_lisp (plist);
+ }
+ else if (type_id == CFDataGetTypeID ())
+ {
+ tag = Qdata;
+ result = cfdata_to_lisp (plist);
+ }
+ else if (type_id == CFArrayGetTypeID ())
+ {
+ CFIndex index, count = CFArrayGetCount (plist);
+
+ tag = Qarray;
+ result = Fmake_vector (make_number (count), Qnil);
+ for (index = 0; index < count; index++)
+ XVECTOR (result)->contents[index] =
+ cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist, index),
+ with_tag, hash_bound);
+ }
+ else if (type_id == CFDictionaryGetTypeID ())
+ {
+ struct cfdict_context context;
+ CFIndex count = CFDictionaryGetCount (plist);
+
+ tag = Qdictionary;
+ context.result = &result;
+ context.with_tag = with_tag;
+ context.hash_bound = hash_bound;
+ if (hash_bound < 0 || count < hash_bound)
+ {
+ result = Qnil;
+ CFDictionaryApplyFunction (plist, cfdictionary_add_to_list,
+ &context);
+ }
+ else
+ {
+ result = make_hash_table (Qequal,
+ make_number (count),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil);
+ CFDictionaryApplyFunction (plist, cfdictionary_puthash,
+ &context);
+ }
+ }
+ else
+ abort ();
+
+ UNGCPRO;
+
+ if (with_tag)
+ result = Fcons (tag, result);
+
+ return result;
+}
+#endif
+
+\f
+/***********************************************************************
+ Emulation of the X Resource Manager
+ ***********************************************************************/
+
+/* Parser functions for resource lines. Each function takes an
+ address of a variable whose value points to the head of a string.
+ The value will be advanced so that it points to the next character
+ of the parsed part when the function returns.
+
+ A resource name such as "Emacs*font" is parsed into a non-empty
+ list called `quarks'. Each element is either a Lisp string that
+ represents a concrete component, a Lisp symbol LOOSE_BINDING
+ (actually Qlambda) that represents any number (>=0) of intervening
+ components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
+ that represents as any single component. */
+
+#define P (*p)
+
+#define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
+#define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
+
+static void
+skip_white_space (p)
+ char **p;
+{
+ /* WhiteSpace = {<space> | <horizontal tab>} */
+ while (*P == ' ' || *P == '\t')
+ P++;
+}
+
+static int
+parse_comment (p)
+ char **p;
+{
+ /* Comment = "!" {<any character except null or newline>} */
+ if (*P == '!')
+ {
+ P++;
+ while (*P)
+ if (*P++ == '\n')
+ break;
+ return 1;
+ }
+ else
+ return 0;
+}
+
+/* Don't interpret filename. Just skip until the newline. */
+static int
+parse_include_file (p)
+ char **p;
+{
+ /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
+ if (*P == '#')
+ {
+ P++;
+ while (*P)
+ if (*P++ == '\n')
+ break;
+ return 1;
+ }
+ else
+ return 0;
+}
+
+static char
+parse_binding (p)
+ char **p;
+{
+ /* Binding = "." | "*" */
+ if (*P == '.' || *P == '*')
+ {
+ char binding = *P++;
+
+ while (*P == '.' || *P == '*')
+ if (*P++ == '*')
+ binding = '*';
+ return binding;
+ }
+ else
+ return '\0';
+}
+
+static Lisp_Object
+parse_component (p)
+ char **p;
+{
+ /* Component = "?" | ComponentName
+ ComponentName = NameChar {NameChar}
+ NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
+ if (*P == '?')
+ {
+ P++;
+ return SINGLE_COMPONENT;
+ }
+ else if (isalnum (*P) || *P == '_' || *P == '-')
+ {
+ char *start = P++;
+
+ while (isalnum (*P) || *P == '_' || *P == '-')
+ P++;
+
+ return make_unibyte_string (start, P - start);
+ }
+ else
+ return Qnil;
+}
+
+static Lisp_Object
+parse_resource_name (p)
+ char **p;
+{
+ Lisp_Object result = Qnil, component;
+ char binding;
+
+ /* ResourceName = [Binding] {Component Binding} ComponentName */
+ if (parse_binding (p) == '*')
+ result = Fcons (LOOSE_BINDING, result);
+
+ component = parse_component (p);
+ if (NILP (component))
+ return Qnil;
+
+ result = Fcons (component, result);
+ while ((binding = parse_binding (p)) != '\0')
+ {
+ if (binding == '*')
+ result = Fcons (LOOSE_BINDING, result);
+ component = parse_component (p);
+ if (NILP (component))
+ return Qnil;
+ else
+ result = Fcons (component, result);
+ }
+
+ /* The final component should not be '?'. */
+ if (EQ (component, SINGLE_COMPONENT))
+ return Qnil;
+
+ return Fnreverse (result);
+}
+
+static Lisp_Object
+parse_value (p)
+ char **p;
+{
+ char *q, *buf;
+ Lisp_Object seq = Qnil, result;
+ int buf_len, total_len = 0, len, continue_p;
+
+ q = strchr (P, '\n');
+ buf_len = q ? q - P : strlen (P);
+ buf = xmalloc (buf_len);
+
+ while (1)
+ {
+ q = buf;
+ continue_p = 0;
+ while (*P)
+ {
+ if (*P == '\n')
+ {
+ P++;
+ break;
+ }
+ else if (*P == '\\')
+ {
+ P++;
+ if (*P == '\0')
+ break;
+ else if (*P == '\n')
+ {
+ P++;
+ continue_p = 1;
+ break;
+ }
+ else if (*P == 'n')
+ {
+ *q++ = '\n';
+ P++;
+ }
+ else if ('0' <= P[0] && P[0] <= '7'
+ && '0' <= P[1] && P[1] <= '7'
+ && '0' <= P[2] && P[2] <= '7')
+ {
+ *q++ = (P[0] - '0' << 6) + (P[1] - '0' << 3) + (P[2] - '0');
+ P += 3;
+ }
+ else
+ *q++ = *P++;
+ }
+ else
+ *q++ = *P++;
+ }
+ len = q - buf;
+ seq = Fcons (make_unibyte_string (buf, len), seq);
+ total_len += len;
+
+ if (continue_p)
+ {
+ q = strchr (P, '\n');
+ len = q ? q - P : strlen (P);
+ if (len > buf_len)
+ {
+ xfree (buf);
+ buf_len = len;
+ buf = xmalloc (buf_len);
+ }
+ }
+ else
+ break;
+ }
+ xfree (buf);
+
+ if (SBYTES (XCAR (seq)) == total_len)
+ return make_string (SDATA (XCAR (seq)), total_len);
+ else
+ {
+ buf = xmalloc (total_len);
+ q = buf + total_len;
+ for (; CONSP (seq); seq = XCDR (seq))
+ {
+ len = SBYTES (XCAR (seq));
+ q -= len;
+ memcpy (q, SDATA (XCAR (seq)), len);
+ }
+ result = make_string (buf, total_len);
+ xfree (buf);
+ return result;
+ }
+}
+
+static Lisp_Object
+parse_resource_line (p)
+ char **p;
+{
+ Lisp_Object quarks, value;
+
+ /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
+ if (parse_comment (p) || parse_include_file (p))
+ return Qnil;
+
+ /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
+ skip_white_space (p);
+ quarks = parse_resource_name (p);
+ if (NILP (quarks))
+ goto cleanup;
+ skip_white_space (p);
+ if (*P != ':')
+ goto cleanup;
+ P++;
+ skip_white_space (p);
+ value = parse_value (p);
+ return Fcons (quarks, value);
+
+ cleanup:
+ /* Skip the remaining data as a dummy value. */
+ parse_value (p);
+ return Qnil;
+}
+
+#undef P
+
+/* Equivalents of X Resource Manager functions.
+
+ 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. 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. */
+
+#define HASHKEY_MAX_NID (make_number (0))
+
+static XrmDatabase
+xrm_create_database ()
+{
+ 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);
+
+ return database;
+}
+
+static void
+xrm_q_put_resource (database, quarks, value)
+ XrmDatabase database;
+ Lisp_Object quarks, value;
+{
+ struct Lisp_Hash_Table *h = XHASH_TABLE (database);
+ unsigned hash_code;
+ 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))
+ {
+ key = Fcons (node_id, XCAR (quarks));
+ i = hash_lookup (h, key, &hash_code);
+ if (i < 0)
+ {
+ max_nid++;
+ XSETINT (node_id, max_nid);
+ hash_put (h, key, node_id, hash_code);
+ }
+ else
+ node_id = HASH_VALUE (h, i);
+ }
+ Fputhash (node_id, value, database);
+
+ Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
+}
+
+/* Merge multiple resource entries specified by DATA into a resource
+ database DATABASE. DATA points to the head of a null-terminated
+ string consisting of multiple resource lines. It's like a
+ combination of XrmGetStringDatabase and XrmMergeDatabases. */
+
+void
+xrm_merge_string_database (database, data)
+ XrmDatabase database;
+ char *data;
+{
+ Lisp_Object quarks_value;
+
+ while (*data)
+ {
+ quarks_value = parse_resource_line (&data);
+ if (!NILP (quarks_value))
+ xrm_q_put_resource (database,
+ XCAR (quarks_value), XCDR (quarks_value));
+ }
+}
+
+static Lisp_Object
+xrm_q_get_resource_1 (database, node_id, quark_name, quark_class)
+ XrmDatabase database;
+ Lisp_Object node_id, quark_name, quark_class;
+{
+ struct Lisp_Hash_Table *h = XHASH_TABLE (database);
+ Lisp_Object key, labels[3], value;
+ int i, k;
+
+ if (!CONSP (quark_name))
+ return Fgethash (node_id, database, Qnil);
+
+ /* First, try tight bindings */
+ labels[0] = XCAR (quark_name);
+ labels[1] = XCAR (quark_class);
+ labels[2] = SINGLE_COMPONENT;
+
+ key = Fcons (node_id, Qnil);
+ for (k = 0; k < sizeof (labels) / sizeof (*labels); k++)
+ {
+ XSETCDR (key, labels[k]);
+ i = hash_lookup (h, key, NULL);
+ if (i >= 0)
+ {
+ 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 */
+ XSETCDR (key, LOOSE_BINDING);
+ i = hash_lookup (h, key, NULL);
+ if (i >= 0)
+ {
+ 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_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;
+{
+ Lisp_Object quark_name, quark_class, tmp;
+ int nn, nc;
+
+ quark_name = parse_resource_name (&name);
+ if (*name != '\0')
+ return Qnil;
+ for (tmp = quark_name, nn = 0; CONSP (tmp); tmp = XCDR (tmp), nn++)
+ if (!STRINGP (XCAR (tmp)))
+ return Qnil;
+
+ quark_class = parse_resource_name (&class);
+ if (*class != '\0')
+ return Qnil;
+ for (tmp = quark_class, nc = 0; CONSP (tmp); tmp = XCDR (tmp), nc++)
+ if (!STRINGP (XCAR (tmp)))
+ return Qnil;
+
+ if (nn != nc)
+ return Qnil;
+ else
+ return xrm_q_get_resource (database, quark_name, quark_class);
+}
+
+#if TARGET_API_MAC_CARBON
+static Lisp_Object
+xrm_cfproperty_list_to_value (plist)
+ CFPropertyListRef plist;
+{
+ CFTypeID type_id = CFGetTypeID (plist);
+
+ if (type_id == CFStringGetTypeID ())
+ return cfstring_to_lisp (plist);
+ else if (type_id == CFNumberGetTypeID ())
+ {
+ CFStringRef string;
+ Lisp_Object result = Qnil;
+
+ string = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@"), plist);
+ if (string)
+ {
+ result = cfstring_to_lisp (string);
+ CFRelease (string);
+ }
+ return result;
+ }
+ else if (type_id == CFBooleanGetTypeID ())
+ return build_string (CFBooleanGetValue (plist) ? "true" : "false");
+ else if (type_id == CFDataGetTypeID ())
+ return cfdata_to_lisp (plist);
+ else
+ return Qnil;
+}
+#endif
+
+/* Create a new resource database from the preferences for the
+ application APPLICATION. APPLICATION is either a string that
+ specifies an application ID, or NULL that represents the current
+ application. */
+
+XrmDatabase
+xrm_get_preference_database (application)
+ char *application;
+{
+#if TARGET_API_MAC_CARBON
+ CFStringRef app_id, *keys, user_doms[2], host_doms[2];
+ CFMutableSetRef key_set = NULL;
+ CFArrayRef key_array;
+ CFIndex index, count;
+ char *res_name;
+ XrmDatabase database;
+ Lisp_Object quarks = Qnil, value = Qnil;
+ CFPropertyListRef plist;
+ int iu, ih;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ user_doms[0] = kCFPreferencesCurrentUser;
+ user_doms[1] = kCFPreferencesAnyUser;
+ host_doms[0] = kCFPreferencesCurrentHost;
+ host_doms[1] = kCFPreferencesAnyHost;
+
+ database = xrm_create_database ();
+
+ GCPRO3 (database, quarks, value);
+
+ BLOCK_INPUT;
+
+ app_id = kCFPreferencesCurrentApplication;
+ if (application)
+ {
+ app_id = cfstring_create_with_utf8_cstring (application);
+ if (app_id == NULL)
+ goto out;
+ }
+
+ key_set = CFSetCreateMutable (NULL, 0, &kCFCopyStringSetCallBacks);
+ if (key_set == NULL)
+ goto out;
+ for (iu = 0; iu < sizeof (user_doms) / sizeof (*user_doms) ; iu++)
+ for (ih = 0; ih < sizeof (host_doms) / sizeof (*host_doms); ih++)
+ {
+ key_array = CFPreferencesCopyKeyList (app_id, user_doms[iu],
+ host_doms[ih]);
+ if (key_array)
+ {
+ count = CFArrayGetCount (key_array);
+ for (index = 0; index < count; index++)
+ CFSetAddValue (key_set,
+ CFArrayGetValueAtIndex (key_array, index));
+ CFRelease (key_array);
+ }
+ }
+
+ 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]));
+ quarks = parse_resource_name (&res_name);
+ if (!(NILP (quarks) || *res_name))
+ {
+ plist = CFPreferencesCopyAppValue (keys[index], app_id);
+ value = xrm_cfproperty_list_to_value (plist);
+ CFRelease (plist);
+ if (!NILP (value))
+ xrm_q_put_resource (database, quarks, value);
+ }
+ }
+
+ xfree (keys);
+ out:
+ if (key_set)
+ CFRelease (key_set);
+ CFRelease (app_id);
+
+ UNBLOCK_INPUT;
+
+ UNGCPRO;
+
+ return database;
+#else
+ return xrm_create_database ();
+#endif
+}
+
+\f
#ifndef MAC_OSX
/* The following functions with "sys_" prefix are stubs to Unix
cipb.hFileInfo.ioDirID = 0;
cipb.hFileInfo.ioFDirIndex = 0;
/* set to 0 to get information about specific dir or file */
-
+
errno = PBGetCatInfo (&cipb, false);
if (errno == -43) /* -43: fnfErr defined in Errors.h */
errno = ENOENT;
if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
{
buf->st_mode = S_IFDIR | S_IREAD | S_IEXEC;
-
+
if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
buf->st_ino = cipb.dirInfo.ioDrDirID;
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
return stat_noalias (true_pathname, buf);
}
stat (const char *path, struct stat *sb)
{
int result;
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
-
+
if ((result = stat_noalias (path, sb)) >= 0 &&
! (sb->st_mode & S_IFLNK))
return result;
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
{
HFileParam hfpb;
char true_pathname[MAXPATHLEN+1], mac_pathname[MAXPATHLEN+1];
-
+
if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
if (posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1) == 0)
return -1;
hfpb.ioNamePtr = mac_pathname;
hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
hfpb.ioDirID = 0; /* parent is the root */
-
+
errno = PBDirCreate ((HParmBlkPtr) &hfpb, false);
/* just return the Mac OSErr code for now */
return errno == noErr ? 0 : -1;
{
HFileParam hfpb;
char mac_pathname[MAXPATHLEN+1];
-
+
if (posix_to_mac_pathname (dirname, mac_pathname, MAXPATHLEN+1) == 0)
return -1;
hfpb.ioNamePtr = mac_pathname;
hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
hfpb.ioDirID = 0; /* parent is the root */
-
+
errno = PBHDelete ((HParmBlkPtr) &hfpb, false);
return errno == noErr ? 0 : -1;
}
int
utime (const char *path, const struct utimbuf *times)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
CInfoPBRec cipb;
-
+
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
cipb.hFileInfo.ioNamePtr = mac_pathname;
cipb.hFileInfo.ioVRefNum = 0;
cipb.hFileInfo.ioDirID = 0;
- cipb.hFileInfo.ioFDirIndex = 0;
+ cipb.hFileInfo.ioFDirIndex = 0;
/* set to 0 to get information about specific dir or file */
-
+
errno = PBGetCatInfo (&cipb, false);
if (errno != noErr)
return -1;
int
access (const char *path, int mode)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
CInfoPBRec cipb;
-
+
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
cipb.hFileInfo.ioDirID = 0;
cipb.hFileInfo.ioFDirIndex = 0;
/* set to 0 to get information about specific dir or file */
-
+
errno = PBGetCatInfo (&cipb, false);
if (errno != noErr)
return -1;
int
sys_open (const char *path, int oflag)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
-
+
if (strcmp (path, "/dev/null") == 0)
return DEV_NULL_FD; /* some bogus fd to be ignored in write */
-
+
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
int
sys_creat (const char *path, mode_t mode)
{
- char true_pathname[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
-
+
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
int
sys_unlink (const char *path)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
-
+
if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
sys_rename (const char * old_name, const char * new_name)
{
char true_old_pathname[MAXPATHLEN+1], true_new_pathname[MAXPATHLEN+1];
- char fully_resolved_old_name[MAXPATHLEN+1];
+ char fully_resolved_old_name[MAXPATHLEN+1];
int len;
char mac_old_name[MAXPATHLEN+1], mac_new_name[MAXPATHLEN+1];
-
+
if (find_true_pathname (old_name, true_old_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
len = readlink (true_old_pathname, fully_resolved_old_name, MAXPATHLEN);
if (len > -1)
fully_resolved_old_name[len] = '\0';
if (find_true_pathname (new_name, true_new_pathname, MAXPATHLEN+1) == -1)
return -1;
-
+
if (strcmp (fully_resolved_old_name, true_new_pathname) == 0)
return 0;
mac_old_name,
MAXPATHLEN+1))
return -1;
-
+
if (!posix_to_mac_pathname(true_new_pathname, mac_new_name, MAXPATHLEN+1))
return -1;
file in Unix. CW version fails in these situation. So we add a
call to unlink here. */
(void) unlink (mac_new_name);
-
+
return rename (mac_old_name, mac_new_name);
}
FILE *
sys_fopen (const char *name, const char *mode)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
int len;
char mac_pathname[MAXPATHLEN+1];
-
+
if (find_true_pathname (name, true_pathname, MAXPATHLEN+1) == -1)
return 0;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
}
-#include <Events.h>
-
long target_ticks = 0;
#ifdef __MRC__
}
+extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
+
int
select (n, rfds, wfds, efds, timeout)
int n;
SELECT_TYPE *efds;
struct timeval *timeout;
{
-#ifdef TARGET_API_MAC_CARBON
- return 1;
+#if TARGET_API_MAC_CARBON
+ OSErr err;
+ 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;
#else /* not TARGET_API_MAC_CARBON */
- EMACS_TIME end_time, now;
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;
- EMACS_GET_TIME (end_time);
- EMACS_ADD_TIME (end_time, end_time, *timeout);
-
- do
- {
- /* 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) && EventAvail (everyEvent, &e))
- return 1;
-
- /* Also check movement of the mouse. */
- {
- Point mouse_pos;
- static Point old_mouse_pos = {-1, -1};
-
- GetMouse (&mouse_pos);
- if (!EqualPt (mouse_pos, old_mouse_pos))
- {
- old_mouse_pos = mouse_pos;
- return 1;
- }
- }
-
- WaitNextEvent (0, &e, 1UL, NULL); /* Accept no event; wait 1
- tic. by T.I. */
-
- EMACS_GET_TIME (now);
- EMACS_SUB_TIME (now, end_time, now);
- }
- while (!EMACS_TIME_NEG_P (now));
+ /* 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;
#endif /* not TARGET_API_MAC_CARBON */
{
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. */
-
+
target_ticks = 0;
if (alarm_signal_func)
(*alarm_signal_func)(SIGALRM);
-
+
return 0;
}
alarm (int seconds)
{
long remaining = target_ticks ? (TickCount () - target_ticks) / 60 : 0;
-
+
target_ticks = seconds ? TickCount () + 60 * seconds : 0;
-
+
return (remaining < 0) ? 0 : (unsigned int) remaining;
}
else
{
#ifdef __MRC__
- __sigfun old_signal_func;
+ __sigfun old_signal_func;
#elif __MWERKS__
- __signal_func_ptr old_signal_func;
+ __signal_func_ptr old_signal_func;
#else
You lose!!!
#endif
/* Get time since boot */
Microseconds (&uw_microseconds);
-
+
/* Convert to time since midnight*/
w_microseconds.hi = uw_microseconds.hi;
w_microseconds.lo = uw_microseconds.lo;
sys_gmtime (const time_t *timer)
{
time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
-
+
return gmtime (&unix_time);
}
#else
time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
#endif
-
+
return localtime (&unix_time);
}
#else
time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
#endif
-
+
return ctime (&unix_time);
}
if (timer)
*timer = mac_time;
-
+
return mac_time;
}
{
int len, k;
static seqnum = 0;
-
+
len = strlen (template);
k = len - 1;
while (k >= 0 && template[k] == 'X')
k--;
-
+
k++; /* make k index of first 'X' */
-
+
if (k < len)
{
/* Zero filled, number of digits equal to the number of X's. */
sprintf (&template[k], "%0*d", len-k, seqnum++);
-
+
return template;
}
else
- return 0;
+ return 0;
}
static char my_passwd_name[PASSWD_FIELD_SIZE];
static char my_passwd_dir[MAXPATHLEN+1];
-static struct passwd my_passwd =
+static struct passwd my_passwd =
{
my_passwd_name,
my_passwd_dir,
};
+static struct group my_group =
+{
+ /* There are no groups on the mac, so we just return "root" as the
+ group name. */
+ "root",
+};
+
/* Initialized by main () in macterm.c to pathname of emacs directory. */
}
}
}
-
+
if (!found)
{
/* Setting to "/" probably won't work but set it to something
}
-static struct passwd emacs_passwd =
+static struct passwd emacs_passwd =
{
"emacs",
emacs_passwd_dir,
getpwuid (uid_t uid)
{
if (!my_passwd_inited)
- {
+ {
init_my_passwd ();
my_passwd_inited = 1;
}
-
+
return &my_passwd;
}
+struct group *
+getgrgid (gid_t gid)
+{
+ return &my_group;
+}
+
+
struct passwd *
getpwnam (const char *name)
{
return &emacs_passwd;
if (!my_passwd_inited)
- {
+ {
init_my_passwd ();
my_passwd_inited = 1;
}
-
+
return &my_passwd;
}
sigblock (int mask)
{
return 0;
-}
+}
void
err = PBGetCatInfo (&cipb, false);
if (err != noErr)
return 0;
-
+
p2cstr (dir_name);
if (strlen (dir_name) + strlen (path) + 1 >= man_path_len)
return 0;
}
while (cipb.dirInfo.ioDrDirID != fsRtDirID);
/* stop when we see the volume's root directory */
-
+
return 1; /* success */
}
+
+OSErr
+posix_pathname_to_fsspec (ufn, fs)
+ const char *ufn;
+ FSSpec *fs;
+{
+ Str255 mac_pathname;
+
+ if (posix_to_mac_pathname (ufn, mac_pathname, sizeof (mac_pathname)) == 0)
+ return fnfErr;
+ else
+ {
+ c2pstr (mac_pathname);
+ return FSMakeFSSpec (0, 0, mac_pathname, fs);
+ }
+}
+
+OSErr
+fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
+ const FSSpec *fs;
+ char *ufn;
+ int ufnbuflen;
+{
+ char mac_pathname[MAXPATHLEN];
+
+ if (path_from_vol_dir_name (mac_pathname, sizeof (mac_pathname) - 1,
+ fs->vRefNum, fs->parID, fs->name)
+ && mac_to_posix_pathname (mac_pathname, ufn, ufnbuflen))
+ return noErr;
+ else
+ return fnfErr;
+}
+
#ifndef MAC_OSX
int
return -1;
buf[0] = '\0';
-
+
p = path;
if (*p == '/')
q = strchr (p + 1, '/');
p = q + 1;
q = strchr(p, '/');
}
-
+
if (len + strlen (p) + 1 >= bufsiz)
return -1;
-
+
strcat (buf, p);
return len + strlen (p);
}
dup2 (int oldd, int newd)
{
int fd, ret;
-
+
close (newd);
fd = dup (oldd);
CInfoPBRec cpb;
char unix_dir_name[MAXPATHLEN+1];
DIR *dir;
-
+
/* Cache directory name with pointer temp_dir_name.
Look for it only the first time. */
if (!temp_dir_name)
&vol_ref_num, &dir_id);
if (err != noErr)
return NULL;
-
+
if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
return NULL;
if (strlen (full_path) + 6 <= MAXPATHLEN)
strcat (full_path, "Emacs:");
- else
+ else
return NULL;
if (!mac_to_posix_pathname (full_path, unix_dir_name, MAXPATHLEN+1))
return NULL;
-
+
dir = opendir (unix_dir_name); /* check whether temp directory exists */
if (dir)
closedir (dir);
/* Allocate and construct an array of pointers to strings from a list
of strings stored in a 'STR#' resource. The returned pointer array
is stored in the style of argv and environ: if the 'STR#' resource
- contains numString strings, an pointer array with numString+1
+ contains numString strings, a pointer array with numString+1
elements is returned in which the last entry contains a null
pointer. The pointer to the pointer array is passed by pointer in
parameter t. The resource ID of the 'STR#' resource is passed in
CInfoPBRec cpb;
static char system_folder_unix_name[MAXPATHLEN+1];
DIR *dir;
-
+
err = FindFolder (kOnSystemDisk, kSystemFolderType, kDontCreateFolder,
&vol_ref_num, &dir_id);
if (err != noErr)
return NULL;
-
+
if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
return NULL;
if (!mac_to_posix_pathname (full_path, system_folder_unix_name,
MAXPATHLEN+1))
return NULL;
-
+
return system_folder_unix_name;
}
init_environ ()
{
int i;
-
+
get_string_list (&environ, ENVIRON_STRING_LIST_ID);
i = 0;
}
-#include <Processes.h>
-#include <EPPC.h>
-
/* Event class of HLE sent to subprocess. */
const OSType kEmacsSubprocessSend = 'ESND';
char *
mystrtok (char *s)
-{
+{
while (*s)
s++;
const char *workdir;
const char *infn, *outfn, *errfn;
{
-#ifdef TARGET_API_MAC_CARBON
+#if TARGET_API_MAC_CARBON
return -1;
#else /* not TARGET_API_MAC_CARBON */
char macappname[MAXPATHLEN+1], macworkdir[MAXPATHLEN+1];
RgnHandle cursor_region_handle;
TargetID targ;
unsigned long ref_con, len;
-
+
if (posix_to_mac_pathname (workdir, macworkdir, MAXPATHLEN+1) == 0)
return -1;
if (posix_to_mac_pathname (infn, macinfn, MAXPATHLEN+1) == 0)
return -1;
if (posix_to_mac_pathname (errfn, macerrfn, MAXPATHLEN+1) == 0)
return -1;
-
+
paramlen = strlen (macworkdir) + strlen (macinfn) + strlen (macoutfn)
+ strlen (macerrfn) + 4; /* count nulls at end of strings */
&& argc == 3 && strcmp (argv[1], "-c") == 0)
{
char *command, *t, tempmacpathname[MAXPATHLEN+1];
-
+
/* The arguments for the command in argv[2] are separated by
spaces. Count them and put the count in newargc. */
command = (char *) alloca (strlen (argv[2])+2);
strcpy (command, argv[2]);
if (command[strlen (command) - 1] != ' ')
strcat (command, " ");
-
+
t = command;
newargc = 0;
t = mystrchr (t, ' ');
newargc++;
t = mystrchr (t+1, ' ');
}
-
+
newargv = (char **) alloca (sizeof (char *) * newargc);
-
+
t = command;
for (j = 0; j < newargc; j++)
{
t = mystrtok (t);
paramlen += strlen (newargv[j]) + 1;
}
-
+
if (strncmp (newargv[0], "~emacs/", 7) == 0)
{
if (posix_to_mac_pathname (newargv[0], tempmacpathname, MAXPATHLEN+1)
strcat (t, newargv[0]);
#endif /* 0 */
Lisp_Object path;
- openp (Vexec_path, build_string (newargv[0]), EXEC_SUFFIXES, &path,
+ openp (Vexec_path, build_string (newargv[0]), Vexec_suffixes, &path,
make_number (X_OK));
if (NILP (path))
strcpy (macappname, tempmacpathname);
}
else
- {
+ {
if (posix_to_mac_pathname (argv[0], macappname, MAXPATHLEN+1) == 0)
return -1;
newargv = (char **) alloca (sizeof (char *) * argc);
- newargc = argc;
+ newargc = argc;
for (j = 1; j < argc; j++)
{
if (strncmp (argv[j], "~emacs/", 7) == 0)
}
}
else
- newargv[j] = argv[j];
+ newargv[j] = argv[j];
paramlen += strlen (newargv[j]) + 1;
}
}
/* null terminate strings sent so it's possible to use strcpy over there */
strcpy (p, macinfn);
p += strlen (macinfn);
- *p++ = '\0';
+ *p++ = '\0';
strcpy (p, macoutfn);
p += strlen (macoutfn);
- *p++ = '\0';
+ *p++ = '\0';
strcpy (p, macerrfn);
p += strlen (macerrfn);
- *p++ = '\0';
+ *p++ = '\0';
for (j = 1; j < newargc; j++)
{
strcpy (p, newargv[j]);
p += strlen (newargv[j]);
- *p++ = '\0';
+ *p++ = '\0';
}
-
+
c2pstr (macappname);
-
+
iErr = FSMakeFSSpec (0, 0, macappname, &spec);
-
+
if (iErr != noErr)
{
free (param);
}
cursor_region_handle = NewRgn ();
-
+
/* Wait for the subprocess to finish, when it will send us a ERPY
high level event. */
while (1)
cursor_region_handle)
&& reply_event.message == kEmacsSubprocessReply)
break;
-
+
/* The return code is sent through the refCon */
iErr = AcceptHighLevelEvent (&targ, &ref_con, NULL, &len);
if (iErr != noErr)
free (param);
return -1;
}
-
+
DisposeHandle ((Handle) cursor_region_handle);
free (param);
DIR *
opendir (const char *dirname)
{
- char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
+ char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
char mac_pathname[MAXPATHLEN+1], vol_name[MAXPATHLEN+1];
DIR *dirp;
CInfoPBRec cipb;
HVolumeParam vpb;
int len, vol_name_len;
-
+
if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
return 0;
-
+
len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
if (len > -1)
fully_resolved_name[len] = '\0';
len = strlen (mac_pathname);
if (mac_pathname[len - 1] != ':' && len < MAXPATHLEN)
strcat (mac_pathname, ":");
-
+
/* Extract volume name */
vol_name_len = strchr (mac_pathname, ':') - mac_pathname;
strncpy (vol_name, mac_pathname, vol_name_len);
cipb.hFileInfo.ioDirID = 0;
cipb.hFileInfo.ioFDirIndex = 0;
/* set to 0 to get information about specific dir or file */
-
+
errno = PBGetCatInfo (&cipb, false);
if (errno != noErr)
{
}
dirp->vol_ref_num = vpb.ioVRefNum;
-
+
return dirp;
}
hpblock.volumeParam.ioNamePtr = s_name;
hpblock.volumeParam.ioVRefNum = 0;
hpblock.volumeParam.ioVolIndex = dp->current_index;
-
+
errno = PBHGetVInfo (&hpblock, false);
if (errno != noErr)
{
errno = ENOENT;
return 0;
}
-
+
p2cstr (s_name);
strcat (s_name, "/"); /* need "/" for stat to work correctly */
s_dirent.d_ino = hpblock.volumeParam.ioVRefNum;
s_dirent.d_name = s_name;
-
+
return &s_dirent;
}
else
cipb.hFileInfo.ioDirID = dp->dir_id;
/* directory ID found by opendir */
cipb.hFileInfo.ioFDirIndex = dp->current_index;
-
+
errno = PBGetCatInfo (&cipb, false);
if (errno != noErr)
{
errno = ENOENT;
return 0;
}
-
- /* insist on an visibile entry */
+
+ /* insist on a visible entry */
if (cipb.hFileInfo.ioFlAttrib & 0x10) /* directory? */
done = !(cipb.dirInfo.ioDrUsrWds.frFlags & fInvisible);
else
done = !(cipb.hFileInfo.ioFlFndrInfo.fdFlags & fInvisible);
-
+
dp->current_index++;
}
p2cstr (s_name);
-
+
p = s_name;
while (*p)
{
s_dirent.d_ino = cipb.dirInfo.ioDrDirID;
/* value unimportant: non-zero for valid file */
s_dirent.d_name = s_name;
-
+
return &s_dirent;
}
}
{
AEDesc null_desc;
OSAError osaerror;
-
+
/* if open fails, as_scripting_component is set to NULL. Its
subsequent use in OSA calls will fail with badComponentInstance
error. */
long status;
CHECK_STRING (script);
-
+
+ BLOCK_INPUT;
status = do_applescript (SDATA (script), &result);
+ UNBLOCK_INPUT;
if (status)
{
if (!result)
char posix_filename[MAXPATHLEN+1];
CHECK_STRING (mac_filename);
-
+
if (mac_to_posix_pathname (SDATA (mac_filename), posix_filename,
MAXPATHLEN))
return build_string (posix_filename);
char mac_filename[MAXPATHLEN+1];
CHECK_STRING (posix_filename);
-
+
if (posix_to_mac_pathname (SDATA (posix_filename), mac_filename,
MAXPATHLEN))
return build_string (mac_filename);
()
{
#if TARGET_API_MAC_CARBON
+ OSStatus err;
ScrapRef scrap;
ScrapFlavorFlags sff;
Size s;
int i;
char *data;
- if (GetCurrentScrap (&scrap) != noErr)
- return Qnil;
-
- if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) != noErr)
- return Qnil;
-
- if (GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s) != noErr)
- return Qnil;
-
- if ((data = (char*) alloca (s)) == NULL)
+ 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);
+ UNBLOCK_INPUT;
+ if (err != noErr || s == 0)
return Qnil;
- if (GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data) != noErr
- || s == 0)
- return Qnil;
-
/* Emacs expects clipboard contents have Unix-style eol's */
for (i = 0; i < s; i++)
if (data[i] == '\r')
value = make_string (*my_handle, rc);
HUnlock (my_handle);
-
+
DisposeHandle (my_handle);
return value;
/* fixme: ignore the push flag for now */
CHECK_STRING (value);
-
+
len = SCHARS (value);
buf = (char *) alloca (len+1);
bcopy (SDATA (value), buf, len);
buf[len] = '\0';
-
+
/* convert to Mac-style eol's before sending to clipboard */
for (i = 0; i < len; i++)
if (buf[i] == '\n')
#if TARGET_API_MAC_CARBON
{
ScrapRef scrap;
+
+ BLOCK_INPUT;
ClearCurrentScrap ();
if (GetCurrentScrap (&scrap) != noErr)
- error ("cannot get current scrap");
+ {
+ UNBLOCK_INPUT;
+ error ("cannot get current scrap");
+ }
if (PutScrapFlavor (scrap, kScrapFlavorTypeText, kScrapFlavorMaskNone, len,
buf) != noErr)
- error ("cannot put to scrap");
+ {
+ 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 */
-
+
return Qnil;
}
ScrapRef scrap;
ScrapFlavorFlags sff;
+ 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;
return Qnil;
}
+#if TARGET_API_MAC_CARBON
+static Lisp_Object Qxml;
+
+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.
+
+Optional arg APPLICATION is an application ID string. If omitted or
+nil, that stands for the current application.
+
+Optional arg FORMAT specifies the data format of the return value. If
+omitted or nil, each Core Foundation object is converted into a
+corresponding Lisp object as follows:
+
+ Core Foundation Lisp Tag
+ ------------------------------------------------------------
+ CFString Multibyte string string
+ CFNumber Integer or float number
+ CFBoolean Symbol (t or nil) boolean
+ CFDate List of three integers date
+ (cf. `current-time')
+ CFData Unibyte string data
+ CFArray Vector array
+ CFDictionary Alist or hash table dictionary
+ (depending on HASH-BOUND)
+
+If it is t, a symbol that represents the type of the original Core
+Foundation object is prepended. If it is `xml', the value is returned
+as an XML representation.
+
+Optional arg HASH-BOUND specifies which kinds of the list objects,
+alists or hash tables, are used as the targets of the conversion from
+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)
+ Lisp_Object key, application, format, hash_bound;
+{
+ CFStringRef app_id, key_str;
+ CFPropertyListRef app_plist = NULL, plist;
+ Lisp_Object result = Qnil, tmp;
+
+ if (STRINGP (key))
+ key = Fcons (key, Qnil);
+ else
+ {
+ CHECK_CONS (key);
+ for (tmp = key; CONSP (tmp); tmp = XCDR (tmp))
+ CHECK_STRING_CAR (tmp);
+ if (!NILP (tmp))
+ wrong_type_argument (Qlistp, key);
+ }
+ if (!NILP (application))
+ CHECK_STRING (application);
+ CHECK_SYMBOL (format);
+ if (!NILP (hash_bound))
+ CHECK_NUMBER (hash_bound);
+
+ BLOCK_INPUT;
+
+ app_id = kCFPreferencesCurrentApplication;
+ if (!NILP (application))
+ {
+ app_id = cfstring_create_with_string (application);
+ if (app_id == NULL)
+ goto out;
+ }
+ key_str = cfstring_create_with_string (XCAR (key));
+ if (key_str == NULL)
+ goto out;
+ app_plist = CFPreferencesCopyAppValue (key_str, app_id);
+ CFRelease (key_str);
+ if (app_plist == NULL)
+ goto out;
+
+ plist = app_plist;
+ for (key = XCDR (key); CONSP (key); key = XCDR (key))
+ {
+ if (CFGetTypeID (plist) != CFDictionaryGetTypeID ())
+ break;
+ key_str = cfstring_create_with_string (XCAR (key));
+ if (key_str == NULL)
+ goto out;
+ plist = CFDictionaryGetValue (plist, key_str);
+ CFRelease (key_str);
+ if (plist == NULL)
+ goto out;
+ }
+
+ 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));
+
+ out:
+ if (app_plist)
+ CFRelease (app_plist);
+ CFRelease (app_id);
+
+ UNBLOCK_INPUT;
+
+ 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. */)
+ ()
+{
+ check_mac ();
+ mac_clear_font_name_table ();
+ return Qnil;
+}
+
#ifdef MAC_OSX
#undef select
extern int inhibit_window_system;
+extern int noninteractive;
+
+/* Unlike in X11, window events in Carbon do not come from sockets.
+ So we cannot simply use `select' to monitor two kinds of inputs:
+ window events and process outputs. We emulate such functionality
+ by regarding fd 0 as the window event channel and simultaneously
+ monitoring both kinds of input channels. It is implemented by
+ dividing into some cases:
+ 1. The window event channel is not involved.
+ -> 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
+ 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.
+ 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
+#define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
+#define EVENT_CLASS_SOCK 'Sock'
+
+static void
+socket_callback (s, type, address, data, info)
+ CFSocketRef s;
+ CFSocketCallBackType type;
+ CFDataRef address;
+ const void *data;
+ void *info;
+{
+ EventRef event;
+
+ CreateEvent (NULL, EVENT_CLASS_SOCK, 0, 0, kEventAttributeNone, &event);
+ PostEventToQueue (GetCurrentEventQueue (), event, kEventPriorityStandard);
+ ReleaseEvent (event);
+}
+#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;
+{
+ int r;
+ OSErr err;
+
+ r = select (n, rfds, wfds, efds, timeout);
+ if (r != -1)
+ {
+ BLOCK_INPUT;
+ err = ReceiveNextEvent (0, NULL, kEventDurationNoWait,
+ kEventLeaveInQueue, NULL);
+ UNBLOCK_INPUT;
+ if (err == noErr)
+ {
+ FD_SET (0, rfds);
+ r++;
+ }
+ }
+ return r;
+}
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
+#undef SELECT_INVALIDATE_CFSOCKET
+#endif
-/* When Emacs is started from the Finder, SELECT always immediately
- returns as if input is present when file descriptor 0 is polled for
- input. Strangely, when Emacs is run as a GUI application from the
- command line, it blocks in the same situation. This `wrapper' of
- the system call SELECT corrects this discrepancy. */
int
sys_select (n, rfds, wfds, efds, timeout)
- int n;
- SELECT_TYPE *rfds;
- SELECT_TYPE *wfds;
- SELECT_TYPE *efds;
- struct timeval *timeout;
+ int n;
+ SELECT_TYPE *rfds;
+ SELECT_TYPE *wfds;
+ SELECT_TYPE *efds;
+ struct timeval *timeout;
{
- if (!inhibit_window_system && rfds && FD_ISSET (0, rfds))
- return 1;
- else
+ OSErr err;
+ int i, r;
+ EMACS_TIME select_timeout;
+
+ if (inhibit_window_system || noninteractive
+ || rfds == NULL || !FD_ISSET (0, rfds))
return select (n, rfds, wfds, efds, timeout);
-}
+ FD_CLR (0, rfds);
+
+ if (wfds == NULL && efds == NULL)
+ {
+ int nsocks = 0;
+ SELECT_TYPE orfds = *rfds;
+
+ EventTimeout timeout_sec =
+ (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)
+ {
+ BLOCK_INPUT;
+ err = ReceiveNextEvent (0, NULL, timeout_sec,
+ kEventLeaveInQueue, NULL);
+ UNBLOCK_INPUT;
+ if (err == noErr)
+ {
+ FD_SET (0, rfds);
+ return 1;
+ }
+ else
+ return 0;
+ }
+
+ /* 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)
+ return r;
+
+ *rfds = orfds;
+
+#ifdef SELECT_USE_CFSOCKET
+ if (timeout_sec > 0 && timeout_sec <= 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);
+
+ do
+ {
+ --s;
+#ifdef SELECT_INVALIDATE_CFSOCKET
+ CFSocketInvalidate (*s);
+#else
+ CFRunLoopRemoveSource (runloop, *s, kCFRunLoopDefaultMode);
+#endif
+ CFRelease (*s);
+ }
+ while (s != shead);
+
+ xfree (shead);
+
+ 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);
+ }
+
+ UNBLOCK_INPUT;
+
+ return r;
+ }
+#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_GET_TIME (now);
+ EMACS_ADD_TIME (end_time, now, remaining_time);
+ }
+
+ do
+ {
+ 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);
+ if (r != 0)
+ return r;
+
+ *rfds = orfds;
+ if (wfds)
+ *wfds = owfds;
+ if (efds)
+ *efds = oefds;
+
+ if (timeout)
+ {
+ EMACS_GET_TIME (now);
+ EMACS_SUB_TIME (remaining_time, end_time, now);
+ }
+ }
+ while (!timeout || EMACS_TIME_LT (now, end_time));
+
+ FD_ZERO (rfds);
+ if (wfds)
+ FD_ZERO (wfds);
+ if (efds)
+ FD_ZERO (efds);
+ return 0;
+ }
+}
/* Set up environment variables so that Emacs can correctly find its
support files when packaged as an application bundle. Directories
q[0] = '\0';
strcpy (p, app_bundle_pathname);
- strcat (p, "/Contents/MacOS/bin");
+ strcat (p, "/Contents/MacOS/libexec");
if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
strcat (q, p);
strcpy (p, app_bundle_pathname);
- strcat (p, "/Contents/MacOS/libexec");
+ strcat (p, "/Contents/MacOS/bin");
if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
{
if (q[0] != '\0')
}
#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 ()
{
QCLIPBOARD = intern ("CLIPBOARD");
staticpro (&QCLIPBOARD);
-
+
+#if TARGET_API_MAC_CARBON
+ 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);
+
+ Qxml = intern ("xml");
+ staticpro (&Qxml);
+#endif
+
defsubr (&Smac_paste_function);
defsubr (&Smac_cut_function);
defsubr (&Sx_selection_exists_p);
+#if TARGET_API_MAC_CARBON
+ defsubr (&Smac_get_preference);
+#endif
+ defsubr (&Smac_clear_font_name_table);
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
+ (do not change this comment) */