1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
32 #include "sysselect.h"
33 #include "blockinput.h"
37 #if TARGET_API_MAC_CARBON
40 #else /* not TARGET_API_MAC_CARBON */
43 #include <TextUtils.h>
45 #include <Resources.h>
50 #include <AppleScript.h>
53 #include <Processes.h>
55 #include <MacLocales.h>
56 #endif /* not TARGET_API_MAC_CARBON */
60 #include <sys/types.h>
65 #include <sys/param.h>
72 /* The system script code. */
73 static int mac_system_script_code
;
75 /* The system locale identifier string. */
76 static Lisp_Object Vmac_system_locale
;
78 /* An instance of the AppleScript component. */
79 static ComponentInstance as_scripting_component
;
80 /* The single script context used for all script executions. */
81 static OSAID as_script_context
;
84 /* When converting from Mac to Unix pathnames, /'s in folder names are
85 converted to :'s. This function, used in copying folder names,
86 performs a strncat and converts all character a to b in the copy of
87 the string s2 appended to the end of s1. */
90 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
98 for (i
= 0; i
< l2
; i
++)
107 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
108 that does not begin with a ':' and contains at least one ':'. A Mac
109 full pathname causes a '/' to be prepended to the Posix pathname.
110 The algorithm for the rest of the pathname is as follows:
111 For each segment between two ':',
112 if it is non-null, copy as is and then add a '/' at the end,
113 otherwise, insert a "../" into the Posix pathname.
114 Returns 1 if successful; 0 if fails. */
117 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
119 const char *p
, *q
, *pe
;
126 p
= strchr (mfn
, ':');
127 if (p
!= 0 && p
!= mfn
) /* full pathname */
134 pe
= mfn
+ strlen (mfn
);
141 { /* two consecutive ':' */
142 if (strlen (ufn
) + 3 >= ufnbuflen
)
148 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
150 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
157 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
159 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
160 /* no separator for last one */
169 extern char *get_temp_dir_name ();
172 /* Convert a Posix pathname to Mac form. Approximately reverse of the
173 above in algorithm. */
176 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
178 const char *p
, *q
, *pe
;
179 char expanded_pathname
[MAXPATHLEN
+1];
188 /* Check for and handle volume names. Last comparison: strangely
189 somewhere "/.emacs" is passed. A temporary fix for now. */
190 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
192 if (strlen (p
) + 1 > mfnbuflen
)
199 /* expand to emacs dir found by init_emacs_passwd_dir */
200 if (strncmp (p
, "~emacs/", 7) == 0)
202 struct passwd
*pw
= getpwnam ("emacs");
204 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
206 strcpy (expanded_pathname
, pw
->pw_dir
);
207 strcat (expanded_pathname
, p
);
208 p
= expanded_pathname
;
209 /* now p points to the pathname with emacs dir prefix */
211 else if (strncmp (p
, "/tmp/", 5) == 0)
213 char *t
= get_temp_dir_name ();
215 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
217 strcpy (expanded_pathname
, t
);
218 strcat (expanded_pathname
, p
);
219 p
= expanded_pathname
;
220 /* now p points to the pathname with emacs dir prefix */
222 else if (*p
!= '/') /* relative pathname */
234 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
236 if (strlen (mfn
) + 1 >= mfnbuflen
)
242 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
244 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
251 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
253 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
262 /***********************************************************************
263 Conversion between Lisp and Core Foundation objects
264 ***********************************************************************/
266 #if TARGET_API_MAC_CARBON
267 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
268 static Lisp_Object Qarray
, Qdictionary
;
269 #define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
271 struct cfdict_context
274 int with_tag
, hash_bound
;
277 /* C string to CFString. */
280 cfstring_create_with_utf8_cstring (c_str
)
285 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
287 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
288 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
294 /* Lisp string to CFString. */
297 cfstring_create_with_string (s
)
300 CFStringRef string
= NULL
;
302 if (STRING_MULTIBYTE (s
))
304 char *p
, *end
= SDATA (s
) + SBYTES (s
);
306 for (p
= SDATA (s
); p
< end
; p
++)
309 s
= ENCODE_UTF_8 (s
);
312 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
313 kCFStringEncodingUTF8
, false);
317 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
318 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
319 kCFStringEncodingMacRoman
, false);
325 /* From CFData to a lisp string. Always returns a unibyte string. */
328 cfdata_to_lisp (data
)
331 CFIndex len
= CFDataGetLength (data
);
332 Lisp_Object result
= make_uninit_string (len
);
334 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
340 /* From CFString to a lisp string. Never returns a unibyte string
341 (even if it only contains ASCII characters).
342 This may cause GC during code conversion. */
345 cfstring_to_lisp (string
)
348 Lisp_Object result
= Qnil
;
349 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
352 result
= make_unibyte_string (s
, strlen (s
));
356 CFStringCreateExternalRepresentation (NULL
, string
,
357 kCFStringEncodingUTF8
, '?');
361 result
= cfdata_to_lisp (data
);
368 result
= DECODE_UTF_8 (result
);
369 /* This may be superfluous. Just to make sure that the result
370 is a multibyte string. */
371 result
= string_to_multibyte (result
);
378 /* CFNumber to a lisp integer or a lisp float. */
381 cfnumber_to_lisp (number
)
384 Lisp_Object result
= Qnil
;
385 #if BITS_PER_EMACS_INT > 32
387 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
390 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
394 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
395 && !FIXNUM_OVERFLOW_P (int_val
))
396 result
= make_number (int_val
);
398 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
399 result
= make_float (float_val
);
404 /* CFDate to a list of three integers as in a return value of
408 cfdate_to_lisp (date
)
411 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
412 static CFAbsoluteTime epoch
= 0.0, sec
;
416 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
418 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
419 high
= sec
/ 65536.0;
420 low
= sec
- high
* 65536.0;
422 return list3 (make_number (high
), make_number (low
), make_number (0));
426 /* CFBoolean to a lisp symbol, `t' or `nil'. */
429 cfboolean_to_lisp (boolean
)
430 CFBooleanRef boolean
;
432 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
436 /* Any Core Foundation object to a (lengthy) lisp string. */
439 cfobject_desc_to_lisp (object
)
442 Lisp_Object result
= Qnil
;
443 CFStringRef desc
= CFCopyDescription (object
);
447 result
= cfstring_to_lisp (desc
);
455 /* Callback functions for cfproperty_list_to_lisp. */
458 cfdictionary_add_to_list (key
, value
, context
)
463 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
466 Fcons (Fcons (cfstring_to_lisp (key
),
467 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
473 cfdictionary_puthash (key
, value
, context
)
478 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
479 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
480 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
483 hash_lookup (h
, lisp_key
, &hash_code
);
484 hash_put (h
, lisp_key
,
485 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
490 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
491 non-zero, a symbol that represents the type of the original Core
492 Foundation object is prepended. HASH_BOUND specifies which kinds
493 of the lisp objects, alists or hash tables, are used as the targets
494 of the conversion from CFDictionary. If HASH_BOUND is negative,
495 always generate alists. If HASH_BOUND >= 0, generate an alist if
496 the number of keys in the dictionary is smaller than HASH_BOUND,
497 and a hash table otherwise. */
500 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
501 CFPropertyListRef plist
;
502 int with_tag
, hash_bound
;
504 CFTypeID type_id
= CFGetTypeID (plist
);
505 Lisp_Object tag
= Qnil
, result
= Qnil
;
506 struct gcpro gcpro1
, gcpro2
;
508 GCPRO2 (tag
, result
);
510 if (type_id
== CFStringGetTypeID ())
513 result
= cfstring_to_lisp (plist
);
515 else if (type_id
== CFNumberGetTypeID ())
518 result
= cfnumber_to_lisp (plist
);
520 else if (type_id
== CFBooleanGetTypeID ())
523 result
= cfboolean_to_lisp (plist
);
525 else if (type_id
== CFDateGetTypeID ())
528 result
= cfdate_to_lisp (plist
);
530 else if (type_id
== CFDataGetTypeID ())
533 result
= cfdata_to_lisp (plist
);
535 else if (type_id
== CFArrayGetTypeID ())
537 CFIndex index
, count
= CFArrayGetCount (plist
);
540 result
= Fmake_vector (make_number (count
), Qnil
);
541 for (index
= 0; index
< count
; index
++)
542 XVECTOR (result
)->contents
[index
] =
543 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
544 with_tag
, hash_bound
);
546 else if (type_id
== CFDictionaryGetTypeID ())
548 struct cfdict_context context
;
549 CFIndex count
= CFDictionaryGetCount (plist
);
552 context
.result
= &result
;
553 context
.with_tag
= with_tag
;
554 context
.hash_bound
= hash_bound
;
555 if (hash_bound
< 0 || count
< hash_bound
)
558 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
563 result
= make_hash_table (Qequal
,
565 make_float (DEFAULT_REHASH_SIZE
),
566 make_float (DEFAULT_REHASH_THRESHOLD
),
568 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
578 result
= Fcons (tag
, result
);
585 /***********************************************************************
586 Emulation of the X Resource Manager
587 ***********************************************************************/
589 /* Parser functions for resource lines. Each function takes an
590 address of a variable whose value points to the head of a string.
591 The value will be advanced so that it points to the next character
592 of the parsed part when the function returns.
594 A resource name such as "Emacs*font" is parsed into a non-empty
595 list called `quarks'. Each element is either a Lisp string that
596 represents a concrete component, a Lisp symbol LOOSE_BINDING
597 (actually Qlambda) that represents any number (>=0) of intervening
598 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
599 that represents as any single component. */
603 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
604 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
610 /* WhiteSpace = {<space> | <horizontal tab>} */
611 while (*P
== ' ' || *P
== '\t')
619 /* Comment = "!" {<any character except null or newline>} */
632 /* Don't interpret filename. Just skip until the newline. */
634 parse_include_file (p
)
637 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
654 /* Binding = "." | "*" */
655 if (*P
== '.' || *P
== '*')
659 while (*P
== '.' || *P
== '*')
672 /* Component = "?" | ComponentName
673 ComponentName = NameChar {NameChar}
674 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
678 return SINGLE_COMPONENT
;
680 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
684 while (isalnum (*P
) || *P
== '_' || *P
== '-')
687 return make_unibyte_string (start
, P
- start
);
694 parse_resource_name (p
)
697 Lisp_Object result
= Qnil
, component
;
700 /* ResourceName = [Binding] {Component Binding} ComponentName */
701 if (parse_binding (p
) == '*')
702 result
= Fcons (LOOSE_BINDING
, result
);
704 component
= parse_component (p
);
705 if (NILP (component
))
708 result
= Fcons (component
, result
);
709 while ((binding
= parse_binding (p
)) != '\0')
712 result
= Fcons (LOOSE_BINDING
, result
);
713 component
= parse_component (p
);
714 if (NILP (component
))
717 result
= Fcons (component
, result
);
720 /* The final component should not be '?'. */
721 if (EQ (component
, SINGLE_COMPONENT
))
724 return Fnreverse (result
);
732 Lisp_Object seq
= Qnil
, result
;
733 int buf_len
, total_len
= 0, len
, continue_p
;
735 q
= strchr (P
, '\n');
736 buf_len
= q
? q
- P
: strlen (P
);
737 buf
= xmalloc (buf_len
);
766 else if ('0' <= P
[0] && P
[0] <= '7'
767 && '0' <= P
[1] && P
[1] <= '7'
768 && '0' <= P
[2] && P
[2] <= '7')
770 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
780 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
785 q
= strchr (P
, '\n');
786 len
= q
? q
- P
: strlen (P
);
791 buf
= xmalloc (buf_len
);
799 if (SBYTES (XCAR (seq
)) == total_len
)
800 return make_string (SDATA (XCAR (seq
)), total_len
);
803 buf
= xmalloc (total_len
);
805 for (; CONSP (seq
); seq
= XCDR (seq
))
807 len
= SBYTES (XCAR (seq
));
809 memcpy (q
, SDATA (XCAR (seq
)), len
);
811 result
= make_string (buf
, total_len
);
818 parse_resource_line (p
)
821 Lisp_Object quarks
, value
;
823 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
824 if (parse_comment (p
) || parse_include_file (p
))
827 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
828 skip_white_space (p
);
829 quarks
= parse_resource_name (p
);
832 skip_white_space (p
);
836 skip_white_space (p
);
837 value
= parse_value (p
);
838 return Fcons (quarks
, value
);
841 /* Skip the remaining data as a dummy value. */
848 /* Equivalents of X Resource Manager functions.
850 An X Resource Database acts as a collection of resource names and
851 associated values. It is implemented as a trie on quarks. Namely,
852 each edge is labeled by either a string, LOOSE_BINDING, or
853 SINGLE_COMPONENT. Each node has a node id, which is a unique
854 nonnegative integer, and the root node id is 0. A database is
855 implemented as a hash table that maps a pair (SRC-NODE-ID .
856 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
857 in the table as a value for HASHKEY_MAX_NID. A value associated to
858 a node is recorded as a value for the node id. */
860 #define HASHKEY_MAX_NID (make_number (0))
863 xrm_create_database ()
865 XrmDatabase database
;
867 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
868 make_float (DEFAULT_REHASH_SIZE
),
869 make_float (DEFAULT_REHASH_THRESHOLD
),
871 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
877 xrm_q_put_resource (database
, quarks
, value
)
878 XrmDatabase database
;
879 Lisp_Object quarks
, value
;
881 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
884 Lisp_Object node_id
, key
;
886 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
888 XSETINT (node_id
, 0);
889 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
891 key
= Fcons (node_id
, XCAR (quarks
));
892 i
= hash_lookup (h
, key
, &hash_code
);
896 XSETINT (node_id
, max_nid
);
897 hash_put (h
, key
, node_id
, hash_code
);
900 node_id
= HASH_VALUE (h
, i
);
902 Fputhash (node_id
, value
, database
);
904 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
907 /* Merge multiple resource entries specified by DATA into a resource
908 database DATABASE. DATA points to the head of a null-terminated
909 string consisting of multiple resource lines. It's like a
910 combination of XrmGetStringDatabase and XrmMergeDatabases. */
913 xrm_merge_string_database (database
, data
)
914 XrmDatabase database
;
917 Lisp_Object quarks_value
;
921 quarks_value
= parse_resource_line (&data
);
922 if (!NILP (quarks_value
))
923 xrm_q_put_resource (database
,
924 XCAR (quarks_value
), XCDR (quarks_value
));
929 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
930 XrmDatabase database
;
931 Lisp_Object node_id
, quark_name
, quark_class
;
933 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
934 Lisp_Object key
, labels
[3], value
;
937 if (!CONSP (quark_name
))
938 return Fgethash (node_id
, database
, Qnil
);
940 /* First, try tight bindings */
941 labels
[0] = XCAR (quark_name
);
942 labels
[1] = XCAR (quark_class
);
943 labels
[2] = SINGLE_COMPONENT
;
945 key
= Fcons (node_id
, Qnil
);
946 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
948 XSETCDR (key
, labels
[k
]);
949 i
= hash_lookup (h
, key
, NULL
);
952 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
953 XCDR (quark_name
), XCDR (quark_class
));
959 /* Then, try loose bindings */
960 XSETCDR (key
, LOOSE_BINDING
);
961 i
= hash_lookup (h
, key
, NULL
);
964 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
965 quark_name
, quark_class
);
969 return xrm_q_get_resource_1 (database
, node_id
,
970 XCDR (quark_name
), XCDR (quark_class
));
977 xrm_q_get_resource (database
, quark_name
, quark_class
)
978 XrmDatabase database
;
979 Lisp_Object quark_name
, quark_class
;
981 return xrm_q_get_resource_1 (database
, make_number (0),
982 quark_name
, quark_class
);
985 /* Retrieve a resource value for the specified NAME and CLASS from the
986 resource database DATABASE. It corresponds to XrmGetResource. */
989 xrm_get_resource (database
, name
, class)
990 XrmDatabase database
;
993 Lisp_Object quark_name
, quark_class
, tmp
;
996 quark_name
= parse_resource_name (&name
);
999 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1000 if (!STRINGP (XCAR (tmp
)))
1003 quark_class
= parse_resource_name (&class);
1006 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1007 if (!STRINGP (XCAR (tmp
)))
1013 return xrm_q_get_resource (database
, quark_name
, quark_class
);
1016 #if TARGET_API_MAC_CARBON
1018 xrm_cfproperty_list_to_value (plist
)
1019 CFPropertyListRef plist
;
1021 CFTypeID type_id
= CFGetTypeID (plist
);
1023 if (type_id
== CFStringGetTypeID ())
1024 return cfstring_to_lisp (plist
);
1025 else if (type_id
== CFNumberGetTypeID ())
1028 Lisp_Object result
= Qnil
;
1030 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1033 result
= cfstring_to_lisp (string
);
1038 else if (type_id
== CFBooleanGetTypeID ())
1039 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1040 else if (type_id
== CFDataGetTypeID ())
1041 return cfdata_to_lisp (plist
);
1047 /* Create a new resource database from the preferences for the
1048 application APPLICATION. APPLICATION is either a string that
1049 specifies an application ID, or NULL that represents the current
1053 xrm_get_preference_database (application
)
1056 #if TARGET_API_MAC_CARBON
1057 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1058 CFMutableSetRef key_set
= NULL
;
1059 CFArrayRef key_array
;
1060 CFIndex index
, count
;
1062 XrmDatabase database
;
1063 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1064 CFPropertyListRef plist
;
1066 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1068 user_doms
[0] = kCFPreferencesCurrentUser
;
1069 user_doms
[1] = kCFPreferencesAnyUser
;
1070 host_doms
[0] = kCFPreferencesCurrentHost
;
1071 host_doms
[1] = kCFPreferencesAnyHost
;
1073 database
= xrm_create_database ();
1075 GCPRO3 (database
, quarks
, value
);
1079 app_id
= kCFPreferencesCurrentApplication
;
1082 app_id
= cfstring_create_with_utf8_cstring (application
);
1087 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1088 if (key_set
== NULL
)
1090 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1091 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1093 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1097 count
= CFArrayGetCount (key_array
);
1098 for (index
= 0; index
< count
; index
++)
1099 CFSetAddValue (key_set
,
1100 CFArrayGetValueAtIndex (key_array
, index
));
1101 CFRelease (key_array
);
1105 count
= CFSetGetCount (key_set
);
1106 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1109 CFSetGetValues (key_set
, (const void **)keys
);
1110 for (index
= 0; index
< count
; index
++)
1112 res_name
= SDATA (cfstring_to_lisp (keys
[index
]));
1113 quarks
= parse_resource_name (&res_name
);
1114 if (!(NILP (quarks
) || *res_name
))
1116 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1117 value
= xrm_cfproperty_list_to_value (plist
);
1120 xrm_q_put_resource (database
, quarks
, value
);
1127 CFRelease (key_set
);
1136 return xrm_create_database ();
1143 /* The following functions with "sys_" prefix are stubs to Unix
1144 functions that have already been implemented by CW or MPW. The
1145 calls to them in Emacs source course are #define'd to call the sys_
1146 versions by the header files s-mac.h. In these stubs pathnames are
1147 converted between their Unix and Mac forms. */
1150 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1151 + 17 leap days. These are for adjusting time values returned by
1152 MacOS Toolbox functions. */
1154 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1157 #if __MSL__ < 0x6000
1158 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1159 a leap year! This is for adjusting time_t values returned by MSL
1161 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1162 #else /* __MSL__ >= 0x6000 */
1163 /* CW changes Pro 6 to follow Unix! */
1164 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1165 #endif /* __MSL__ >= 0x6000 */
1167 /* MPW library functions follow Unix (confused?). */
1168 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1169 #else /* not __MRC__ */
1171 #endif /* not __MRC__ */
1174 /* Define our own stat function for both MrC and CW. The reason for
1175 doing this: "stat" is both the name of a struct and function name:
1176 can't use the same trick like that for sys_open, sys_close, etc. to
1177 redirect Emacs's calls to our own version that converts Unix style
1178 filenames to Mac style filename because all sorts of compilation
1179 errors will be generated if stat is #define'd to be sys_stat. */
1182 stat_noalias (const char *path
, struct stat
*buf
)
1184 char mac_pathname
[MAXPATHLEN
+1];
1187 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1190 c2pstr (mac_pathname
);
1191 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1192 cipb
.hFileInfo
.ioVRefNum
= 0;
1193 cipb
.hFileInfo
.ioDirID
= 0;
1194 cipb
.hFileInfo
.ioFDirIndex
= 0;
1195 /* set to 0 to get information about specific dir or file */
1197 errno
= PBGetCatInfo (&cipb
, false);
1198 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1203 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1205 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1207 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1208 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1209 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1210 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1211 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1212 /* size of dir = number of files and dirs */
1215 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1216 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1220 buf
->st_mode
= S_IFREG
| S_IREAD
;
1221 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1222 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1223 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1224 buf
->st_mode
|= S_IEXEC
;
1225 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1226 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1227 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1230 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1231 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1234 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1236 /* identify alias files as symlinks */
1237 buf
->st_mode
&= ~S_IFREG
;
1238 buf
->st_mode
|= S_IFLNK
;
1242 buf
->st_uid
= getuid ();
1243 buf
->st_gid
= getgid ();
1251 lstat (const char *path
, struct stat
*buf
)
1254 char true_pathname
[MAXPATHLEN
+1];
1256 /* Try looking for the file without resolving aliases first. */
1257 if ((result
= stat_noalias (path
, buf
)) >= 0)
1260 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1263 return stat_noalias (true_pathname
, buf
);
1268 stat (const char *path
, struct stat
*sb
)
1271 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1274 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1275 ! (sb
->st_mode
& S_IFLNK
))
1278 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1281 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1284 fully_resolved_name
[len
] = '\0';
1285 /* in fact our readlink terminates strings */
1286 return lstat (fully_resolved_name
, sb
);
1289 return lstat (true_pathname
, sb
);
1294 /* CW defines fstat in stat.mac.c while MPW does not provide this
1295 function. Without the information of how to get from a file
1296 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1297 to implement this function. Fortunately, there is only one place
1298 where this function is called in our configuration: in fileio.c,
1299 where only the st_dev and st_ino fields are used to determine
1300 whether two fildes point to different i-nodes to prevent copying
1301 a file onto itself equal. What we have here probably needs
1305 fstat (int fildes
, struct stat
*buf
)
1308 buf
->st_ino
= fildes
;
1309 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1310 return 0; /* success */
1312 #endif /* __MRC__ */
1316 mkdir (const char *dirname
, int mode
)
1318 #pragma unused(mode)
1321 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1323 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1326 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1329 c2pstr (mac_pathname
);
1330 hfpb
.ioNamePtr
= mac_pathname
;
1331 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1332 hfpb
.ioDirID
= 0; /* parent is the root */
1334 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1335 /* just return the Mac OSErr code for now */
1336 return errno
== noErr
? 0 : -1;
1341 sys_rmdir (const char *dirname
)
1344 char mac_pathname
[MAXPATHLEN
+1];
1346 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1349 c2pstr (mac_pathname
);
1350 hfpb
.ioNamePtr
= mac_pathname
;
1351 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1352 hfpb
.ioDirID
= 0; /* parent is the root */
1354 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1355 return errno
== noErr
? 0 : -1;
1360 /* No implementation yet. */
1362 execvp (const char *path
, ...)
1366 #endif /* __MRC__ */
1370 utime (const char *path
, const struct utimbuf
*times
)
1372 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1374 char mac_pathname
[MAXPATHLEN
+1];
1377 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1380 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1382 fully_resolved_name
[len
] = '\0';
1384 strcpy (fully_resolved_name
, true_pathname
);
1386 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1389 c2pstr (mac_pathname
);
1390 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1391 cipb
.hFileInfo
.ioVRefNum
= 0;
1392 cipb
.hFileInfo
.ioDirID
= 0;
1393 cipb
.hFileInfo
.ioFDirIndex
= 0;
1394 /* set to 0 to get information about specific dir or file */
1396 errno
= PBGetCatInfo (&cipb
, false);
1400 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1403 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1405 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1410 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1412 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1415 errno
= PBSetCatInfo (&cipb
, false);
1416 return errno
== noErr
? 0 : -1;
1430 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1432 access (const char *path
, int mode
)
1434 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1436 char mac_pathname
[MAXPATHLEN
+1];
1439 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1442 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1444 fully_resolved_name
[len
] = '\0';
1446 strcpy (fully_resolved_name
, true_pathname
);
1448 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1451 c2pstr (mac_pathname
);
1452 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1453 cipb
.hFileInfo
.ioVRefNum
= 0;
1454 cipb
.hFileInfo
.ioDirID
= 0;
1455 cipb
.hFileInfo
.ioFDirIndex
= 0;
1456 /* set to 0 to get information about specific dir or file */
1458 errno
= PBGetCatInfo (&cipb
, false);
1462 if (mode
== F_OK
) /* got this far, file exists */
1466 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1470 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1477 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1478 /* don't allow if lock bit is on */
1484 #define DEV_NULL_FD 0x10000
1488 sys_open (const char *path
, int oflag
)
1490 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1492 char mac_pathname
[MAXPATHLEN
+1];
1494 if (strcmp (path
, "/dev/null") == 0)
1495 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1497 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1500 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1502 fully_resolved_name
[len
] = '\0';
1504 strcpy (fully_resolved_name
, true_pathname
);
1506 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1511 int res
= open (mac_pathname
, oflag
);
1512 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1513 if (oflag
& O_CREAT
)
1514 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1516 #else /* not __MRC__ */
1517 return open (mac_pathname
, oflag
);
1518 #endif /* not __MRC__ */
1525 sys_creat (const char *path
, mode_t mode
)
1527 char true_pathname
[MAXPATHLEN
+1];
1529 char mac_pathname
[MAXPATHLEN
+1];
1531 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1534 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1539 int result
= creat (mac_pathname
);
1540 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1542 #else /* not __MRC__ */
1543 return creat (mac_pathname
, mode
);
1544 #endif /* not __MRC__ */
1551 sys_unlink (const char *path
)
1553 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1555 char mac_pathname
[MAXPATHLEN
+1];
1557 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1560 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1562 fully_resolved_name
[len
] = '\0';
1564 strcpy (fully_resolved_name
, true_pathname
);
1566 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1569 return unlink (mac_pathname
);
1575 sys_read (int fildes
, char *buf
, int count
)
1577 if (fildes
== 0) /* this should not be used for console input */
1580 #if __MSL__ >= 0x6000
1581 return _read (fildes
, buf
, count
);
1583 return read (fildes
, buf
, count
);
1590 sys_write (int fildes
, const char *buf
, int count
)
1592 if (fildes
== DEV_NULL_FD
)
1595 #if __MSL__ >= 0x6000
1596 return _write (fildes
, buf
, count
);
1598 return write (fildes
, buf
, count
);
1605 sys_rename (const char * old_name
, const char * new_name
)
1607 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1608 char fully_resolved_old_name
[MAXPATHLEN
+1];
1610 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1612 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1615 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1617 fully_resolved_old_name
[len
] = '\0';
1619 strcpy (fully_resolved_old_name
, true_old_pathname
);
1621 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1624 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1627 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1632 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1635 /* If a file with new_name already exists, rename deletes the old
1636 file in Unix. CW version fails in these situation. So we add a
1637 call to unlink here. */
1638 (void) unlink (mac_new_name
);
1640 return rename (mac_old_name
, mac_new_name
);
1645 extern FILE *fopen (const char *name
, const char *mode
);
1647 sys_fopen (const char *name
, const char *mode
)
1649 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1651 char mac_pathname
[MAXPATHLEN
+1];
1653 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1656 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1658 fully_resolved_name
[len
] = '\0';
1660 strcpy (fully_resolved_name
, true_pathname
);
1662 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1667 if (mode
[0] == 'w' || mode
[0] == 'a')
1668 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1669 #endif /* not __MRC__ */
1670 return fopen (mac_pathname
, mode
);
1675 #include "keyboard.h"
1676 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1679 select (n
, rfds
, wfds
, efds
, timeout
)
1684 struct timeval
*timeout
;
1687 #if TARGET_API_MAC_CARBON
1688 EventTimeout timeout_sec
=
1690 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1691 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1692 : kEventDurationForever
);
1695 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1697 #else /* not TARGET_API_MAC_CARBON */
1699 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1700 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1702 /* Can only handle wait for keyboard input. */
1703 if (n
> 1 || wfds
|| efds
)
1706 /* Also return true if an event other than a keyDown has occurred.
1707 This causes kbd_buffer_get_event in keyboard.c to call
1708 read_avail_input which in turn calls XTread_socket to poll for
1709 these events. Otherwise these never get processed except but a
1710 very slow poll timer. */
1711 if (mac_wait_next_event (&e
, sleep_time
, false))
1714 err
= -9875; /* eventLoopTimedOutErr */
1715 #endif /* not TARGET_API_MAC_CARBON */
1717 if (FD_ISSET (0, rfds
))
1728 if (input_polling_used ())
1730 /* It could be confusing if a real alarm arrives while
1731 processing the fake one. Turn it off and let the
1732 handler reset it. */
1733 extern void poll_for_input_1
P_ ((void));
1734 int old_poll_suppress_count
= poll_suppress_count
;
1735 poll_suppress_count
= 1;
1736 poll_for_input_1 ();
1737 poll_suppress_count
= old_poll_suppress_count
;
1747 /* Simulation of SIGALRM. The stub for function signal stores the
1748 signal handler function in alarm_signal_func if a SIGALRM is
1752 #include "syssignal.h"
1754 static TMTask mac_atimer_task
;
1756 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
1758 static int signal_mask
= 0;
1761 __sigfun alarm_signal_func
= (__sigfun
) 0;
1763 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
1764 #else /* not __MRC__ and not __MWERKS__ */
1766 #endif /* not __MRC__ and not __MWERKS__ */
1770 extern __sigfun
signal (int signal
, __sigfun signal_func
);
1772 sys_signal (int signal_num
, __sigfun signal_func
)
1774 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
1776 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
1777 #else /* not __MRC__ and not __MWERKS__ */
1779 #endif /* not __MRC__ and not __MWERKS__ */
1781 if (signal_num
!= SIGALRM
)
1782 return signal (signal_num
, signal_func
);
1786 __sigfun old_signal_func
;
1788 __signal_func_ptr old_signal_func
;
1792 old_signal_func
= alarm_signal_func
;
1793 alarm_signal_func
= signal_func
;
1794 return old_signal_func
;
1800 mac_atimer_handler (qlink
)
1803 if (alarm_signal_func
)
1804 (alarm_signal_func
) (SIGALRM
);
1809 set_mac_atimer (count
)
1812 static TimerUPP mac_atimer_handlerUPP
= NULL
;
1814 if (mac_atimer_handlerUPP
== NULL
)
1815 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
1816 mac_atimer_task
.tmCount
= 0;
1817 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
1818 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
1819 InsTime (mac_atimer_qlink
);
1821 PrimeTime (mac_atimer_qlink
, count
);
1826 remove_mac_atimer (remaining_count
)
1827 long *remaining_count
;
1829 if (mac_atimer_qlink
)
1831 RmvTime (mac_atimer_qlink
);
1832 if (remaining_count
)
1833 *remaining_count
= mac_atimer_task
.tmCount
;
1834 mac_atimer_qlink
= NULL
;
1846 int old_mask
= signal_mask
;
1848 signal_mask
|= mask
;
1850 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
1851 remove_mac_atimer (NULL
);
1858 sigsetmask (int mask
)
1860 int old_mask
= signal_mask
;
1864 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
1865 if (signal_mask
& sigmask (SIGALRM
))
1866 remove_mac_atimer (NULL
);
1868 set_mac_atimer (mac_atimer_task
.tmCount
);
1877 long remaining_count
;
1879 if (remove_mac_atimer (&remaining_count
) == 0)
1881 set_mac_atimer (seconds
* 1000);
1883 return remaining_count
/ 1000;
1887 mac_atimer_task
.tmCount
= seconds
* 1000;
1895 setitimer (which
, value
, ovalue
)
1897 const struct itimerval
*value
;
1898 struct itimerval
*ovalue
;
1900 long remaining_count
;
1901 long count
= (EMACS_SECS (value
->it_value
) * 1000
1902 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
1904 if (remove_mac_atimer (&remaining_count
) == 0)
1908 bzero (ovalue
, sizeof (*ovalue
));
1909 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
1910 (remaining_count
% 1000) * 1000);
1912 set_mac_atimer (count
);
1915 mac_atimer_task
.tmCount
= count
;
1921 /* gettimeofday should return the amount of time (in a timeval
1922 structure) since midnight today. The toolbox function Microseconds
1923 returns the number of microseconds (in a UnsignedWide value) since
1924 the machine was booted. Also making this complicated is WideAdd,
1925 WideSubtract, etc. take wide values. */
1932 static wide wall_clock_at_epoch
, clicks_at_epoch
;
1933 UnsignedWide uw_microseconds
;
1934 wide w_microseconds
;
1935 time_t sys_time (time_t *);
1937 /* If this function is called for the first time, record the number
1938 of seconds since midnight and the number of microseconds since
1939 boot at the time of this first call. */
1944 systime
= sys_time (NULL
);
1945 /* Store microseconds since midnight in wall_clock_at_epoch. */
1946 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
1947 Microseconds (&uw_microseconds
);
1948 /* Store microseconds since boot in clicks_at_epoch. */
1949 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
1950 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
1953 /* Get time since boot */
1954 Microseconds (&uw_microseconds
);
1956 /* Convert to time since midnight*/
1957 w_microseconds
.hi
= uw_microseconds
.hi
;
1958 w_microseconds
.lo
= uw_microseconds
.lo
;
1959 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
1960 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
1961 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
1969 sleep (unsigned int seconds
)
1971 unsigned long time_up
;
1974 time_up
= TickCount () + seconds
* 60;
1975 while (TickCount () < time_up
)
1977 /* Accept no event; just wait. by T.I. */
1978 WaitNextEvent (0, &e
, 30, NULL
);
1983 #endif /* __MRC__ */
1986 /* The time functions adjust time values according to the difference
1987 between the Unix and CW epoches. */
1990 extern struct tm
*gmtime (const time_t *);
1992 sys_gmtime (const time_t *timer
)
1994 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1996 return gmtime (&unix_time
);
2001 extern struct tm
*localtime (const time_t *);
2003 sys_localtime (const time_t *timer
)
2005 #if __MSL__ >= 0x6000
2006 time_t unix_time
= *timer
;
2008 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2011 return localtime (&unix_time
);
2016 extern char *ctime (const time_t *);
2018 sys_ctime (const time_t *timer
)
2020 #if __MSL__ >= 0x6000
2021 time_t unix_time
= *timer
;
2023 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2026 return ctime (&unix_time
);
2031 extern time_t time (time_t *);
2033 sys_time (time_t *timer
)
2035 #if __MSL__ >= 0x6000
2036 time_t mac_time
= time (NULL
);
2038 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2048 /* no subprocesses, empty wait */
2058 croak (char *badfunc
)
2060 printf ("%s not yet implemented\r\n", badfunc
);
2066 mktemp (char *template)
2071 len
= strlen (template);
2073 while (k
>= 0 && template[k
] == 'X')
2076 k
++; /* make k index of first 'X' */
2080 /* Zero filled, number of digits equal to the number of X's. */
2081 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2090 /* Emulate getpwuid, getpwnam and others. */
2092 #define PASSWD_FIELD_SIZE 256
2094 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2095 static char my_passwd_dir
[MAXPATHLEN
+1];
2097 static struct passwd my_passwd
=
2103 static struct group my_group
=
2105 /* There are no groups on the mac, so we just return "root" as the
2111 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2113 char emacs_passwd_dir
[MAXPATHLEN
+1];
2119 init_emacs_passwd_dir ()
2123 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2125 /* Need pathname of first ancestor that begins with "emacs"
2126 since Mac emacs application is somewhere in the emacs-*
2128 int len
= strlen (emacs_passwd_dir
);
2130 /* j points to the "/" following the directory name being
2133 while (i
>= 0 && !found
)
2135 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2137 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2138 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2140 emacs_passwd_dir
[j
+1] = '\0';
2151 /* Setting to "/" probably won't work but set it to something
2153 strcpy (emacs_passwd_dir
, "/");
2154 strcpy (my_passwd_dir
, "/");
2159 static struct passwd emacs_passwd
=
2165 static int my_passwd_inited
= 0;
2173 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2174 directory where Emacs was started. */
2176 owner_name
= (char **) GetResource ('STR ',-16096);
2180 BlockMove ((unsigned char *) *owner_name
,
2181 (unsigned char *) my_passwd_name
,
2183 HUnlock (owner_name
);
2184 p2cstr ((unsigned char *) my_passwd_name
);
2187 my_passwd_name
[0] = 0;
2192 getpwuid (uid_t uid
)
2194 if (!my_passwd_inited
)
2197 my_passwd_inited
= 1;
2205 getgrgid (gid_t gid
)
2212 getpwnam (const char *name
)
2214 if (strcmp (name
, "emacs") == 0)
2215 return &emacs_passwd
;
2217 if (!my_passwd_inited
)
2220 my_passwd_inited
= 1;
2227 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2228 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2249 error ("Can't spawn subshell");
2254 request_sigio (void)
2260 unrequest_sigio (void)
2275 pipe (int _fildes
[2])
2282 /* Hard and symbolic links. */
2285 symlink (const char *name1
, const char *name2
)
2293 link (const char *name1
, const char *name2
)
2299 #endif /* ! MAC_OSX */
2301 /* Determine the path name of the file specified by VREFNUM, DIRID,
2302 and NAME and place that in the buffer PATH of length
2305 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2306 long dir_id
, ConstStr255Param name
)
2312 if (strlen (name
) > man_path_len
)
2315 memcpy (dir_name
, name
, name
[0]+1);
2316 memcpy (path
, name
, name
[0]+1);
2319 cipb
.dirInfo
.ioDrParID
= dir_id
;
2320 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2324 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2325 cipb
.dirInfo
.ioFDirIndex
= -1;
2326 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2327 /* go up to parent each time */
2329 err
= PBGetCatInfo (&cipb
, false);
2334 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2337 strcat (dir_name
, ":");
2338 strcat (dir_name
, path
);
2339 /* attach to front since we're going up directory tree */
2340 strcpy (path
, dir_name
);
2342 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2343 /* stop when we see the volume's root directory */
2345 return 1; /* success */
2350 posix_pathname_to_fsspec (ufn
, fs
)
2354 Str255 mac_pathname
;
2356 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2360 c2pstr (mac_pathname
);
2361 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2366 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2371 char mac_pathname
[MAXPATHLEN
];
2373 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2374 fs
->vRefNum
, fs
->parID
, fs
->name
)
2375 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2384 readlink (const char *path
, char *buf
, int bufsiz
)
2386 char mac_sym_link_name
[MAXPATHLEN
+1];
2389 Boolean target_is_folder
, was_aliased
;
2390 Str255 directory_name
, mac_pathname
;
2393 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2396 c2pstr (mac_sym_link_name
);
2397 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2404 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2405 if (err
!= noErr
|| !was_aliased
)
2411 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2418 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2424 return strlen (buf
);
2428 /* Convert a path to one with aliases fully expanded. */
2431 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2433 char *q
, temp
[MAXPATHLEN
+1];
2437 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2444 q
= strchr (p
+ 1, '/');
2446 q
= strchr (p
, '/');
2447 len
= 0; /* loop may not be entered, e.g., for "/" */
2452 strncat (temp
, p
, q
- p
);
2453 len
= readlink (temp
, buf
, bufsiz
);
2456 if (strlen (temp
) + 1 > bufsiz
)
2466 if (len
+ strlen (p
) + 1 >= bufsiz
)
2470 return len
+ strlen (p
);
2475 umask (mode_t numask
)
2477 static mode_t mask
= 022;
2478 mode_t oldmask
= mask
;
2485 chmod (const char *path
, mode_t mode
)
2487 /* say it always succeed for now */
2496 return fcntl (oldd
, F_DUPFD
, 0);
2498 /* current implementation of fcntl in fcntl.mac.c simply returns old
2500 return fcntl (oldd
, F_DUPFD
);
2507 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2508 newd if it already exists. Then, attempt to dup oldd. If not
2509 successful, call dup2 recursively until we are, then close the
2510 unsuccessful ones. */
2513 dup2 (int oldd
, int newd
)
2524 ret
= dup2 (oldd
, newd
);
2530 /* let it fail for now */
2547 ioctl (int d
, int request
, void *argp
)
2557 if (fildes
>=0 && fildes
<= 2)
2590 #endif /* __MRC__ */
2594 #if __MSL__ < 0x6000
2602 #endif /* __MWERKS__ */
2604 #endif /* ! MAC_OSX */
2607 /* Return the path to the directory in which Emacs can create
2608 temporary files. The MacOS "temporary items" directory cannot be
2609 used because it removes the file written by a process when it
2610 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2611 again not exactly). And of course Emacs needs to read back the
2612 files written by its subprocesses. So here we write the files to a
2613 directory "Emacs" in the Preferences Folder. This directory is
2614 created if it does not exist. */
2617 get_temp_dir_name ()
2619 static char *temp_dir_name
= NULL
;
2623 Str255 dir_name
, full_path
;
2625 char unix_dir_name
[MAXPATHLEN
+1];
2628 /* Cache directory name with pointer temp_dir_name.
2629 Look for it only the first time. */
2632 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2633 &vol_ref_num
, &dir_id
);
2637 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2640 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2641 strcat (full_path
, "Emacs:");
2645 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2648 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2651 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2654 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2655 strcpy (temp_dir_name
, unix_dir_name
);
2658 return temp_dir_name
;
2663 /* Allocate and construct an array of pointers to strings from a list
2664 of strings stored in a 'STR#' resource. The returned pointer array
2665 is stored in the style of argv and environ: if the 'STR#' resource
2666 contains numString strings, a pointer array with numString+1
2667 elements is returned in which the last entry contains a null
2668 pointer. The pointer to the pointer array is passed by pointer in
2669 parameter t. The resource ID of the 'STR#' resource is passed in
2670 parameter StringListID.
2674 get_string_list (char ***t
, short string_list_id
)
2680 h
= GetResource ('STR#', string_list_id
);
2685 num_strings
= * (short *) p
;
2687 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2688 for (i
= 0; i
< num_strings
; i
++)
2690 short length
= *p
++;
2691 (*t
)[i
] = (char *) malloc (length
+ 1);
2692 strncpy ((*t
)[i
], p
, length
);
2693 (*t
)[i
][length
] = '\0';
2696 (*t
)[num_strings
] = 0;
2701 /* Return no string in case GetResource fails. Bug fixed by
2702 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2703 option (no sym -on implies -opt local). */
2704 *t
= (char **) malloc (sizeof (char *));
2711 get_path_to_system_folder ()
2716 Str255 dir_name
, full_path
;
2718 static char system_folder_unix_name
[MAXPATHLEN
+1];
2721 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2722 &vol_ref_num
, &dir_id
);
2726 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2729 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2733 return system_folder_unix_name
;
2739 #define ENVIRON_STRING_LIST_ID 128
2741 /* Get environment variable definitions from STR# resource. */
2748 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2754 /* Make HOME directory the one Emacs starts up in if not specified
2756 if (getenv ("HOME") == NULL
)
2758 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2761 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2764 strcpy (environ
[i
], "HOME=");
2765 strcat (environ
[i
], my_passwd_dir
);
2772 /* Make HOME directory the one Emacs starts up in if not specified
2774 if (getenv ("MAIL") == NULL
)
2776 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2779 char * path_to_system_folder
= get_path_to_system_folder ();
2780 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2783 strcpy (environ
[i
], "MAIL=");
2784 strcat (environ
[i
], path_to_system_folder
);
2785 strcat (environ
[i
], "Eudora Folder/In");
2793 /* Return the value of the environment variable NAME. */
2796 getenv (const char *name
)
2798 int length
= strlen(name
);
2801 for (e
= environ
; *e
!= 0; e
++)
2802 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2803 return &(*e
)[length
+ 1];
2805 if (strcmp (name
, "TMPDIR") == 0)
2806 return get_temp_dir_name ();
2813 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2814 char *sys_siglist
[] =
2816 "Zero is not a signal!!!",
2818 "Interactive user interrupt", /* 2 */ "?",
2819 "Floating point exception", /* 4 */ "?", "?", "?",
2820 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2821 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2822 "?", "?", "?", "?", "?", "?", "?", "?",
2826 char *sys_siglist
[] =
2828 "Zero is not a signal!!!",
2830 "Floating point exception",
2831 "Illegal instruction",
2832 "Interactive user interrupt",
2833 "Segment violation",
2836 #else /* not __MRC__ and not __MWERKS__ */
2838 #endif /* not __MRC__ and not __MWERKS__ */
2841 #include <utsname.h>
2844 uname (struct utsname
*name
)
2847 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2850 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2851 p2cstr (name
->nodename
);
2859 /* Event class of HLE sent to subprocess. */
2860 const OSType kEmacsSubprocessSend
= 'ESND';
2862 /* Event class of HLE sent back from subprocess. */
2863 const OSType kEmacsSubprocessReply
= 'ERPY';
2867 mystrchr (char *s
, char c
)
2869 while (*s
&& *s
!= c
)
2897 mystrcpy (char *to
, char *from
)
2909 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2910 terminated). The process should run with the default directory
2911 "workdir", read input from "infn", and write output and error to
2912 "outfn" and "errfn", resp. The Process Manager call
2913 LaunchApplication is used to start the subprocess. We use high
2914 level events as the mechanism to pass arguments to the subprocess
2915 and to make Emacs wait for the subprocess to terminate and pass
2916 back a result code. The bulk of the code here packs the arguments
2917 into one message to be passed together with the high level event.
2918 Emacs also sometimes starts a subprocess using a shell to perform
2919 wildcard filename expansion. Since we don't really have a shell on
2920 the Mac, this case is detected and the starting of the shell is
2921 by-passed. We really need to add code here to do filename
2922 expansion to support such functionality. */
2925 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2926 unsigned char **argv
;
2927 const char *workdir
;
2928 const char *infn
, *outfn
, *errfn
;
2930 #if TARGET_API_MAC_CARBON
2932 #else /* not TARGET_API_MAC_CARBON */
2933 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2934 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2935 int paramlen
, argc
, newargc
, j
, retries
;
2936 char **newargv
, *param
, *p
;
2939 LaunchParamBlockRec lpbr
;
2940 EventRecord send_event
, reply_event
;
2941 RgnHandle cursor_region_handle
;
2943 unsigned long ref_con
, len
;
2945 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2947 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2949 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2951 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2954 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2955 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2964 /* If a subprocess is invoked with a shell, we receive 3 arguments
2965 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2966 bins>/<command> <command args>" */
2967 j
= strlen (argv
[0]);
2968 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2969 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2971 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2973 /* The arguments for the command in argv[2] are separated by
2974 spaces. Count them and put the count in newargc. */
2975 command
= (char *) alloca (strlen (argv
[2])+2);
2976 strcpy (command
, argv
[2]);
2977 if (command
[strlen (command
) - 1] != ' ')
2978 strcat (command
, " ");
2982 t
= mystrchr (t
, ' ');
2986 t
= mystrchr (t
+1, ' ');
2989 newargv
= (char **) alloca (sizeof (char *) * newargc
);
2992 for (j
= 0; j
< newargc
; j
++)
2994 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
2995 mystrcpy (newargv
[j
], t
);
2998 paramlen
+= strlen (newargv
[j
]) + 1;
3001 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3003 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3008 { /* sometimes Emacs call "sh" without a path for the command */
3010 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3011 strcpy (t
, "~emacs/");
3012 strcat (t
, newargv
[0]);
3015 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3016 make_number (X_OK
));
3020 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3024 strcpy (macappname
, tempmacpathname
);
3028 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3031 newargv
= (char **) alloca (sizeof (char *) * argc
);
3033 for (j
= 1; j
< argc
; j
++)
3035 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3037 char *t
= strchr (argv
[j
], ' ');
3040 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3041 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3042 tempcmdname
[t
-argv
[j
]] = '\0';
3043 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3046 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3048 strcpy (newargv
[j
], tempmaccmdname
);
3049 strcat (newargv
[j
], t
);
3053 char tempmaccmdname
[MAXPATHLEN
+1];
3054 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3057 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3058 strcpy (newargv
[j
], tempmaccmdname
);
3062 newargv
[j
] = argv
[j
];
3063 paramlen
+= strlen (newargv
[j
]) + 1;
3067 /* After expanding all the arguments, we now know the length of the
3068 parameter block to be sent to the subprocess as a message
3069 attached to the HLE. */
3070 param
= (char *) malloc (paramlen
+ 1);
3076 /* first byte of message contains number of arguments for command */
3077 strcpy (p
, macworkdir
);
3078 p
+= strlen (macworkdir
);
3080 /* null terminate strings sent so it's possible to use strcpy over there */
3081 strcpy (p
, macinfn
);
3082 p
+= strlen (macinfn
);
3084 strcpy (p
, macoutfn
);
3085 p
+= strlen (macoutfn
);
3087 strcpy (p
, macerrfn
);
3088 p
+= strlen (macerrfn
);
3090 for (j
= 1; j
< newargc
; j
++)
3092 strcpy (p
, newargv
[j
]);
3093 p
+= strlen (newargv
[j
]);
3097 c2pstr (macappname
);
3099 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3107 lpbr
.launchBlockID
= extendedBlock
;
3108 lpbr
.launchEPBLength
= extendedBlockLen
;
3109 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3110 lpbr
.launchAppSpec
= &spec
;
3111 lpbr
.launchAppParameters
= NULL
;
3113 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3120 send_event
.what
= kHighLevelEvent
;
3121 send_event
.message
= kEmacsSubprocessSend
;
3122 /* Event ID stored in "where" unused */
3125 /* OS may think current subprocess has terminated if previous one
3126 terminated recently. */
3129 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3130 paramlen
+ 1, receiverIDisPSN
);
3132 while (iErr
== sessClosedErr
&& retries
-- > 0);
3140 cursor_region_handle
= NewRgn ();
3142 /* Wait for the subprocess to finish, when it will send us a ERPY
3143 high level event. */
3145 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3146 cursor_region_handle
)
3147 && reply_event
.message
== kEmacsSubprocessReply
)
3150 /* The return code is sent through the refCon */
3151 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3154 DisposeHandle ((Handle
) cursor_region_handle
);
3159 DisposeHandle ((Handle
) cursor_region_handle
);
3163 #endif /* not TARGET_API_MAC_CARBON */
3168 opendir (const char *dirname
)
3170 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3171 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3175 int len
, vol_name_len
;
3177 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3180 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3182 fully_resolved_name
[len
] = '\0';
3184 strcpy (fully_resolved_name
, true_pathname
);
3186 dirp
= (DIR *) malloc (sizeof(DIR));
3190 /* Handle special case when dirname is "/": sets up for readir to
3191 get all mount volumes. */
3192 if (strcmp (fully_resolved_name
, "/") == 0)
3194 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3195 dirp
->current_index
= 1; /* index for first volume */
3199 /* Handle typical cases: not accessing all mounted volumes. */
3200 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3203 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3204 len
= strlen (mac_pathname
);
3205 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3206 strcat (mac_pathname
, ":");
3208 /* Extract volume name */
3209 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3210 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3211 vol_name
[vol_name_len
] = '\0';
3212 strcat (vol_name
, ":");
3214 c2pstr (mac_pathname
);
3215 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3216 /* using full pathname so vRefNum and DirID ignored */
3217 cipb
.hFileInfo
.ioVRefNum
= 0;
3218 cipb
.hFileInfo
.ioDirID
= 0;
3219 cipb
.hFileInfo
.ioFDirIndex
= 0;
3220 /* set to 0 to get information about specific dir or file */
3222 errno
= PBGetCatInfo (&cipb
, false);
3229 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3230 return 0; /* not a directory */
3232 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3233 dirp
->getting_volumes
= 0;
3234 dirp
->current_index
= 1; /* index for first file/directory */
3237 vpb
.ioNamePtr
= vol_name
;
3238 /* using full pathname so vRefNum and DirID ignored */
3240 vpb
.ioVolIndex
= -1;
3241 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3248 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3265 HParamBlockRec hpblock
;
3267 static struct dirent s_dirent
;
3268 static Str255 s_name
;
3272 /* Handle the root directory containing the mounted volumes. Call
3273 PBHGetVInfo specifying an index to obtain the info for a volume.
3274 PBHGetVInfo returns an error when it receives an index beyond the
3275 last volume, at which time we should return a nil dirent struct
3277 if (dp
->getting_volumes
)
3279 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3280 hpblock
.volumeParam
.ioVRefNum
= 0;
3281 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3283 errno
= PBHGetVInfo (&hpblock
, false);
3291 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3293 dp
->current_index
++;
3295 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3296 s_dirent
.d_name
= s_name
;
3302 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3303 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3304 /* location to receive filename returned */
3306 /* return only visible files */
3310 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3311 /* directory ID found by opendir */
3312 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3314 errno
= PBGetCatInfo (&cipb
, false);
3321 /* insist on a visible entry */
3322 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3323 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3325 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3327 dp
->current_index
++;
3340 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3341 /* value unimportant: non-zero for valid file */
3342 s_dirent
.d_name
= s_name
;
3352 char mac_pathname
[MAXPATHLEN
+1];
3353 Str255 directory_name
;
3357 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3360 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3366 #endif /* ! MAC_OSX */
3370 initialize_applescript ()
3375 /* if open fails, as_scripting_component is set to NULL. Its
3376 subsequent use in OSA calls will fail with badComponentInstance
3378 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3379 kAppleScriptSubtype
);
3381 null_desc
.descriptorType
= typeNull
;
3382 null_desc
.dataHandle
= 0;
3383 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3384 kOSANullScript
, &as_script_context
);
3386 as_script_context
= kOSANullScript
;
3387 /* use default context if create fails */
3391 void terminate_applescript()
3393 OSADispose (as_scripting_component
, as_script_context
);
3394 CloseComponent (as_scripting_component
);
3398 /* Compile and execute the AppleScript SCRIPT and return the error
3399 status as function value. A zero is returned if compilation and
3400 execution is successful, in which case RESULT returns a pointer to
3401 a string containing the resulting script value. Otherwise, the Mac
3402 error code is returned and RESULT returns a pointer to an error
3403 string. In both cases the caller should deallocate the storage
3404 used by the string pointed to by RESULT if it is non-NULL. For
3405 documentation on the MacOS scripting architecture, see Inside
3406 Macintosh - Interapplication Communications: Scripting Components. */
3409 do_applescript (char *script
, char **result
)
3411 AEDesc script_desc
, result_desc
, error_desc
;
3418 if (!as_scripting_component
)
3419 initialize_applescript();
3421 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3425 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3426 typeChar
, kOSAModeNull
, &result_desc
);
3428 if (osaerror
== errOSAScriptError
)
3430 /* error executing AppleScript: retrieve error message */
3431 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3434 #if TARGET_API_MAC_CARBON
3435 length
= AEGetDescDataSize (&error_desc
);
3436 *result
= (char *) xmalloc (length
+ 1);
3439 AEGetDescData (&error_desc
, *result
, length
);
3440 *(*result
+ length
) = '\0';
3442 #else /* not TARGET_API_MAC_CARBON */
3443 HLock (error_desc
.dataHandle
);
3444 length
= GetHandleSize(error_desc
.dataHandle
);
3445 *result
= (char *) xmalloc (length
+ 1);
3448 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3449 *(*result
+ length
) = '\0';
3451 HUnlock (error_desc
.dataHandle
);
3452 #endif /* not TARGET_API_MAC_CARBON */
3453 AEDisposeDesc (&error_desc
);
3456 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3458 #if TARGET_API_MAC_CARBON
3459 length
= AEGetDescDataSize (&result_desc
);
3460 *result
= (char *) xmalloc (length
+ 1);
3463 AEGetDescData (&result_desc
, *result
, length
);
3464 *(*result
+ length
) = '\0';
3466 #else /* not TARGET_API_MAC_CARBON */
3467 HLock (result_desc
.dataHandle
);
3468 length
= GetHandleSize(result_desc
.dataHandle
);
3469 *result
= (char *) xmalloc (length
+ 1);
3472 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3473 *(*result
+ length
) = '\0';
3475 HUnlock (result_desc
.dataHandle
);
3476 #endif /* not TARGET_API_MAC_CARBON */
3477 AEDisposeDesc (&result_desc
);
3480 AEDisposeDesc (&script_desc
);
3486 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3487 doc
: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
3488 If compilation and execution are successful, the resulting script
3489 value is returned as a string. Otherwise the function aborts and
3490 displays the error message returned by the AppleScript scripting
3495 char *result
, *temp
;
3496 Lisp_Object lisp_result
;
3499 CHECK_STRING (script
);
3502 status
= do_applescript (SDATA (script
), &result
);
3507 error ("AppleScript error %d", status
);
3510 /* Unfortunately only OSADoScript in do_applescript knows how
3511 how large the resulting script value or error message is
3512 going to be and therefore as caller memory must be
3513 deallocated here. It is necessary to free the error
3514 message before calling error to avoid a memory leak. */
3515 temp
= (char *) alloca (strlen (result
) + 1);
3516 strcpy (temp
, result
);
3523 lisp_result
= build_string (result
);
3530 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3531 Smac_file_name_to_posix
, 1, 1, 0,
3532 doc
: /* Convert Macintosh filename to Posix form. */)
3534 Lisp_Object mac_filename
;
3536 char posix_filename
[MAXPATHLEN
+1];
3538 CHECK_STRING (mac_filename
);
3540 if (mac_to_posix_pathname (SDATA (mac_filename
), posix_filename
,
3542 return build_string (posix_filename
);
3548 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3549 Sposix_file_name_to_mac
, 1, 1, 0,
3550 doc
: /* Convert Posix filename to Mac form. */)
3552 Lisp_Object posix_filename
;
3554 char mac_filename
[MAXPATHLEN
+1];
3556 CHECK_STRING (posix_filename
);
3558 if (posix_to_mac_pathname (SDATA (posix_filename
), mac_filename
,
3560 return build_string (mac_filename
);
3566 #if TARGET_API_MAC_CARBON
3567 static Lisp_Object Qxml
, Qmime_charset
;
3568 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
3570 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3571 doc
: /* Return the application preference value for KEY.
3572 KEY is either a string specifying a preference key, or a list of key
3573 strings. If it is a list, the (i+1)-th element is used as a key for
3574 the CFDictionary value obtained by the i-th element. If lookup is
3575 failed at some stage, nil is returned.
3577 Optional arg APPLICATION is an application ID string. If omitted or
3578 nil, that stands for the current application.
3580 Optional arg FORMAT specifies the data format of the return value. If
3581 omitted or nil, each Core Foundation object is converted into a
3582 corresponding Lisp object as follows:
3584 Core Foundation Lisp Tag
3585 ------------------------------------------------------------
3586 CFString Multibyte string string
3587 CFNumber Integer or float number
3588 CFBoolean Symbol (t or nil) boolean
3589 CFDate List of three integers date
3590 (cf. `current-time')
3591 CFData Unibyte string data
3592 CFArray Vector array
3593 CFDictionary Alist or hash table dictionary
3594 (depending on HASH-BOUND)
3596 If it is t, a symbol that represents the type of the original Core
3597 Foundation object is prepended. If it is `xml', the value is returned
3598 as an XML representation.
3600 Optional arg HASH-BOUND specifies which kinds of the list objects,
3601 alists or hash tables, are used as the targets of the conversion from
3602 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3603 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3604 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3606 (key
, application
, format
, hash_bound
)
3607 Lisp_Object key
, application
, format
, hash_bound
;
3609 CFStringRef app_id
, key_str
;
3610 CFPropertyListRef app_plist
= NULL
, plist
;
3611 Lisp_Object result
= Qnil
, tmp
;
3614 key
= Fcons (key
, Qnil
);
3618 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3619 CHECK_STRING_CAR (tmp
);
3621 wrong_type_argument (Qlistp
, key
);
3623 if (!NILP (application
))
3624 CHECK_STRING (application
);
3625 CHECK_SYMBOL (format
);
3626 if (!NILP (hash_bound
))
3627 CHECK_NUMBER (hash_bound
);
3631 app_id
= kCFPreferencesCurrentApplication
;
3632 if (!NILP (application
))
3634 app_id
= cfstring_create_with_string (application
);
3638 key_str
= cfstring_create_with_string (XCAR (key
));
3639 if (key_str
== NULL
)
3641 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3642 CFRelease (key_str
);
3643 if (app_plist
== NULL
)
3647 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3649 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3651 key_str
= cfstring_create_with_string (XCAR (key
));
3652 if (key_str
== NULL
)
3654 plist
= CFDictionaryGetValue (plist
, key_str
);
3655 CFRelease (key_str
);
3661 if (EQ (format
, Qxml
))
3663 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3666 result
= cfdata_to_lisp (data
);
3671 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3672 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3676 CFRelease (app_plist
);
3685 static CFStringEncoding
3686 get_cfstring_encoding_from_lisp (obj
)
3689 CFStringRef iana_name
;
3690 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
3695 if (SYMBOLP (obj
) && !NILP (obj
) && !NILP (Fcoding_system_p (obj
)))
3697 Lisp_Object coding_spec
, plist
;
3699 coding_spec
= Fget (obj
, Qcoding_system
);
3700 plist
= XVECTOR (coding_spec
)->contents
[3];
3701 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
3705 obj
= SYMBOL_NAME (obj
);
3709 iana_name
= cfstring_create_with_string (obj
);
3712 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
3713 CFRelease (iana_name
);
3720 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
3722 cfstring_create_normalized (str
, symbol
)
3727 TextEncodingVariant variant
;
3728 float initial_mag
= 0.0;
3729 CFStringRef result
= NULL
;
3731 if (EQ (symbol
, QNFD
))
3732 form
= kCFStringNormalizationFormD
;
3733 else if (EQ (symbol
, QNFKD
))
3734 form
= kCFStringNormalizationFormKD
;
3735 else if (EQ (symbol
, QNFC
))
3736 form
= kCFStringNormalizationFormC
;
3737 else if (EQ (symbol
, QNFKC
))
3738 form
= kCFStringNormalizationFormKC
;
3739 else if (EQ (symbol
, QHFS_plus_D
))
3741 variant
= kUnicodeHFSPlusDecompVariant
;
3744 else if (EQ (symbol
, QHFS_plus_C
))
3746 variant
= kUnicodeHFSPlusCompVariant
;
3752 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
3756 CFStringNormalize (mut_str
, form
);
3760 else if (initial_mag
> 0.0)
3762 UnicodeToTextInfo uni
= NULL
;
3765 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
3767 ByteCount out_read
, out_size
, out_len
;
3769 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
3771 kTextEncodingDefaultFormat
);
3772 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
3774 kTextEncodingDefaultFormat
);
3775 map
.mappingVersion
= kUnicodeUseLatestMapping
;
3777 length
= CFStringGetLength (str
);
3778 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
3782 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
3783 if (in_text
== NULL
)
3785 buffer
= xmalloc (sizeof (UniChar
) * length
);
3788 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
3794 err
= CreateUnicodeToTextInfo(&map
, &uni
);
3795 while (err
== noErr
)
3797 out_buf
= xmalloc (out_size
);
3798 if (out_buf
== NULL
)
3801 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
3803 kUnicodeDefaultDirectionMask
,
3804 0, NULL
, NULL
, NULL
,
3805 out_size
, &out_read
, &out_len
,
3807 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
3816 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
3817 out_len
/ sizeof (UniChar
));
3819 DisposeUnicodeToTextInfo (&uni
);
3835 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
3836 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
3837 The conversion is performed using the converter provided by the system.
3838 Each encoding is specified by either a coding system symbol, a mime
3839 charset string, or an integer as a CFStringEncoding value.
3840 On Mac OS X 10.2 and later, you can do Unicode Normalization by
3841 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
3842 NFKD, NFC, NFKC, HFS+D, or HFS+C.
3843 On successful conversion, returns the result string, else returns
3845 (string
, source
, target
, normalization_form
)
3846 Lisp_Object string
, source
, target
, normalization_form
;
3848 Lisp_Object result
= Qnil
;
3849 CFStringEncoding src_encoding
, tgt_encoding
;
3850 CFStringRef str
= NULL
;
3851 CFDataRef data
= NULL
;
3853 CHECK_STRING (string
);
3854 if (!INTEGERP (source
) && !STRINGP (source
))
3855 CHECK_SYMBOL (source
);
3856 if (!INTEGERP (target
) && !STRINGP (target
))
3857 CHECK_SYMBOL (target
);
3858 CHECK_SYMBOL (normalization_form
);
3862 src_encoding
= get_cfstring_encoding_from_lisp (source
);
3863 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
3865 string
= string_make_unibyte (string
);
3866 if (src_encoding
!= kCFStringEncodingInvalidId
3867 && tgt_encoding
!= kCFStringEncodingInvalidId
)
3868 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
3869 src_encoding
, true);
3870 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
3873 CFStringRef saved_str
= str
;
3875 str
= cfstring_create_normalized (saved_str
, normalization_form
);
3876 CFRelease (saved_str
);
3881 data
= CFStringCreateExternalRepresentation (NULL
, str
,
3882 tgt_encoding
, '\0');
3887 result
= cfdata_to_lisp (data
);
3895 #endif /* TARGET_API_MAC_CARBON */
3898 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
3899 doc
: /* Clear the font name table. */)
3903 mac_clear_font_name_table ();
3910 extern int inhibit_window_system
;
3911 extern int noninteractive
;
3913 /* Unlike in X11, window events in Carbon do not come from sockets.
3914 So we cannot simply use `select' to monitor two kinds of inputs:
3915 window events and process outputs. We emulate such functionality
3916 by regarding fd 0 as the window event channel and simultaneously
3917 monitoring both kinds of input channels. It is implemented by
3918 dividing into some cases:
3919 1. The window event channel is not involved.
3921 2. Sockets are not involved.
3922 -> Use ReceiveNextEvent.
3923 3. [If SELECT_USE_CFSOCKET is defined]
3924 Only the window event channel and socket read channels are
3925 involved, and timeout is not too short (greater than
3926 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
3927 -> Create CFSocket for each socket and add it into the current
3928 event RunLoop so that an `ready-to-read' event can be posted
3929 to the event queue that is also used for window events. Then
3930 ReceiveNextEvent can wait for both kinds of inputs.
3932 -> Periodically poll the window input channel while repeatedly
3933 executing `select' with a short timeout
3934 (SELECT_POLLING_PERIOD_USEC microseconds). */
3936 #define SELECT_POLLING_PERIOD_USEC 20000
3937 #ifdef SELECT_USE_CFSOCKET
3938 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
3939 #define EVENT_CLASS_SOCK 'Sock'
3942 socket_callback (s
, type
, address
, data
, info
)
3944 CFSocketCallBackType type
;
3951 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
3952 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
3953 ReleaseEvent (event
);
3955 #endif /* SELECT_USE_CFSOCKET */
3958 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
3963 struct timeval
*timeout
;
3968 r
= select (n
, rfds
, wfds
, efds
, timeout
);
3972 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
3973 kEventLeaveInQueue
, NULL
);
3984 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
3985 #undef SELECT_INVALIDATE_CFSOCKET
3989 sys_select (n
, rfds
, wfds
, efds
, timeout
)
3994 struct timeval
*timeout
;
3998 EMACS_TIME select_timeout
;
4000 if (inhibit_window_system
|| noninteractive
4001 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4002 return select (n
, rfds
, wfds
, efds
, timeout
);
4006 if (wfds
== NULL
&& efds
== NULL
)
4009 SELECT_TYPE orfds
= *rfds
;
4011 EventTimeout timeout_sec
=
4013 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4014 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4015 : kEventDurationForever
);
4017 for (i
= 1; i
< n
; i
++)
4018 if (FD_ISSET (i
, rfds
))
4024 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4025 kEventLeaveInQueue
, NULL
);
4036 /* Avoid initial overhead of RunLoop setup for the case that
4037 some input is already available. */
4038 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4039 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4040 if (r
!= 0 || timeout_sec
== 0.0)
4045 #ifdef SELECT_USE_CFSOCKET
4046 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4047 goto poll_periodically
;
4050 CFRunLoopRef runloop
=
4051 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4052 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4053 #ifdef SELECT_INVALIDATE_CFSOCKET
4054 CFSocketRef
*shead
, *s
;
4056 CFRunLoopSourceRef
*shead
, *s
;
4061 #ifdef SELECT_INVALIDATE_CFSOCKET
4062 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4064 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4067 for (i
= 1; i
< n
; i
++)
4068 if (FD_ISSET (i
, rfds
))
4070 CFSocketRef socket
=
4071 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4072 socket_callback
, NULL
);
4073 CFRunLoopSourceRef source
=
4074 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4076 #ifdef SELECT_INVALIDATE_CFSOCKET
4077 CFSocketSetSocketFlags (socket
, 0);
4079 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4080 #ifdef SELECT_INVALIDATE_CFSOCKET
4090 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4095 #ifdef SELECT_INVALIDATE_CFSOCKET
4096 CFSocketInvalidate (*s
);
4098 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4113 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4114 GetEventTypeCount (specs
),
4116 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4117 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4124 #endif /* SELECT_USE_CFSOCKET */
4129 EMACS_TIME end_time
, now
, remaining_time
;
4130 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4138 remaining_time
= *timeout
;
4139 EMACS_GET_TIME (now
);
4140 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4145 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4146 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4147 select_timeout
= remaining_time
;
4148 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4160 EMACS_GET_TIME (now
);
4161 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4164 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4175 /* Set up environment variables so that Emacs can correctly find its
4176 support files when packaged as an application bundle. Directories
4177 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4178 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4179 by `make install' by default can instead be placed in
4180 .../Emacs.app/Contents/Resources/ and
4181 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4182 is changed only if it is not already set. Presumably if the user
4183 sets an environment variable, he will want to use files in his path
4184 instead of ones in the application bundle. */
4186 init_mac_osx_environment ()
4190 CFStringRef cf_app_bundle_pathname
;
4191 int app_bundle_pathname_len
;
4192 char *app_bundle_pathname
;
4196 /* Fetch the pathname of the application bundle as a C string into
4197 app_bundle_pathname. */
4199 bundle
= CFBundleGetMainBundle ();
4203 bundleURL
= CFBundleCopyBundleURL (bundle
);
4207 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4208 kCFURLPOSIXPathStyle
);
4209 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4210 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4212 if (!CFStringGetCString (cf_app_bundle_pathname
,
4213 app_bundle_pathname
,
4214 app_bundle_pathname_len
+ 1,
4215 kCFStringEncodingISOLatin1
))
4217 CFRelease (cf_app_bundle_pathname
);
4221 CFRelease (cf_app_bundle_pathname
);
4223 /* P should have sufficient room for the pathname of the bundle plus
4224 the subpath in it leading to the respective directories. Q
4225 should have three times that much room because EMACSLOADPATH can
4226 have the value "<path to lisp dir>:<path to leim dir>:<path to
4228 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4229 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4230 if (!getenv ("EMACSLOADPATH"))
4234 strcpy (p
, app_bundle_pathname
);
4235 strcat (p
, "/Contents/Resources/lisp");
4236 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4239 strcpy (p
, app_bundle_pathname
);
4240 strcat (p
, "/Contents/Resources/leim");
4241 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4248 strcpy (p
, app_bundle_pathname
);
4249 strcat (p
, "/Contents/Resources/site-lisp");
4250 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4258 setenv ("EMACSLOADPATH", q
, 1);
4261 if (!getenv ("EMACSPATH"))
4265 strcpy (p
, app_bundle_pathname
);
4266 strcat (p
, "/Contents/MacOS/libexec");
4267 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4270 strcpy (p
, app_bundle_pathname
);
4271 strcat (p
, "/Contents/MacOS/bin");
4272 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4280 setenv ("EMACSPATH", q
, 1);
4283 if (!getenv ("EMACSDATA"))
4285 strcpy (p
, app_bundle_pathname
);
4286 strcat (p
, "/Contents/Resources/etc");
4287 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4288 setenv ("EMACSDATA", p
, 1);
4291 if (!getenv ("EMACSDOC"))
4293 strcpy (p
, app_bundle_pathname
);
4294 strcat (p
, "/Contents/Resources/etc");
4295 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4296 setenv ("EMACSDOC", p
, 1);
4299 if (!getenv ("INFOPATH"))
4301 strcpy (p
, app_bundle_pathname
);
4302 strcat (p
, "/Contents/Resources/info");
4303 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4304 setenv ("INFOPATH", p
, 1);
4307 #endif /* MAC_OSX */
4311 mac_get_system_locale ()
4319 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4320 region
= GetScriptManagerVariable (smRegionCode
);
4321 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4323 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4326 return build_string (str
);
4335 #if TARGET_API_MAC_CARBON
4336 Qstring
= intern ("string"); staticpro (&Qstring
);
4337 Qnumber
= intern ("number"); staticpro (&Qnumber
);
4338 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
4339 Qdate
= intern ("date"); staticpro (&Qdate
);
4340 Qdata
= intern ("data"); staticpro (&Qdata
);
4341 Qarray
= intern ("array"); staticpro (&Qarray
);
4342 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
4344 Qxml
= intern ("xml");
4347 Qmime_charset
= intern ("mime-charset");
4348 staticpro (&Qmime_charset
);
4350 QNFD
= intern ("NFD"); staticpro (&QNFD
);
4351 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
4352 QNFC
= intern ("NFC"); staticpro (&QNFC
);
4353 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
4354 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
4355 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
4358 #if TARGET_API_MAC_CARBON
4359 defsubr (&Smac_get_preference
);
4360 defsubr (&Smac_code_convert_string
);
4362 defsubr (&Smac_clear_font_name_table
);
4364 defsubr (&Sdo_applescript
);
4365 defsubr (&Smac_file_name_to_posix
);
4366 defsubr (&Sposix_file_name_to_mac
);
4368 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
4369 doc
: /* The system script code. */);
4370 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4372 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
4373 doc
: /* The system locale identifier string.
4374 This is not a POSIX locale ID, but an ICU locale ID. So encoding
4375 information is not included. */);
4376 Vmac_system_locale
= mac_get_system_locale ();
4379 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4380 (do not change this comment) */