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., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
32 #include "sysselect.h"
33 #include "blockinput.h"
39 #if !TARGET_API_MAC_CARBON
42 #include <TextUtils.h>
44 #include <Resources.h>
49 #include <AppleScript.h>
52 #include <Processes.h>
54 #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 */
2493 fchmod (int fd
, mode_t mode
)
2495 /* say it always succeed for now */
2501 fchown (int fd
, uid_t owner
, gid_t group
)
2503 /* say it always succeed for now */
2512 return fcntl (oldd
, F_DUPFD
, 0);
2514 /* current implementation of fcntl in fcntl.mac.c simply returns old
2516 return fcntl (oldd
, F_DUPFD
);
2523 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2524 newd if it already exists. Then, attempt to dup oldd. If not
2525 successful, call dup2 recursively until we are, then close the
2526 unsuccessful ones. */
2529 dup2 (int oldd
, int newd
)
2540 ret
= dup2 (oldd
, newd
);
2546 /* let it fail for now */
2563 ioctl (int d
, int request
, void *argp
)
2573 if (fildes
>=0 && fildes
<= 2)
2606 #endif /* __MRC__ */
2610 #if __MSL__ < 0x6000
2618 #endif /* __MWERKS__ */
2620 #endif /* ! MAC_OSX */
2623 /* Return the path to the directory in which Emacs can create
2624 temporary files. The MacOS "temporary items" directory cannot be
2625 used because it removes the file written by a process when it
2626 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2627 again not exactly). And of course Emacs needs to read back the
2628 files written by its subprocesses. So here we write the files to a
2629 directory "Emacs" in the Preferences Folder. This directory is
2630 created if it does not exist. */
2633 get_temp_dir_name ()
2635 static char *temp_dir_name
= NULL
;
2639 Str255 dir_name
, full_path
;
2641 char unix_dir_name
[MAXPATHLEN
+1];
2644 /* Cache directory name with pointer temp_dir_name.
2645 Look for it only the first time. */
2648 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2649 &vol_ref_num
, &dir_id
);
2653 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2656 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2657 strcat (full_path
, "Emacs:");
2661 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2664 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2667 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2670 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2671 strcpy (temp_dir_name
, unix_dir_name
);
2674 return temp_dir_name
;
2679 /* Allocate and construct an array of pointers to strings from a list
2680 of strings stored in a 'STR#' resource. The returned pointer array
2681 is stored in the style of argv and environ: if the 'STR#' resource
2682 contains numString strings, a pointer array with numString+1
2683 elements is returned in which the last entry contains a null
2684 pointer. The pointer to the pointer array is passed by pointer in
2685 parameter t. The resource ID of the 'STR#' resource is passed in
2686 parameter StringListID.
2690 get_string_list (char ***t
, short string_list_id
)
2696 h
= GetResource ('STR#', string_list_id
);
2701 num_strings
= * (short *) p
;
2703 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2704 for (i
= 0; i
< num_strings
; i
++)
2706 short length
= *p
++;
2707 (*t
)[i
] = (char *) malloc (length
+ 1);
2708 strncpy ((*t
)[i
], p
, length
);
2709 (*t
)[i
][length
] = '\0';
2712 (*t
)[num_strings
] = 0;
2717 /* Return no string in case GetResource fails. Bug fixed by
2718 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2719 option (no sym -on implies -opt local). */
2720 *t
= (char **) malloc (sizeof (char *));
2727 get_path_to_system_folder ()
2732 Str255 dir_name
, full_path
;
2734 static char system_folder_unix_name
[MAXPATHLEN
+1];
2737 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2738 &vol_ref_num
, &dir_id
);
2742 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2745 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2749 return system_folder_unix_name
;
2755 #define ENVIRON_STRING_LIST_ID 128
2757 /* Get environment variable definitions from STR# resource. */
2764 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2770 /* Make HOME directory the one Emacs starts up in if not specified
2772 if (getenv ("HOME") == NULL
)
2774 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2777 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2780 strcpy (environ
[i
], "HOME=");
2781 strcat (environ
[i
], my_passwd_dir
);
2788 /* Make HOME directory the one Emacs starts up in if not specified
2790 if (getenv ("MAIL") == NULL
)
2792 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2795 char * path_to_system_folder
= get_path_to_system_folder ();
2796 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2799 strcpy (environ
[i
], "MAIL=");
2800 strcat (environ
[i
], path_to_system_folder
);
2801 strcat (environ
[i
], "Eudora Folder/In");
2809 /* Return the value of the environment variable NAME. */
2812 getenv (const char *name
)
2814 int length
= strlen(name
);
2817 for (e
= environ
; *e
!= 0; e
++)
2818 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2819 return &(*e
)[length
+ 1];
2821 if (strcmp (name
, "TMPDIR") == 0)
2822 return get_temp_dir_name ();
2829 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2830 char *sys_siglist
[] =
2832 "Zero is not a signal!!!",
2834 "Interactive user interrupt", /* 2 */ "?",
2835 "Floating point exception", /* 4 */ "?", "?", "?",
2836 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2837 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2838 "?", "?", "?", "?", "?", "?", "?", "?",
2842 char *sys_siglist
[] =
2844 "Zero is not a signal!!!",
2846 "Floating point exception",
2847 "Illegal instruction",
2848 "Interactive user interrupt",
2849 "Segment violation",
2852 #else /* not __MRC__ and not __MWERKS__ */
2854 #endif /* not __MRC__ and not __MWERKS__ */
2857 #include <utsname.h>
2860 uname (struct utsname
*name
)
2863 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2866 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2867 p2cstr (name
->nodename
);
2875 /* Event class of HLE sent to subprocess. */
2876 const OSType kEmacsSubprocessSend
= 'ESND';
2878 /* Event class of HLE sent back from subprocess. */
2879 const OSType kEmacsSubprocessReply
= 'ERPY';
2883 mystrchr (char *s
, char c
)
2885 while (*s
&& *s
!= c
)
2913 mystrcpy (char *to
, char *from
)
2925 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2926 terminated). The process should run with the default directory
2927 "workdir", read input from "infn", and write output and error to
2928 "outfn" and "errfn", resp. The Process Manager call
2929 LaunchApplication is used to start the subprocess. We use high
2930 level events as the mechanism to pass arguments to the subprocess
2931 and to make Emacs wait for the subprocess to terminate and pass
2932 back a result code. The bulk of the code here packs the arguments
2933 into one message to be passed together with the high level event.
2934 Emacs also sometimes starts a subprocess using a shell to perform
2935 wildcard filename expansion. Since we don't really have a shell on
2936 the Mac, this case is detected and the starting of the shell is
2937 by-passed. We really need to add code here to do filename
2938 expansion to support such functionality. */
2941 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2942 unsigned char **argv
;
2943 const char *workdir
;
2944 const char *infn
, *outfn
, *errfn
;
2946 #if TARGET_API_MAC_CARBON
2948 #else /* not TARGET_API_MAC_CARBON */
2949 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2950 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2951 int paramlen
, argc
, newargc
, j
, retries
;
2952 char **newargv
, *param
, *p
;
2955 LaunchParamBlockRec lpbr
;
2956 EventRecord send_event
, reply_event
;
2957 RgnHandle cursor_region_handle
;
2959 unsigned long ref_con
, len
;
2961 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2963 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2965 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2967 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2970 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2971 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2980 /* If a subprocess is invoked with a shell, we receive 3 arguments
2981 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2982 bins>/<command> <command args>" */
2983 j
= strlen (argv
[0]);
2984 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2985 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2987 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2989 /* The arguments for the command in argv[2] are separated by
2990 spaces. Count them and put the count in newargc. */
2991 command
= (char *) alloca (strlen (argv
[2])+2);
2992 strcpy (command
, argv
[2]);
2993 if (command
[strlen (command
) - 1] != ' ')
2994 strcat (command
, " ");
2998 t
= mystrchr (t
, ' ');
3002 t
= mystrchr (t
+1, ' ');
3005 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3008 for (j
= 0; j
< newargc
; j
++)
3010 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3011 mystrcpy (newargv
[j
], t
);
3014 paramlen
+= strlen (newargv
[j
]) + 1;
3017 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3019 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3024 { /* sometimes Emacs call "sh" without a path for the command */
3026 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3027 strcpy (t
, "~emacs/");
3028 strcat (t
, newargv
[0]);
3031 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3032 make_number (X_OK
));
3036 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3040 strcpy (macappname
, tempmacpathname
);
3044 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3047 newargv
= (char **) alloca (sizeof (char *) * argc
);
3049 for (j
= 1; j
< argc
; j
++)
3051 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3053 char *t
= strchr (argv
[j
], ' ');
3056 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3057 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3058 tempcmdname
[t
-argv
[j
]] = '\0';
3059 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3062 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3064 strcpy (newargv
[j
], tempmaccmdname
);
3065 strcat (newargv
[j
], t
);
3069 char tempmaccmdname
[MAXPATHLEN
+1];
3070 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3073 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3074 strcpy (newargv
[j
], tempmaccmdname
);
3078 newargv
[j
] = argv
[j
];
3079 paramlen
+= strlen (newargv
[j
]) + 1;
3083 /* After expanding all the arguments, we now know the length of the
3084 parameter block to be sent to the subprocess as a message
3085 attached to the HLE. */
3086 param
= (char *) malloc (paramlen
+ 1);
3092 /* first byte of message contains number of arguments for command */
3093 strcpy (p
, macworkdir
);
3094 p
+= strlen (macworkdir
);
3096 /* null terminate strings sent so it's possible to use strcpy over there */
3097 strcpy (p
, macinfn
);
3098 p
+= strlen (macinfn
);
3100 strcpy (p
, macoutfn
);
3101 p
+= strlen (macoutfn
);
3103 strcpy (p
, macerrfn
);
3104 p
+= strlen (macerrfn
);
3106 for (j
= 1; j
< newargc
; j
++)
3108 strcpy (p
, newargv
[j
]);
3109 p
+= strlen (newargv
[j
]);
3113 c2pstr (macappname
);
3115 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3123 lpbr
.launchBlockID
= extendedBlock
;
3124 lpbr
.launchEPBLength
= extendedBlockLen
;
3125 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3126 lpbr
.launchAppSpec
= &spec
;
3127 lpbr
.launchAppParameters
= NULL
;
3129 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3136 send_event
.what
= kHighLevelEvent
;
3137 send_event
.message
= kEmacsSubprocessSend
;
3138 /* Event ID stored in "where" unused */
3141 /* OS may think current subprocess has terminated if previous one
3142 terminated recently. */
3145 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3146 paramlen
+ 1, receiverIDisPSN
);
3148 while (iErr
== sessClosedErr
&& retries
-- > 0);
3156 cursor_region_handle
= NewRgn ();
3158 /* Wait for the subprocess to finish, when it will send us a ERPY
3159 high level event. */
3161 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3162 cursor_region_handle
)
3163 && reply_event
.message
== kEmacsSubprocessReply
)
3166 /* The return code is sent through the refCon */
3167 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3170 DisposeHandle ((Handle
) cursor_region_handle
);
3175 DisposeHandle ((Handle
) cursor_region_handle
);
3179 #endif /* not TARGET_API_MAC_CARBON */
3184 opendir (const char *dirname
)
3186 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3187 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3191 int len
, vol_name_len
;
3193 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3196 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3198 fully_resolved_name
[len
] = '\0';
3200 strcpy (fully_resolved_name
, true_pathname
);
3202 dirp
= (DIR *) malloc (sizeof(DIR));
3206 /* Handle special case when dirname is "/": sets up for readir to
3207 get all mount volumes. */
3208 if (strcmp (fully_resolved_name
, "/") == 0)
3210 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3211 dirp
->current_index
= 1; /* index for first volume */
3215 /* Handle typical cases: not accessing all mounted volumes. */
3216 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3219 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3220 len
= strlen (mac_pathname
);
3221 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3222 strcat (mac_pathname
, ":");
3224 /* Extract volume name */
3225 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3226 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3227 vol_name
[vol_name_len
] = '\0';
3228 strcat (vol_name
, ":");
3230 c2pstr (mac_pathname
);
3231 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3232 /* using full pathname so vRefNum and DirID ignored */
3233 cipb
.hFileInfo
.ioVRefNum
= 0;
3234 cipb
.hFileInfo
.ioDirID
= 0;
3235 cipb
.hFileInfo
.ioFDirIndex
= 0;
3236 /* set to 0 to get information about specific dir or file */
3238 errno
= PBGetCatInfo (&cipb
, false);
3245 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3246 return 0; /* not a directory */
3248 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3249 dirp
->getting_volumes
= 0;
3250 dirp
->current_index
= 1; /* index for first file/directory */
3253 vpb
.ioNamePtr
= vol_name
;
3254 /* using full pathname so vRefNum and DirID ignored */
3256 vpb
.ioVolIndex
= -1;
3257 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3264 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3281 HParamBlockRec hpblock
;
3283 static struct dirent s_dirent
;
3284 static Str255 s_name
;
3288 /* Handle the root directory containing the mounted volumes. Call
3289 PBHGetVInfo specifying an index to obtain the info for a volume.
3290 PBHGetVInfo returns an error when it receives an index beyond the
3291 last volume, at which time we should return a nil dirent struct
3293 if (dp
->getting_volumes
)
3295 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3296 hpblock
.volumeParam
.ioVRefNum
= 0;
3297 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3299 errno
= PBHGetVInfo (&hpblock
, false);
3307 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3309 dp
->current_index
++;
3311 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3312 s_dirent
.d_name
= s_name
;
3318 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3319 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3320 /* location to receive filename returned */
3322 /* return only visible files */
3326 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3327 /* directory ID found by opendir */
3328 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3330 errno
= PBGetCatInfo (&cipb
, false);
3337 /* insist on a visible entry */
3338 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3339 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3341 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3343 dp
->current_index
++;
3356 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3357 /* value unimportant: non-zero for valid file */
3358 s_dirent
.d_name
= s_name
;
3368 char mac_pathname
[MAXPATHLEN
+1];
3369 Str255 directory_name
;
3373 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3376 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3382 #endif /* ! MAC_OSX */
3386 initialize_applescript ()
3391 /* if open fails, as_scripting_component is set to NULL. Its
3392 subsequent use in OSA calls will fail with badComponentInstance
3394 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3395 kAppleScriptSubtype
);
3397 null_desc
.descriptorType
= typeNull
;
3398 null_desc
.dataHandle
= 0;
3399 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3400 kOSANullScript
, &as_script_context
);
3402 as_script_context
= kOSANullScript
;
3403 /* use default context if create fails */
3408 terminate_applescript()
3410 OSADispose (as_scripting_component
, as_script_context
);
3411 CloseComponent (as_scripting_component
);
3414 /* Convert a lisp string to the 4 byte character code. */
3417 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3426 /* check type string */
3428 if (SBYTES (arg
) != 4)
3430 error ("Wrong argument: need string of length 4 for code");
3432 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3437 /* Convert the 4 byte character code into a 4 byte string. */
3440 mac_get_object_from_code(OSType defCode
)
3442 UInt32 code
= EndianU32_NtoB (defCode
);
3444 return make_unibyte_string ((char *)&code
, 4);
3448 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3449 doc
: /* Get the creator code of FILENAME as a four character string. */)
3451 Lisp_Object filename
;
3460 Lisp_Object result
= Qnil
;
3461 CHECK_STRING (filename
);
3463 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3466 filename
= Fexpand_file_name (filename
, Qnil
);
3470 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3472 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3475 if (status
== noErr
)
3478 FSCatalogInfo catalogInfo
;
3480 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3481 &catalogInfo
, NULL
, NULL
, NULL
);
3485 status
= FSpGetFInfo (&fss
, &finder_info
);
3487 if (status
== noErr
)
3490 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
3492 result
= mac_get_object_from_code (finder_info
.fdCreator
);
3497 if (status
!= noErr
) {
3498 error ("Error while getting file information.");
3503 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
3504 doc
: /* Get the type code of FILENAME as a four character string. */)
3506 Lisp_Object filename
;
3515 Lisp_Object result
= Qnil
;
3516 CHECK_STRING (filename
);
3518 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3521 filename
= Fexpand_file_name (filename
, Qnil
);
3525 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3527 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3530 if (status
== noErr
)
3533 FSCatalogInfo catalogInfo
;
3535 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3536 &catalogInfo
, NULL
, NULL
, NULL
);
3540 status
= FSpGetFInfo (&fss
, &finder_info
);
3542 if (status
== noErr
)
3545 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
3547 result
= mac_get_object_from_code (finder_info
.fdType
);
3552 if (status
!= noErr
) {
3553 error ("Error while getting file information.");
3558 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
3559 doc
: /* Set creator code of file FILENAME to CODE.
3560 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
3561 assumed. Return non-nil if successful. */)
3563 Lisp_Object filename
, code
;
3572 CHECK_STRING (filename
);
3574 cCode
= mac_get_code_from_arg(code
, 'EMAx');
3576 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3579 filename
= Fexpand_file_name (filename
, Qnil
);
3583 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3585 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3588 if (status
== noErr
)
3591 FSCatalogInfo catalogInfo
;
3593 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3594 &catalogInfo
, NULL
, NULL
, &parentDir
);
3598 status
= FSpGetFInfo (&fss
, &finder_info
);
3600 if (status
== noErr
)
3603 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
3604 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3605 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3607 finder_info
.fdCreator
= cCode
;
3608 status
= FSpSetFInfo (&fss
, &finder_info
);
3613 if (status
!= noErr
) {
3614 error ("Error while setting creator information.");
3619 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
3620 doc
: /* Set file code of file FILENAME to CODE.
3621 CODE must be a 4-character string. Return non-nil if successful. */)
3623 Lisp_Object filename
, code
;
3632 CHECK_STRING (filename
);
3634 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
3636 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3639 filename
= Fexpand_file_name (filename
, Qnil
);
3643 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3645 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3648 if (status
== noErr
)
3651 FSCatalogInfo catalogInfo
;
3653 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3654 &catalogInfo
, NULL
, NULL
, &parentDir
);
3658 status
= FSpGetFInfo (&fss
, &finder_info
);
3660 if (status
== noErr
)
3663 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
3664 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3665 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3667 finder_info
.fdType
= cCode
;
3668 status
= FSpSetFInfo (&fss
, &finder_info
);
3673 if (status
!= noErr
) {
3674 error ("Error while setting creator information.");
3680 /* Compile and execute the AppleScript SCRIPT and return the error
3681 status as function value. A zero is returned if compilation and
3682 execution is successful, in which case RESULT returns a pointer to
3683 a string containing the resulting script value. Otherwise, the Mac
3684 error code is returned and RESULT returns a pointer to an error
3685 string. In both cases the caller should deallocate the storage
3686 used by the string pointed to by RESULT if it is non-NULL. For
3687 documentation on the MacOS scripting architecture, see Inside
3688 Macintosh - Interapplication Communications: Scripting Components. */
3691 do_applescript (char *script
, char **result
)
3693 AEDesc script_desc
, result_desc
, error_desc
;
3700 if (!as_scripting_component
)
3701 initialize_applescript();
3703 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3707 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3708 typeChar
, kOSAModeNull
, &result_desc
);
3710 if (osaerror
== errOSAScriptError
)
3712 /* error executing AppleScript: retrieve error message */
3713 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3716 #if TARGET_API_MAC_CARBON
3717 length
= AEGetDescDataSize (&error_desc
);
3718 *result
= (char *) xmalloc (length
+ 1);
3721 AEGetDescData (&error_desc
, *result
, length
);
3722 *(*result
+ length
) = '\0';
3724 #else /* not TARGET_API_MAC_CARBON */
3725 HLock (error_desc
.dataHandle
);
3726 length
= GetHandleSize(error_desc
.dataHandle
);
3727 *result
= (char *) xmalloc (length
+ 1);
3730 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3731 *(*result
+ length
) = '\0';
3733 HUnlock (error_desc
.dataHandle
);
3734 #endif /* not TARGET_API_MAC_CARBON */
3735 AEDisposeDesc (&error_desc
);
3738 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3740 #if TARGET_API_MAC_CARBON
3741 length
= AEGetDescDataSize (&result_desc
);
3742 *result
= (char *) xmalloc (length
+ 1);
3745 AEGetDescData (&result_desc
, *result
, length
);
3746 *(*result
+ length
) = '\0';
3748 #else /* not TARGET_API_MAC_CARBON */
3749 HLock (result_desc
.dataHandle
);
3750 length
= GetHandleSize(result_desc
.dataHandle
);
3751 *result
= (char *) xmalloc (length
+ 1);
3754 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3755 *(*result
+ length
) = '\0';
3757 HUnlock (result_desc
.dataHandle
);
3758 #endif /* not TARGET_API_MAC_CARBON */
3759 AEDisposeDesc (&result_desc
);
3762 AEDisposeDesc (&script_desc
);
3768 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3769 doc
: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
3770 If compilation and execution are successful, the resulting script
3771 value is returned as a string. Otherwise the function aborts and
3772 displays the error message returned by the AppleScript scripting
3777 char *result
, *temp
;
3778 Lisp_Object lisp_result
;
3781 CHECK_STRING (script
);
3784 status
= do_applescript (SDATA (script
), &result
);
3789 error ("AppleScript error %d", status
);
3792 /* Unfortunately only OSADoScript in do_applescript knows how
3793 how large the resulting script value or error message is
3794 going to be and therefore as caller memory must be
3795 deallocated here. It is necessary to free the error
3796 message before calling error to avoid a memory leak. */
3797 temp
= (char *) alloca (strlen (result
) + 1);
3798 strcpy (temp
, result
);
3805 lisp_result
= build_string (result
);
3812 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3813 Smac_file_name_to_posix
, 1, 1, 0,
3814 doc
: /* Convert Macintosh filename to Posix form. */)
3816 Lisp_Object mac_filename
;
3818 char posix_filename
[MAXPATHLEN
+1];
3820 CHECK_STRING (mac_filename
);
3822 if (mac_to_posix_pathname (SDATA (mac_filename
), posix_filename
,
3824 return build_string (posix_filename
);
3830 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3831 Sposix_file_name_to_mac
, 1, 1, 0,
3832 doc
: /* Convert Posix filename to Mac form. */)
3834 Lisp_Object posix_filename
;
3836 char mac_filename
[MAXPATHLEN
+1];
3838 CHECK_STRING (posix_filename
);
3840 if (posix_to_mac_pathname (SDATA (posix_filename
), mac_filename
,
3842 return build_string (mac_filename
);
3848 #if TARGET_API_MAC_CARBON
3849 static Lisp_Object Qxml
, Qmime_charset
;
3850 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
3852 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3853 doc
: /* Return the application preference value for KEY.
3854 KEY is either a string specifying a preference key, or a list of key
3855 strings. If it is a list, the (i+1)-th element is used as a key for
3856 the CFDictionary value obtained by the i-th element. If lookup is
3857 failed at some stage, nil is returned.
3859 Optional arg APPLICATION is an application ID string. If omitted or
3860 nil, that stands for the current application.
3862 Optional arg FORMAT specifies the data format of the return value. If
3863 omitted or nil, each Core Foundation object is converted into a
3864 corresponding Lisp object as follows:
3866 Core Foundation Lisp Tag
3867 ------------------------------------------------------------
3868 CFString Multibyte string string
3869 CFNumber Integer or float number
3870 CFBoolean Symbol (t or nil) boolean
3871 CFDate List of three integers date
3872 (cf. `current-time')
3873 CFData Unibyte string data
3874 CFArray Vector array
3875 CFDictionary Alist or hash table dictionary
3876 (depending on HASH-BOUND)
3878 If it is t, a symbol that represents the type of the original Core
3879 Foundation object is prepended. If it is `xml', the value is returned
3880 as an XML representation.
3882 Optional arg HASH-BOUND specifies which kinds of the list objects,
3883 alists or hash tables, are used as the targets of the conversion from
3884 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3885 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3886 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3888 (key
, application
, format
, hash_bound
)
3889 Lisp_Object key
, application
, format
, hash_bound
;
3891 CFStringRef app_id
, key_str
;
3892 CFPropertyListRef app_plist
= NULL
, plist
;
3893 Lisp_Object result
= Qnil
, tmp
;
3896 key
= Fcons (key
, Qnil
);
3900 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3901 CHECK_STRING_CAR (tmp
);
3903 wrong_type_argument (Qlistp
, key
);
3905 if (!NILP (application
))
3906 CHECK_STRING (application
);
3907 CHECK_SYMBOL (format
);
3908 if (!NILP (hash_bound
))
3909 CHECK_NUMBER (hash_bound
);
3913 app_id
= kCFPreferencesCurrentApplication
;
3914 if (!NILP (application
))
3916 app_id
= cfstring_create_with_string (application
);
3920 key_str
= cfstring_create_with_string (XCAR (key
));
3921 if (key_str
== NULL
)
3923 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3924 CFRelease (key_str
);
3925 if (app_plist
== NULL
)
3929 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3931 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3933 key_str
= cfstring_create_with_string (XCAR (key
));
3934 if (key_str
== NULL
)
3936 plist
= CFDictionaryGetValue (plist
, key_str
);
3937 CFRelease (key_str
);
3943 if (EQ (format
, Qxml
))
3945 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3948 result
= cfdata_to_lisp (data
);
3953 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3954 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3958 CFRelease (app_plist
);
3967 static CFStringEncoding
3968 get_cfstring_encoding_from_lisp (obj
)
3971 CFStringRef iana_name
;
3972 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
3977 if (SYMBOLP (obj
) && !NILP (obj
) && !NILP (Fcoding_system_p (obj
)))
3979 Lisp_Object coding_spec
, plist
;
3981 coding_spec
= Fget (obj
, Qcoding_system
);
3982 plist
= XVECTOR (coding_spec
)->contents
[3];
3983 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
3987 obj
= SYMBOL_NAME (obj
);
3991 iana_name
= cfstring_create_with_string (obj
);
3994 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
3995 CFRelease (iana_name
);
4002 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4004 cfstring_create_normalized (str
, symbol
)
4009 TextEncodingVariant variant
;
4010 float initial_mag
= 0.0;
4011 CFStringRef result
= NULL
;
4013 if (EQ (symbol
, QNFD
))
4014 form
= kCFStringNormalizationFormD
;
4015 else if (EQ (symbol
, QNFKD
))
4016 form
= kCFStringNormalizationFormKD
;
4017 else if (EQ (symbol
, QNFC
))
4018 form
= kCFStringNormalizationFormC
;
4019 else if (EQ (symbol
, QNFKC
))
4020 form
= kCFStringNormalizationFormKC
;
4021 else if (EQ (symbol
, QHFS_plus_D
))
4023 variant
= kUnicodeHFSPlusDecompVariant
;
4026 else if (EQ (symbol
, QHFS_plus_C
))
4028 variant
= kUnicodeHFSPlusCompVariant
;
4034 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4038 CFStringNormalize (mut_str
, form
);
4042 else if (initial_mag
> 0.0)
4044 UnicodeToTextInfo uni
= NULL
;
4047 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4049 ByteCount out_read
, out_size
, out_len
;
4051 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4053 kTextEncodingDefaultFormat
);
4054 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4056 kTextEncodingDefaultFormat
);
4057 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4059 length
= CFStringGetLength (str
);
4060 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4064 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4065 if (in_text
== NULL
)
4067 buffer
= xmalloc (sizeof (UniChar
) * length
);
4070 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4076 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4077 while (err
== noErr
)
4079 out_buf
= xmalloc (out_size
);
4080 if (out_buf
== NULL
)
4083 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4085 kUnicodeDefaultDirectionMask
,
4086 0, NULL
, NULL
, NULL
,
4087 out_size
, &out_read
, &out_len
,
4089 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4098 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4099 out_len
/ sizeof (UniChar
));
4101 DisposeUnicodeToTextInfo (&uni
);
4117 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4118 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4119 The conversion is performed using the converter provided by the system.
4120 Each encoding is specified by either a coding system symbol, a mime
4121 charset string, or an integer as a CFStringEncoding value.
4122 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4123 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4124 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4125 On successful conversion, returns the result string, else returns
4127 (string
, source
, target
, normalization_form
)
4128 Lisp_Object string
, source
, target
, normalization_form
;
4130 Lisp_Object result
= Qnil
;
4131 CFStringEncoding src_encoding
, tgt_encoding
;
4132 CFStringRef str
= NULL
;
4133 CFDataRef data
= NULL
;
4135 CHECK_STRING (string
);
4136 if (!INTEGERP (source
) && !STRINGP (source
))
4137 CHECK_SYMBOL (source
);
4138 if (!INTEGERP (target
) && !STRINGP (target
))
4139 CHECK_SYMBOL (target
);
4140 CHECK_SYMBOL (normalization_form
);
4144 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4145 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4147 string
= Fstring_as_unibyte (string
);
4148 if (src_encoding
!= kCFStringEncodingInvalidId
4149 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4150 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4151 src_encoding
, true);
4152 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4155 CFStringRef saved_str
= str
;
4157 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4158 CFRelease (saved_str
);
4163 data
= CFStringCreateExternalRepresentation (NULL
, str
,
4164 tgt_encoding
, '\0');
4169 result
= cfdata_to_lisp (data
);
4177 #endif /* TARGET_API_MAC_CARBON */
4180 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4181 doc
: /* Clear the font name table. */)
4185 mac_clear_font_name_table ();
4192 extern int inhibit_window_system
;
4193 extern int noninteractive
;
4195 /* Unlike in X11, window events in Carbon do not come from sockets.
4196 So we cannot simply use `select' to monitor two kinds of inputs:
4197 window events and process outputs. We emulate such functionality
4198 by regarding fd 0 as the window event channel and simultaneously
4199 monitoring both kinds of input channels. It is implemented by
4200 dividing into some cases:
4201 1. The window event channel is not involved.
4203 2. Sockets are not involved.
4204 -> Use ReceiveNextEvent.
4205 3. [If SELECT_USE_CFSOCKET is defined]
4206 Only the window event channel and socket read channels are
4207 involved, and timeout is not too short (greater than
4208 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4209 -> Create CFSocket for each socket and add it into the current
4210 event RunLoop so that an `ready-to-read' event can be posted
4211 to the event queue that is also used for window events. Then
4212 ReceiveNextEvent can wait for both kinds of inputs.
4214 -> Periodically poll the window input channel while repeatedly
4215 executing `select' with a short timeout
4216 (SELECT_POLLING_PERIOD_USEC microseconds). */
4218 #define SELECT_POLLING_PERIOD_USEC 20000
4219 #ifdef SELECT_USE_CFSOCKET
4220 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4221 #define EVENT_CLASS_SOCK 'Sock'
4224 socket_callback (s
, type
, address
, data
, info
)
4226 CFSocketCallBackType type
;
4233 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4234 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4235 ReleaseEvent (event
);
4237 #endif /* SELECT_USE_CFSOCKET */
4240 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4245 struct timeval
*timeout
;
4250 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4254 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4255 kEventLeaveInQueue
, NULL
);
4266 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4267 #undef SELECT_INVALIDATE_CFSOCKET
4271 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4276 struct timeval
*timeout
;
4280 EMACS_TIME select_timeout
;
4282 if (inhibit_window_system
|| noninteractive
4283 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4284 return select (n
, rfds
, wfds
, efds
, timeout
);
4288 if (wfds
== NULL
&& efds
== NULL
)
4291 SELECT_TYPE orfds
= *rfds
;
4293 EventTimeout timeout_sec
=
4295 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4296 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4297 : kEventDurationForever
);
4299 for (i
= 1; i
< n
; i
++)
4300 if (FD_ISSET (i
, rfds
))
4306 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4307 kEventLeaveInQueue
, NULL
);
4318 /* Avoid initial overhead of RunLoop setup for the case that
4319 some input is already available. */
4320 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4321 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4322 if (r
!= 0 || timeout_sec
== 0.0)
4327 #ifdef SELECT_USE_CFSOCKET
4328 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4329 goto poll_periodically
;
4332 CFRunLoopRef runloop
=
4333 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4334 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4335 #ifdef SELECT_INVALIDATE_CFSOCKET
4336 CFSocketRef
*shead
, *s
;
4338 CFRunLoopSourceRef
*shead
, *s
;
4343 #ifdef SELECT_INVALIDATE_CFSOCKET
4344 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4346 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4349 for (i
= 1; i
< n
; i
++)
4350 if (FD_ISSET (i
, rfds
))
4352 CFSocketRef socket
=
4353 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4354 socket_callback
, NULL
);
4355 CFRunLoopSourceRef source
=
4356 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4358 #ifdef SELECT_INVALIDATE_CFSOCKET
4359 CFSocketSetSocketFlags (socket
, 0);
4361 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4362 #ifdef SELECT_INVALIDATE_CFSOCKET
4372 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4377 #ifdef SELECT_INVALIDATE_CFSOCKET
4378 CFSocketInvalidate (*s
);
4380 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4395 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4396 GetEventTypeCount (specs
),
4398 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4399 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4406 #endif /* SELECT_USE_CFSOCKET */
4411 EMACS_TIME end_time
, now
, remaining_time
;
4412 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4420 remaining_time
= *timeout
;
4421 EMACS_GET_TIME (now
);
4422 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4427 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4428 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4429 select_timeout
= remaining_time
;
4430 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4442 EMACS_GET_TIME (now
);
4443 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4446 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4457 /* Set up environment variables so that Emacs can correctly find its
4458 support files when packaged as an application bundle. Directories
4459 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4460 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4461 by `make install' by default can instead be placed in
4462 .../Emacs.app/Contents/Resources/ and
4463 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4464 is changed only if it is not already set. Presumably if the user
4465 sets an environment variable, he will want to use files in his path
4466 instead of ones in the application bundle. */
4468 init_mac_osx_environment ()
4472 CFStringRef cf_app_bundle_pathname
;
4473 int app_bundle_pathname_len
;
4474 char *app_bundle_pathname
;
4478 /* Fetch the pathname of the application bundle as a C string into
4479 app_bundle_pathname. */
4481 bundle
= CFBundleGetMainBundle ();
4485 bundleURL
= CFBundleCopyBundleURL (bundle
);
4489 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4490 kCFURLPOSIXPathStyle
);
4491 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4492 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4494 if (!CFStringGetCString (cf_app_bundle_pathname
,
4495 app_bundle_pathname
,
4496 app_bundle_pathname_len
+ 1,
4497 kCFStringEncodingISOLatin1
))
4499 CFRelease (cf_app_bundle_pathname
);
4503 CFRelease (cf_app_bundle_pathname
);
4505 /* P should have sufficient room for the pathname of the bundle plus
4506 the subpath in it leading to the respective directories. Q
4507 should have three times that much room because EMACSLOADPATH can
4508 have the value "<path to lisp dir>:<path to leim dir>:<path to
4510 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4511 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4512 if (!getenv ("EMACSLOADPATH"))
4516 strcpy (p
, app_bundle_pathname
);
4517 strcat (p
, "/Contents/Resources/lisp");
4518 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4521 strcpy (p
, app_bundle_pathname
);
4522 strcat (p
, "/Contents/Resources/leim");
4523 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4530 strcpy (p
, app_bundle_pathname
);
4531 strcat (p
, "/Contents/Resources/site-lisp");
4532 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4540 setenv ("EMACSLOADPATH", q
, 1);
4543 if (!getenv ("EMACSPATH"))
4547 strcpy (p
, app_bundle_pathname
);
4548 strcat (p
, "/Contents/MacOS/libexec");
4549 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4552 strcpy (p
, app_bundle_pathname
);
4553 strcat (p
, "/Contents/MacOS/bin");
4554 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4562 setenv ("EMACSPATH", q
, 1);
4565 if (!getenv ("EMACSDATA"))
4567 strcpy (p
, app_bundle_pathname
);
4568 strcat (p
, "/Contents/Resources/etc");
4569 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4570 setenv ("EMACSDATA", p
, 1);
4573 if (!getenv ("EMACSDOC"))
4575 strcpy (p
, app_bundle_pathname
);
4576 strcat (p
, "/Contents/Resources/etc");
4577 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4578 setenv ("EMACSDOC", p
, 1);
4581 if (!getenv ("INFOPATH"))
4583 strcpy (p
, app_bundle_pathname
);
4584 strcat (p
, "/Contents/Resources/info");
4585 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4586 setenv ("INFOPATH", p
, 1);
4589 #endif /* MAC_OSX */
4593 mac_get_system_locale ()
4601 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4602 region
= GetScriptManagerVariable (smRegionCode
);
4603 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4605 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4608 return build_string (str
);
4617 #if TARGET_API_MAC_CARBON
4618 Qstring
= intern ("string"); staticpro (&Qstring
);
4619 Qnumber
= intern ("number"); staticpro (&Qnumber
);
4620 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
4621 Qdate
= intern ("date"); staticpro (&Qdate
);
4622 Qdata
= intern ("data"); staticpro (&Qdata
);
4623 Qarray
= intern ("array"); staticpro (&Qarray
);
4624 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
4626 Qxml
= intern ("xml");
4629 Qmime_charset
= intern ("mime-charset");
4630 staticpro (&Qmime_charset
);
4632 QNFD
= intern ("NFD"); staticpro (&QNFD
);
4633 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
4634 QNFC
= intern ("NFC"); staticpro (&QNFC
);
4635 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
4636 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
4637 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
4640 #if TARGET_API_MAC_CARBON
4641 defsubr (&Smac_get_preference
);
4642 defsubr (&Smac_code_convert_string
);
4644 defsubr (&Smac_clear_font_name_table
);
4646 defsubr (&Smac_set_file_creator
);
4647 defsubr (&Smac_set_file_type
);
4648 defsubr (&Smac_get_file_creator
);
4649 defsubr (&Smac_get_file_type
);
4650 defsubr (&Sdo_applescript
);
4651 defsubr (&Smac_file_name_to_posix
);
4652 defsubr (&Sposix_file_name_to_mac
);
4654 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
4655 doc
: /* The system script code. */);
4656 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4658 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
4659 doc
: /* The system locale identifier string.
4660 This is not a POSIX locale ID, but an ICU locale ID. So encoding
4661 information is not included. */);
4662 Vmac_system_locale
= mac_get_system_locale ();
4665 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4666 (do not change this comment) */