1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2005 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>
64 #include <sys/param.h>
70 /* The system script code. */
71 static int mac_system_script_code
;
73 /* The system locale identifier string. */
74 static Lisp_Object Vmac_system_locale
;
76 /* An instance of the AppleScript component. */
77 static ComponentInstance as_scripting_component
;
78 /* The single script context used for all script executions. */
79 static OSAID as_script_context
;
82 /* When converting from Mac to Unix pathnames, /'s in folder names are
83 converted to :'s. This function, used in copying folder names,
84 performs a strncat and converts all character a to b in the copy of
85 the string s2 appended to the end of s1. */
88 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
96 for (i
= 0; i
< l2
; i
++)
105 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
106 that does not begin with a ':' and contains at least one ':'. A Mac
107 full pathname causes a '/' to be prepended to the Posix pathname.
108 The algorithm for the rest of the pathname is as follows:
109 For each segment between two ':',
110 if it is non-null, copy as is and then add a '/' at the end,
111 otherwise, insert a "../" into the Posix pathname.
112 Returns 1 if successful; 0 if fails. */
115 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
117 const char *p
, *q
, *pe
;
124 p
= strchr (mfn
, ':');
125 if (p
!= 0 && p
!= mfn
) /* full pathname */
132 pe
= mfn
+ strlen (mfn
);
139 { /* two consecutive ':' */
140 if (strlen (ufn
) + 3 >= ufnbuflen
)
146 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
148 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
155 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
157 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
158 /* no separator for last one */
167 extern char *get_temp_dir_name ();
170 /* Convert a Posix pathname to Mac form. Approximately reverse of the
171 above in algorithm. */
174 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
176 const char *p
, *q
, *pe
;
177 char expanded_pathname
[MAXPATHLEN
+1];
186 /* Check for and handle volume names. Last comparison: strangely
187 somewhere "/.emacs" is passed. A temporary fix for now. */
188 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
190 if (strlen (p
) + 1 > mfnbuflen
)
197 /* expand to emacs dir found by init_emacs_passwd_dir */
198 if (strncmp (p
, "~emacs/", 7) == 0)
200 struct passwd
*pw
= getpwnam ("emacs");
202 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
204 strcpy (expanded_pathname
, pw
->pw_dir
);
205 strcat (expanded_pathname
, p
);
206 p
= expanded_pathname
;
207 /* now p points to the pathname with emacs dir prefix */
209 else if (strncmp (p
, "/tmp/", 5) == 0)
211 char *t
= get_temp_dir_name ();
213 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
215 strcpy (expanded_pathname
, t
);
216 strcat (expanded_pathname
, p
);
217 p
= expanded_pathname
;
218 /* now p points to the pathname with emacs dir prefix */
220 else if (*p
!= '/') /* relative pathname */
232 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
234 if (strlen (mfn
) + 1 >= mfnbuflen
)
240 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
242 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
249 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
251 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
260 /***********************************************************************
261 Conversion between Lisp and Core Foundation objects
262 ***********************************************************************/
264 #if TARGET_API_MAC_CARBON
265 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
266 static Lisp_Object Qarray
, Qdictionary
;
267 #define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
269 struct cfdict_context
272 int with_tag
, hash_bound
;
275 /* C string to CFString. */
278 cfstring_create_with_utf8_cstring (c_str
)
283 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
285 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
286 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
292 /* Lisp string to CFString. */
295 cfstring_create_with_string (s
)
298 CFStringRef string
= NULL
;
300 if (STRING_MULTIBYTE (s
))
302 char *p
, *end
= SDATA (s
) + SBYTES (s
);
304 for (p
= SDATA (s
); p
< end
; p
++)
307 s
= ENCODE_UTF_8 (s
);
310 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
311 kCFStringEncodingUTF8
, false);
315 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
316 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
317 kCFStringEncodingMacRoman
, false);
323 /* From CFData to a lisp string. Always returns a unibyte string. */
326 cfdata_to_lisp (data
)
329 CFIndex len
= CFDataGetLength (data
);
330 Lisp_Object result
= make_uninit_string (len
);
332 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
338 /* From CFString to a lisp string. Never returns a unibyte string
339 (even if it only contains ASCII characters).
340 This may cause GC during code conversion. */
343 cfstring_to_lisp (string
)
346 Lisp_Object result
= Qnil
;
347 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
350 result
= make_unibyte_string (s
, strlen (s
));
354 CFStringCreateExternalRepresentation (NULL
, string
,
355 kCFStringEncodingUTF8
, '?');
359 result
= cfdata_to_lisp (data
);
366 result
= DECODE_UTF_8 (result
);
367 /* This may be superfluous. Just to make sure that the result
368 is a multibyte string. */
369 result
= string_to_multibyte (result
);
376 /* CFNumber to a lisp integer or a lisp float. */
379 cfnumber_to_lisp (number
)
382 Lisp_Object result
= Qnil
;
383 #if BITS_PER_EMACS_INT > 32
385 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
388 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
392 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
393 && !FIXNUM_OVERFLOW_P (int_val
))
394 result
= make_number (int_val
);
396 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
397 result
= make_float (float_val
);
402 /* CFDate to a list of three integers as in a return value of
406 cfdate_to_lisp (date
)
409 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
410 static CFAbsoluteTime epoch
= 0.0, sec
;
414 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
416 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
417 high
= sec
/ 65536.0;
418 low
= sec
- high
* 65536.0;
420 return list3 (make_number (high
), make_number (low
), make_number (0));
424 /* CFBoolean to a lisp symbol, `t' or `nil'. */
427 cfboolean_to_lisp (boolean
)
428 CFBooleanRef boolean
;
430 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
434 /* Any Core Foundation object to a (lengthy) lisp string. */
437 cfobject_desc_to_lisp (object
)
440 Lisp_Object result
= Qnil
;
441 CFStringRef desc
= CFCopyDescription (object
);
445 result
= cfstring_to_lisp (desc
);
453 /* Callback functions for cfproperty_list_to_lisp. */
456 cfdictionary_add_to_list (key
, value
, context
)
461 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
464 Fcons (Fcons (cfstring_to_lisp (key
),
465 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
471 cfdictionary_puthash (key
, value
, context
)
476 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
477 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
478 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
481 hash_lookup (h
, lisp_key
, &hash_code
);
482 hash_put (h
, lisp_key
,
483 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
488 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
489 non-zero, a symbol that represents the type of the original Core
490 Foundation object is prepended. HASH_BOUND specifies which kinds
491 of the lisp objects, alists or hash tables, are used as the targets
492 of the conversion from CFDictionary. If HASH_BOUND is negative,
493 always generate alists. If HASH_BOUND >= 0, generate an alist if
494 the number of keys in the dictionary is smaller than HASH_BOUND,
495 and a hash table otherwise. */
498 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
499 CFPropertyListRef plist
;
500 int with_tag
, hash_bound
;
502 CFTypeID type_id
= CFGetTypeID (plist
);
503 Lisp_Object tag
= Qnil
, result
= Qnil
;
504 struct gcpro gcpro1
, gcpro2
;
506 GCPRO2 (tag
, result
);
508 if (type_id
== CFStringGetTypeID ())
511 result
= cfstring_to_lisp (plist
);
513 else if (type_id
== CFNumberGetTypeID ())
516 result
= cfnumber_to_lisp (plist
);
518 else if (type_id
== CFBooleanGetTypeID ())
521 result
= cfboolean_to_lisp (plist
);
523 else if (type_id
== CFDateGetTypeID ())
526 result
= cfdate_to_lisp (plist
);
528 else if (type_id
== CFDataGetTypeID ())
531 result
= cfdata_to_lisp (plist
);
533 else if (type_id
== CFArrayGetTypeID ())
535 CFIndex index
, count
= CFArrayGetCount (plist
);
538 result
= Fmake_vector (make_number (count
), Qnil
);
539 for (index
= 0; index
< count
; index
++)
540 XVECTOR (result
)->contents
[index
] =
541 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
542 with_tag
, hash_bound
);
544 else if (type_id
== CFDictionaryGetTypeID ())
546 struct cfdict_context context
;
547 CFIndex count
= CFDictionaryGetCount (plist
);
550 context
.result
= &result
;
551 context
.with_tag
= with_tag
;
552 context
.hash_bound
= hash_bound
;
553 if (hash_bound
< 0 || count
< hash_bound
)
556 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
561 result
= make_hash_table (Qequal
,
563 make_float (DEFAULT_REHASH_SIZE
),
564 make_float (DEFAULT_REHASH_THRESHOLD
),
566 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
576 result
= Fcons (tag
, result
);
583 /***********************************************************************
584 Emulation of the X Resource Manager
585 ***********************************************************************/
587 /* Parser functions for resource lines. Each function takes an
588 address of a variable whose value points to the head of a string.
589 The value will be advanced so that it points to the next character
590 of the parsed part when the function returns.
592 A resource name such as "Emacs*font" is parsed into a non-empty
593 list called `quarks'. Each element is either a Lisp string that
594 represents a concrete component, a Lisp symbol LOOSE_BINDING
595 (actually Qlambda) that represents any number (>=0) of intervening
596 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
597 that represents as any single component. */
601 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
602 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
608 /* WhiteSpace = {<space> | <horizontal tab>} */
609 while (*P
== ' ' || *P
== '\t')
617 /* Comment = "!" {<any character except null or newline>} */
630 /* Don't interpret filename. Just skip until the newline. */
632 parse_include_file (p
)
635 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
652 /* Binding = "." | "*" */
653 if (*P
== '.' || *P
== '*')
657 while (*P
== '.' || *P
== '*')
670 /* Component = "?" | ComponentName
671 ComponentName = NameChar {NameChar}
672 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
676 return SINGLE_COMPONENT
;
678 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
682 while (isalnum (*P
) || *P
== '_' || *P
== '-')
685 return make_unibyte_string (start
, P
- start
);
692 parse_resource_name (p
)
695 Lisp_Object result
= Qnil
, component
;
698 /* ResourceName = [Binding] {Component Binding} ComponentName */
699 if (parse_binding (p
) == '*')
700 result
= Fcons (LOOSE_BINDING
, result
);
702 component
= parse_component (p
);
703 if (NILP (component
))
706 result
= Fcons (component
, result
);
707 while ((binding
= parse_binding (p
)) != '\0')
710 result
= Fcons (LOOSE_BINDING
, result
);
711 component
= parse_component (p
);
712 if (NILP (component
))
715 result
= Fcons (component
, result
);
718 /* The final component should not be '?'. */
719 if (EQ (component
, SINGLE_COMPONENT
))
722 return Fnreverse (result
);
730 Lisp_Object seq
= Qnil
, result
;
731 int buf_len
, total_len
= 0, len
, continue_p
;
733 q
= strchr (P
, '\n');
734 buf_len
= q
? q
- P
: strlen (P
);
735 buf
= xmalloc (buf_len
);
764 else if ('0' <= P
[0] && P
[0] <= '7'
765 && '0' <= P
[1] && P
[1] <= '7'
766 && '0' <= P
[2] && P
[2] <= '7')
768 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
778 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
783 q
= strchr (P
, '\n');
784 len
= q
? q
- P
: strlen (P
);
789 buf
= xmalloc (buf_len
);
797 if (SBYTES (XCAR (seq
)) == total_len
)
798 return make_string (SDATA (XCAR (seq
)), total_len
);
801 buf
= xmalloc (total_len
);
803 for (; CONSP (seq
); seq
= XCDR (seq
))
805 len
= SBYTES (XCAR (seq
));
807 memcpy (q
, SDATA (XCAR (seq
)), len
);
809 result
= make_string (buf
, total_len
);
816 parse_resource_line (p
)
819 Lisp_Object quarks
, value
;
821 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
822 if (parse_comment (p
) || parse_include_file (p
))
825 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
826 skip_white_space (p
);
827 quarks
= parse_resource_name (p
);
830 skip_white_space (p
);
834 skip_white_space (p
);
835 value
= parse_value (p
);
836 return Fcons (quarks
, value
);
839 /* Skip the remaining data as a dummy value. */
846 /* Equivalents of X Resource Manager functions.
848 An X Resource Database acts as a collection of resource names and
849 associated values. It is implemented as a trie on quarks. Namely,
850 each edge is labeled by either a string, LOOSE_BINDING, or
851 SINGLE_COMPONENT. Each node has a node id, which is a unique
852 nonnegative integer, and the root node id is 0. A database is
853 implemented as a hash table that maps a pair (SRC-NODE-ID .
854 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
855 in the table as a value for HASHKEY_MAX_NID. A value associated to
856 a node is recorded as a value for the node id. */
858 #define HASHKEY_MAX_NID (make_number (0))
861 xrm_create_database ()
863 XrmDatabase database
;
865 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
866 make_float (DEFAULT_REHASH_SIZE
),
867 make_float (DEFAULT_REHASH_THRESHOLD
),
869 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
875 xrm_q_put_resource (database
, quarks
, value
)
876 XrmDatabase database
;
877 Lisp_Object quarks
, value
;
879 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
882 Lisp_Object node_id
, key
;
884 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
886 XSETINT (node_id
, 0);
887 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
889 key
= Fcons (node_id
, XCAR (quarks
));
890 i
= hash_lookup (h
, key
, &hash_code
);
894 XSETINT (node_id
, max_nid
);
895 hash_put (h
, key
, node_id
, hash_code
);
898 node_id
= HASH_VALUE (h
, i
);
900 Fputhash (node_id
, value
, database
);
902 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
905 /* Merge multiple resource entries specified by DATA into a resource
906 database DATABASE. DATA points to the head of a null-terminated
907 string consisting of multiple resource lines. It's like a
908 combination of XrmGetStringDatabase and XrmMergeDatabases. */
911 xrm_merge_string_database (database
, data
)
912 XrmDatabase database
;
915 Lisp_Object quarks_value
;
919 quarks_value
= parse_resource_line (&data
);
920 if (!NILP (quarks_value
))
921 xrm_q_put_resource (database
,
922 XCAR (quarks_value
), XCDR (quarks_value
));
927 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
928 XrmDatabase database
;
929 Lisp_Object node_id
, quark_name
, quark_class
;
931 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
932 Lisp_Object key
, labels
[3], value
;
935 if (!CONSP (quark_name
))
936 return Fgethash (node_id
, database
, Qnil
);
938 /* First, try tight bindings */
939 labels
[0] = XCAR (quark_name
);
940 labels
[1] = XCAR (quark_class
);
941 labels
[2] = SINGLE_COMPONENT
;
943 key
= Fcons (node_id
, Qnil
);
944 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
946 XSETCDR (key
, labels
[k
]);
947 i
= hash_lookup (h
, key
, NULL
);
950 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
951 XCDR (quark_name
), XCDR (quark_class
));
957 /* Then, try loose bindings */
958 XSETCDR (key
, LOOSE_BINDING
);
959 i
= hash_lookup (h
, key
, NULL
);
962 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
963 quark_name
, quark_class
);
967 return xrm_q_get_resource_1 (database
, node_id
,
968 XCDR (quark_name
), XCDR (quark_class
));
975 xrm_q_get_resource (database
, quark_name
, quark_class
)
976 XrmDatabase database
;
977 Lisp_Object quark_name
, quark_class
;
979 return xrm_q_get_resource_1 (database
, make_number (0),
980 quark_name
, quark_class
);
983 /* Retrieve a resource value for the specified NAME and CLASS from the
984 resource database DATABASE. It corresponds to XrmGetResource. */
987 xrm_get_resource (database
, name
, class)
988 XrmDatabase database
;
991 Lisp_Object quark_name
, quark_class
, tmp
;
994 quark_name
= parse_resource_name (&name
);
997 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
998 if (!STRINGP (XCAR (tmp
)))
1001 quark_class
= parse_resource_name (&class);
1004 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1005 if (!STRINGP (XCAR (tmp
)))
1011 return xrm_q_get_resource (database
, quark_name
, quark_class
);
1014 #if TARGET_API_MAC_CARBON
1016 xrm_cfproperty_list_to_value (plist
)
1017 CFPropertyListRef plist
;
1019 CFTypeID type_id
= CFGetTypeID (plist
);
1021 if (type_id
== CFStringGetTypeID ())
1022 return cfstring_to_lisp (plist
);
1023 else if (type_id
== CFNumberGetTypeID ())
1026 Lisp_Object result
= Qnil
;
1028 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1031 result
= cfstring_to_lisp (string
);
1036 else if (type_id
== CFBooleanGetTypeID ())
1037 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1038 else if (type_id
== CFDataGetTypeID ())
1039 return cfdata_to_lisp (plist
);
1045 /* Create a new resource database from the preferences for the
1046 application APPLICATION. APPLICATION is either a string that
1047 specifies an application ID, or NULL that represents the current
1051 xrm_get_preference_database (application
)
1054 #if TARGET_API_MAC_CARBON
1055 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1056 CFMutableSetRef key_set
= NULL
;
1057 CFArrayRef key_array
;
1058 CFIndex index
, count
;
1060 XrmDatabase database
;
1061 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1062 CFPropertyListRef plist
;
1064 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1066 user_doms
[0] = kCFPreferencesCurrentUser
;
1067 user_doms
[1] = kCFPreferencesAnyUser
;
1068 host_doms
[0] = kCFPreferencesCurrentHost
;
1069 host_doms
[1] = kCFPreferencesAnyHost
;
1071 database
= xrm_create_database ();
1073 GCPRO3 (database
, quarks
, value
);
1077 app_id
= kCFPreferencesCurrentApplication
;
1080 app_id
= cfstring_create_with_utf8_cstring (application
);
1085 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1086 if (key_set
== NULL
)
1088 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1089 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1091 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1095 count
= CFArrayGetCount (key_array
);
1096 for (index
= 0; index
< count
; index
++)
1097 CFSetAddValue (key_set
,
1098 CFArrayGetValueAtIndex (key_array
, index
));
1099 CFRelease (key_array
);
1103 count
= CFSetGetCount (key_set
);
1104 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1107 CFSetGetValues (key_set
, (const void **)keys
);
1108 for (index
= 0; index
< count
; index
++)
1110 res_name
= SDATA (cfstring_to_lisp (keys
[index
]));
1111 quarks
= parse_resource_name (&res_name
);
1112 if (!(NILP (quarks
) || *res_name
))
1114 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1115 value
= xrm_cfproperty_list_to_value (plist
);
1118 xrm_q_put_resource (database
, quarks
, value
);
1125 CFRelease (key_set
);
1134 return xrm_create_database ();
1141 /* The following functions with "sys_" prefix are stubs to Unix
1142 functions that have already been implemented by CW or MPW. The
1143 calls to them in Emacs source course are #define'd to call the sys_
1144 versions by the header files s-mac.h. In these stubs pathnames are
1145 converted between their Unix and Mac forms. */
1148 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1149 + 17 leap days. These are for adjusting time values returned by
1150 MacOS Toolbox functions. */
1152 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1155 #if __MSL__ < 0x6000
1156 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1157 a leap year! This is for adjusting time_t values returned by MSL
1159 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1160 #else /* __MSL__ >= 0x6000 */
1161 /* CW changes Pro 6 to follow Unix! */
1162 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1163 #endif /* __MSL__ >= 0x6000 */
1165 /* MPW library functions follow Unix (confused?). */
1166 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1167 #else /* not __MRC__ */
1169 #endif /* not __MRC__ */
1172 /* Define our own stat function for both MrC and CW. The reason for
1173 doing this: "stat" is both the name of a struct and function name:
1174 can't use the same trick like that for sys_open, sys_close, etc. to
1175 redirect Emacs's calls to our own version that converts Unix style
1176 filenames to Mac style filename because all sorts of compilation
1177 errors will be generated if stat is #define'd to be sys_stat. */
1180 stat_noalias (const char *path
, struct stat
*buf
)
1182 char mac_pathname
[MAXPATHLEN
+1];
1185 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1188 c2pstr (mac_pathname
);
1189 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1190 cipb
.hFileInfo
.ioVRefNum
= 0;
1191 cipb
.hFileInfo
.ioDirID
= 0;
1192 cipb
.hFileInfo
.ioFDirIndex
= 0;
1193 /* set to 0 to get information about specific dir or file */
1195 errno
= PBGetCatInfo (&cipb
, false);
1196 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1201 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1203 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1205 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1206 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1207 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1208 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1209 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1210 /* size of dir = number of files and dirs */
1213 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1214 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1218 buf
->st_mode
= S_IFREG
| S_IREAD
;
1219 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1220 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1221 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1222 buf
->st_mode
|= S_IEXEC
;
1223 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1224 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1225 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1228 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1229 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1232 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1234 /* identify alias files as symlinks */
1235 buf
->st_mode
&= ~S_IFREG
;
1236 buf
->st_mode
|= S_IFLNK
;
1240 buf
->st_uid
= getuid ();
1241 buf
->st_gid
= getgid ();
1249 lstat (const char *path
, struct stat
*buf
)
1252 char true_pathname
[MAXPATHLEN
+1];
1254 /* Try looking for the file without resolving aliases first. */
1255 if ((result
= stat_noalias (path
, buf
)) >= 0)
1258 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1261 return stat_noalias (true_pathname
, buf
);
1266 stat (const char *path
, struct stat
*sb
)
1269 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1272 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1273 ! (sb
->st_mode
& S_IFLNK
))
1276 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1279 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1282 fully_resolved_name
[len
] = '\0';
1283 /* in fact our readlink terminates strings */
1284 return lstat (fully_resolved_name
, sb
);
1287 return lstat (true_pathname
, sb
);
1292 /* CW defines fstat in stat.mac.c while MPW does not provide this
1293 function. Without the information of how to get from a file
1294 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1295 to implement this function. Fortunately, there is only one place
1296 where this function is called in our configuration: in fileio.c,
1297 where only the st_dev and st_ino fields are used to determine
1298 whether two fildes point to different i-nodes to prevent copying
1299 a file onto itself equal. What we have here probably needs
1303 fstat (int fildes
, struct stat
*buf
)
1306 buf
->st_ino
= fildes
;
1307 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1308 return 0; /* success */
1310 #endif /* __MRC__ */
1314 mkdir (const char *dirname
, int mode
)
1316 #pragma unused(mode)
1319 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1321 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1324 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1327 c2pstr (mac_pathname
);
1328 hfpb
.ioNamePtr
= mac_pathname
;
1329 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1330 hfpb
.ioDirID
= 0; /* parent is the root */
1332 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1333 /* just return the Mac OSErr code for now */
1334 return errno
== noErr
? 0 : -1;
1339 sys_rmdir (const char *dirname
)
1342 char mac_pathname
[MAXPATHLEN
+1];
1344 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1347 c2pstr (mac_pathname
);
1348 hfpb
.ioNamePtr
= mac_pathname
;
1349 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1350 hfpb
.ioDirID
= 0; /* parent is the root */
1352 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1353 return errno
== noErr
? 0 : -1;
1358 /* No implementation yet. */
1360 execvp (const char *path
, ...)
1364 #endif /* __MRC__ */
1368 utime (const char *path
, const struct utimbuf
*times
)
1370 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1372 char mac_pathname
[MAXPATHLEN
+1];
1375 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1378 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1380 fully_resolved_name
[len
] = '\0';
1382 strcpy (fully_resolved_name
, true_pathname
);
1384 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1387 c2pstr (mac_pathname
);
1388 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1389 cipb
.hFileInfo
.ioVRefNum
= 0;
1390 cipb
.hFileInfo
.ioDirID
= 0;
1391 cipb
.hFileInfo
.ioFDirIndex
= 0;
1392 /* set to 0 to get information about specific dir or file */
1394 errno
= PBGetCatInfo (&cipb
, false);
1398 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1401 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1403 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1408 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1410 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1413 errno
= PBSetCatInfo (&cipb
, false);
1414 return errno
== noErr
? 0 : -1;
1428 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1430 access (const char *path
, int mode
)
1432 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1434 char mac_pathname
[MAXPATHLEN
+1];
1437 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1440 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1442 fully_resolved_name
[len
] = '\0';
1444 strcpy (fully_resolved_name
, true_pathname
);
1446 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1449 c2pstr (mac_pathname
);
1450 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1451 cipb
.hFileInfo
.ioVRefNum
= 0;
1452 cipb
.hFileInfo
.ioDirID
= 0;
1453 cipb
.hFileInfo
.ioFDirIndex
= 0;
1454 /* set to 0 to get information about specific dir or file */
1456 errno
= PBGetCatInfo (&cipb
, false);
1460 if (mode
== F_OK
) /* got this far, file exists */
1464 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1468 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1475 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1476 /* don't allow if lock bit is on */
1482 #define DEV_NULL_FD 0x10000
1486 sys_open (const char *path
, int oflag
)
1488 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1490 char mac_pathname
[MAXPATHLEN
+1];
1492 if (strcmp (path
, "/dev/null") == 0)
1493 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1495 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1498 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1500 fully_resolved_name
[len
] = '\0';
1502 strcpy (fully_resolved_name
, true_pathname
);
1504 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1509 int res
= open (mac_pathname
, oflag
);
1510 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1511 if (oflag
& O_CREAT
)
1512 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1514 #else /* not __MRC__ */
1515 return open (mac_pathname
, oflag
);
1516 #endif /* not __MRC__ */
1523 sys_creat (const char *path
, mode_t mode
)
1525 char true_pathname
[MAXPATHLEN
+1];
1527 char mac_pathname
[MAXPATHLEN
+1];
1529 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1532 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1537 int result
= creat (mac_pathname
);
1538 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1540 #else /* not __MRC__ */
1541 return creat (mac_pathname
, mode
);
1542 #endif /* not __MRC__ */
1549 sys_unlink (const char *path
)
1551 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1553 char mac_pathname
[MAXPATHLEN
+1];
1555 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1558 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1560 fully_resolved_name
[len
] = '\0';
1562 strcpy (fully_resolved_name
, true_pathname
);
1564 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1567 return unlink (mac_pathname
);
1573 sys_read (int fildes
, char *buf
, int count
)
1575 if (fildes
== 0) /* this should not be used for console input */
1578 #if __MSL__ >= 0x6000
1579 return _read (fildes
, buf
, count
);
1581 return read (fildes
, buf
, count
);
1588 sys_write (int fildes
, const char *buf
, int count
)
1590 if (fildes
== DEV_NULL_FD
)
1593 #if __MSL__ >= 0x6000
1594 return _write (fildes
, buf
, count
);
1596 return write (fildes
, buf
, count
);
1603 sys_rename (const char * old_name
, const char * new_name
)
1605 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1606 char fully_resolved_old_name
[MAXPATHLEN
+1];
1608 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1610 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1613 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1615 fully_resolved_old_name
[len
] = '\0';
1617 strcpy (fully_resolved_old_name
, true_old_pathname
);
1619 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1622 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1625 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1630 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1633 /* If a file with new_name already exists, rename deletes the old
1634 file in Unix. CW version fails in these situation. So we add a
1635 call to unlink here. */
1636 (void) unlink (mac_new_name
);
1638 return rename (mac_old_name
, mac_new_name
);
1643 extern FILE *fopen (const char *name
, const char *mode
);
1645 sys_fopen (const char *name
, const char *mode
)
1647 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1649 char mac_pathname
[MAXPATHLEN
+1];
1651 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1654 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1656 fully_resolved_name
[len
] = '\0';
1658 strcpy (fully_resolved_name
, true_pathname
);
1660 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1665 if (mode
[0] == 'w' || mode
[0] == 'a')
1666 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1667 #endif /* not __MRC__ */
1668 return fopen (mac_pathname
, mode
);
1673 #include "keyboard.h"
1674 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1677 select (n
, rfds
, wfds
, efds
, timeout
)
1682 struct timeval
*timeout
;
1685 #if TARGET_API_MAC_CARBON
1686 EventTimeout timeout_sec
=
1688 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1689 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1690 : kEventDurationForever
);
1693 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1695 #else /* not TARGET_API_MAC_CARBON */
1697 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1698 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1700 /* Can only handle wait for keyboard input. */
1701 if (n
> 1 || wfds
|| efds
)
1704 /* Also return true if an event other than a keyDown has occurred.
1705 This causes kbd_buffer_get_event in keyboard.c to call
1706 read_avail_input which in turn calls XTread_socket to poll for
1707 these events. Otherwise these never get processed except but a
1708 very slow poll timer. */
1709 if (mac_wait_next_event (&e
, sleep_time
, false))
1712 err
= -9875; /* eventLoopTimedOutErr */
1713 #endif /* not TARGET_API_MAC_CARBON */
1715 if (FD_ISSET (0, rfds
))
1726 if (input_polling_used ())
1728 /* It could be confusing if a real alarm arrives while
1729 processing the fake one. Turn it off and let the
1730 handler reset it. */
1731 extern void poll_for_input_1
P_ ((void));
1732 int old_poll_suppress_count
= poll_suppress_count
;
1733 poll_suppress_count
= 1;
1734 poll_for_input_1 ();
1735 poll_suppress_count
= old_poll_suppress_count
;
1745 /* Simulation of SIGALRM. The stub for function signal stores the
1746 signal handler function in alarm_signal_func if a SIGALRM is
1750 #include "syssignal.h"
1752 static TMTask mac_atimer_task
;
1754 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
1756 static int signal_mask
= 0;
1759 __sigfun alarm_signal_func
= (__sigfun
) 0;
1761 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
1762 #else /* not __MRC__ and not __MWERKS__ */
1764 #endif /* not __MRC__ and not __MWERKS__ */
1768 extern __sigfun
signal (int signal
, __sigfun signal_func
);
1770 sys_signal (int signal_num
, __sigfun signal_func
)
1772 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
1774 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
1775 #else /* not __MRC__ and not __MWERKS__ */
1777 #endif /* not __MRC__ and not __MWERKS__ */
1779 if (signal_num
!= SIGALRM
)
1780 return signal (signal_num
, signal_func
);
1784 __sigfun old_signal_func
;
1786 __signal_func_ptr old_signal_func
;
1790 old_signal_func
= alarm_signal_func
;
1791 alarm_signal_func
= signal_func
;
1792 return old_signal_func
;
1798 mac_atimer_handler (qlink
)
1801 if (alarm_signal_func
)
1802 (alarm_signal_func
) (SIGALRM
);
1807 set_mac_atimer (count
)
1810 static TimerUPP mac_atimer_handlerUPP
= NULL
;
1812 if (mac_atimer_handlerUPP
== NULL
)
1813 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
1814 mac_atimer_task
.tmCount
= 0;
1815 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
1816 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
1817 InsTime (mac_atimer_qlink
);
1819 PrimeTime (mac_atimer_qlink
, count
);
1824 remove_mac_atimer (remaining_count
)
1825 long *remaining_count
;
1827 if (mac_atimer_qlink
)
1829 RmvTime (mac_atimer_qlink
);
1830 if (remaining_count
)
1831 *remaining_count
= mac_atimer_task
.tmCount
;
1832 mac_atimer_qlink
= NULL
;
1844 int old_mask
= signal_mask
;
1846 signal_mask
|= mask
;
1848 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
1849 remove_mac_atimer (NULL
);
1856 sigsetmask (int mask
)
1858 int old_mask
= signal_mask
;
1862 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
1863 if (signal_mask
& sigmask (SIGALRM
))
1864 remove_mac_atimer (NULL
);
1866 set_mac_atimer (mac_atimer_task
.tmCount
);
1875 long remaining_count
;
1877 if (remove_mac_atimer (&remaining_count
) == 0)
1879 set_mac_atimer (seconds
* 1000);
1881 return remaining_count
/ 1000;
1885 mac_atimer_task
.tmCount
= seconds
* 1000;
1893 setitimer (which
, value
, ovalue
)
1895 const struct itimerval
*value
;
1896 struct itimerval
*ovalue
;
1898 long remaining_count
;
1899 long count
= (EMACS_SECS (value
->it_value
) * 1000
1900 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
1902 if (remove_mac_atimer (&remaining_count
) == 0)
1906 bzero (ovalue
, sizeof (*ovalue
));
1907 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
1908 (remaining_count
% 1000) * 1000);
1910 set_mac_atimer (count
);
1913 mac_atimer_task
.tmCount
= count
;
1919 /* gettimeofday should return the amount of time (in a timeval
1920 structure) since midnight today. The toolbox function Microseconds
1921 returns the number of microseconds (in a UnsignedWide value) since
1922 the machine was booted. Also making this complicated is WideAdd,
1923 WideSubtract, etc. take wide values. */
1930 static wide wall_clock_at_epoch
, clicks_at_epoch
;
1931 UnsignedWide uw_microseconds
;
1932 wide w_microseconds
;
1933 time_t sys_time (time_t *);
1935 /* If this function is called for the first time, record the number
1936 of seconds since midnight and the number of microseconds since
1937 boot at the time of this first call. */
1942 systime
= sys_time (NULL
);
1943 /* Store microseconds since midnight in wall_clock_at_epoch. */
1944 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
1945 Microseconds (&uw_microseconds
);
1946 /* Store microseconds since boot in clicks_at_epoch. */
1947 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
1948 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
1951 /* Get time since boot */
1952 Microseconds (&uw_microseconds
);
1954 /* Convert to time since midnight*/
1955 w_microseconds
.hi
= uw_microseconds
.hi
;
1956 w_microseconds
.lo
= uw_microseconds
.lo
;
1957 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
1958 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
1959 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
1967 sleep (unsigned int seconds
)
1969 unsigned long time_up
;
1972 time_up
= TickCount () + seconds
* 60;
1973 while (TickCount () < time_up
)
1975 /* Accept no event; just wait. by T.I. */
1976 WaitNextEvent (0, &e
, 30, NULL
);
1981 #endif /* __MRC__ */
1984 /* The time functions adjust time values according to the difference
1985 between the Unix and CW epoches. */
1988 extern struct tm
*gmtime (const time_t *);
1990 sys_gmtime (const time_t *timer
)
1992 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1994 return gmtime (&unix_time
);
1999 extern struct tm
*localtime (const time_t *);
2001 sys_localtime (const time_t *timer
)
2003 #if __MSL__ >= 0x6000
2004 time_t unix_time
= *timer
;
2006 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2009 return localtime (&unix_time
);
2014 extern char *ctime (const time_t *);
2016 sys_ctime (const time_t *timer
)
2018 #if __MSL__ >= 0x6000
2019 time_t unix_time
= *timer
;
2021 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2024 return ctime (&unix_time
);
2029 extern time_t time (time_t *);
2031 sys_time (time_t *timer
)
2033 #if __MSL__ >= 0x6000
2034 time_t mac_time
= time (NULL
);
2036 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2046 /* no subprocesses, empty wait */
2056 croak (char *badfunc
)
2058 printf ("%s not yet implemented\r\n", badfunc
);
2064 mktemp (char *template)
2069 len
= strlen (template);
2071 while (k
>= 0 && template[k
] == 'X')
2074 k
++; /* make k index of first 'X' */
2078 /* Zero filled, number of digits equal to the number of X's. */
2079 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2088 /* Emulate getpwuid, getpwnam and others. */
2090 #define PASSWD_FIELD_SIZE 256
2092 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2093 static char my_passwd_dir
[MAXPATHLEN
+1];
2095 static struct passwd my_passwd
=
2101 static struct group my_group
=
2103 /* There are no groups on the mac, so we just return "root" as the
2109 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2111 char emacs_passwd_dir
[MAXPATHLEN
+1];
2117 init_emacs_passwd_dir ()
2121 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2123 /* Need pathname of first ancestor that begins with "emacs"
2124 since Mac emacs application is somewhere in the emacs-*
2126 int len
= strlen (emacs_passwd_dir
);
2128 /* j points to the "/" following the directory name being
2131 while (i
>= 0 && !found
)
2133 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2135 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2136 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2138 emacs_passwd_dir
[j
+1] = '\0';
2149 /* Setting to "/" probably won't work but set it to something
2151 strcpy (emacs_passwd_dir
, "/");
2152 strcpy (my_passwd_dir
, "/");
2157 static struct passwd emacs_passwd
=
2163 static int my_passwd_inited
= 0;
2171 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2172 directory where Emacs was started. */
2174 owner_name
= (char **) GetResource ('STR ',-16096);
2178 BlockMove ((unsigned char *) *owner_name
,
2179 (unsigned char *) my_passwd_name
,
2181 HUnlock (owner_name
);
2182 p2cstr ((unsigned char *) my_passwd_name
);
2185 my_passwd_name
[0] = 0;
2190 getpwuid (uid_t uid
)
2192 if (!my_passwd_inited
)
2195 my_passwd_inited
= 1;
2203 getgrgid (gid_t gid
)
2210 getpwnam (const char *name
)
2212 if (strcmp (name
, "emacs") == 0)
2213 return &emacs_passwd
;
2215 if (!my_passwd_inited
)
2218 my_passwd_inited
= 1;
2225 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2226 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2247 error ("Can't spawn subshell");
2252 request_sigio (void)
2258 unrequest_sigio (void)
2273 pipe (int _fildes
[2])
2280 /* Hard and symbolic links. */
2283 symlink (const char *name1
, const char *name2
)
2291 link (const char *name1
, const char *name2
)
2297 #endif /* ! MAC_OSX */
2299 /* Determine the path name of the file specified by VREFNUM, DIRID,
2300 and NAME and place that in the buffer PATH of length
2303 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2304 long dir_id
, ConstStr255Param name
)
2310 if (strlen (name
) > man_path_len
)
2313 memcpy (dir_name
, name
, name
[0]+1);
2314 memcpy (path
, name
, name
[0]+1);
2317 cipb
.dirInfo
.ioDrParID
= dir_id
;
2318 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2322 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2323 cipb
.dirInfo
.ioFDirIndex
= -1;
2324 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2325 /* go up to parent each time */
2327 err
= PBGetCatInfo (&cipb
, false);
2332 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2335 strcat (dir_name
, ":");
2336 strcat (dir_name
, path
);
2337 /* attach to front since we're going up directory tree */
2338 strcpy (path
, dir_name
);
2340 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2341 /* stop when we see the volume's root directory */
2343 return 1; /* success */
2348 posix_pathname_to_fsspec (ufn
, fs
)
2352 Str255 mac_pathname
;
2354 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2358 c2pstr (mac_pathname
);
2359 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2364 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2369 char mac_pathname
[MAXPATHLEN
];
2371 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2372 fs
->vRefNum
, fs
->parID
, fs
->name
)
2373 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2382 readlink (const char *path
, char *buf
, int bufsiz
)
2384 char mac_sym_link_name
[MAXPATHLEN
+1];
2387 Boolean target_is_folder
, was_aliased
;
2388 Str255 directory_name
, mac_pathname
;
2391 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2394 c2pstr (mac_sym_link_name
);
2395 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2402 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2403 if (err
!= noErr
|| !was_aliased
)
2409 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2416 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2422 return strlen (buf
);
2426 /* Convert a path to one with aliases fully expanded. */
2429 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2431 char *q
, temp
[MAXPATHLEN
+1];
2435 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2442 q
= strchr (p
+ 1, '/');
2444 q
= strchr (p
, '/');
2445 len
= 0; /* loop may not be entered, e.g., for "/" */
2450 strncat (temp
, p
, q
- p
);
2451 len
= readlink (temp
, buf
, bufsiz
);
2454 if (strlen (temp
) + 1 > bufsiz
)
2464 if (len
+ strlen (p
) + 1 >= bufsiz
)
2468 return len
+ strlen (p
);
2473 umask (mode_t numask
)
2475 static mode_t mask
= 022;
2476 mode_t oldmask
= mask
;
2483 chmod (const char *path
, mode_t mode
)
2485 /* say it always succeed for now */
2491 fchmod (int fd
, mode_t mode
)
2493 /* say it always succeed for now */
2499 fchown (int fd
, uid_t owner
, gid_t group
)
2501 /* say it always succeed for now */
2510 return fcntl (oldd
, F_DUPFD
, 0);
2512 /* current implementation of fcntl in fcntl.mac.c simply returns old
2514 return fcntl (oldd
, F_DUPFD
);
2521 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2522 newd if it already exists. Then, attempt to dup oldd. If not
2523 successful, call dup2 recursively until we are, then close the
2524 unsuccessful ones. */
2527 dup2 (int oldd
, int newd
)
2538 ret
= dup2 (oldd
, newd
);
2544 /* let it fail for now */
2561 ioctl (int d
, int request
, void *argp
)
2571 if (fildes
>=0 && fildes
<= 2)
2604 #endif /* __MRC__ */
2608 #if __MSL__ < 0x6000
2616 #endif /* __MWERKS__ */
2618 #endif /* ! MAC_OSX */
2621 /* Return the path to the directory in which Emacs can create
2622 temporary files. The MacOS "temporary items" directory cannot be
2623 used because it removes the file written by a process when it
2624 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2625 again not exactly). And of course Emacs needs to read back the
2626 files written by its subprocesses. So here we write the files to a
2627 directory "Emacs" in the Preferences Folder. This directory is
2628 created if it does not exist. */
2631 get_temp_dir_name ()
2633 static char *temp_dir_name
= NULL
;
2637 Str255 dir_name
, full_path
;
2639 char unix_dir_name
[MAXPATHLEN
+1];
2642 /* Cache directory name with pointer temp_dir_name.
2643 Look for it only the first time. */
2646 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2647 &vol_ref_num
, &dir_id
);
2651 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2654 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2655 strcat (full_path
, "Emacs:");
2659 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2662 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2665 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2668 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2669 strcpy (temp_dir_name
, unix_dir_name
);
2672 return temp_dir_name
;
2677 /* Allocate and construct an array of pointers to strings from a list
2678 of strings stored in a 'STR#' resource. The returned pointer array
2679 is stored in the style of argv and environ: if the 'STR#' resource
2680 contains numString strings, a pointer array with numString+1
2681 elements is returned in which the last entry contains a null
2682 pointer. The pointer to the pointer array is passed by pointer in
2683 parameter t. The resource ID of the 'STR#' resource is passed in
2684 parameter StringListID.
2688 get_string_list (char ***t
, short string_list_id
)
2694 h
= GetResource ('STR#', string_list_id
);
2699 num_strings
= * (short *) p
;
2701 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2702 for (i
= 0; i
< num_strings
; i
++)
2704 short length
= *p
++;
2705 (*t
)[i
] = (char *) malloc (length
+ 1);
2706 strncpy ((*t
)[i
], p
, length
);
2707 (*t
)[i
][length
] = '\0';
2710 (*t
)[num_strings
] = 0;
2715 /* Return no string in case GetResource fails. Bug fixed by
2716 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2717 option (no sym -on implies -opt local). */
2718 *t
= (char **) malloc (sizeof (char *));
2725 get_path_to_system_folder ()
2730 Str255 dir_name
, full_path
;
2732 static char system_folder_unix_name
[MAXPATHLEN
+1];
2735 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2736 &vol_ref_num
, &dir_id
);
2740 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2743 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2747 return system_folder_unix_name
;
2753 #define ENVIRON_STRING_LIST_ID 128
2755 /* Get environment variable definitions from STR# resource. */
2762 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2768 /* Make HOME directory the one Emacs starts up in if not specified
2770 if (getenv ("HOME") == NULL
)
2772 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2775 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2778 strcpy (environ
[i
], "HOME=");
2779 strcat (environ
[i
], my_passwd_dir
);
2786 /* Make HOME directory the one Emacs starts up in if not specified
2788 if (getenv ("MAIL") == NULL
)
2790 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2793 char * path_to_system_folder
= get_path_to_system_folder ();
2794 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2797 strcpy (environ
[i
], "MAIL=");
2798 strcat (environ
[i
], path_to_system_folder
);
2799 strcat (environ
[i
], "Eudora Folder/In");
2807 /* Return the value of the environment variable NAME. */
2810 getenv (const char *name
)
2812 int length
= strlen(name
);
2815 for (e
= environ
; *e
!= 0; e
++)
2816 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2817 return &(*e
)[length
+ 1];
2819 if (strcmp (name
, "TMPDIR") == 0)
2820 return get_temp_dir_name ();
2827 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2828 char *sys_siglist
[] =
2830 "Zero is not a signal!!!",
2832 "Interactive user interrupt", /* 2 */ "?",
2833 "Floating point exception", /* 4 */ "?", "?", "?",
2834 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2835 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2836 "?", "?", "?", "?", "?", "?", "?", "?",
2840 char *sys_siglist
[] =
2842 "Zero is not a signal!!!",
2844 "Floating point exception",
2845 "Illegal instruction",
2846 "Interactive user interrupt",
2847 "Segment violation",
2850 #else /* not __MRC__ and not __MWERKS__ */
2852 #endif /* not __MRC__ and not __MWERKS__ */
2855 #include <utsname.h>
2858 uname (struct utsname
*name
)
2861 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2864 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2865 p2cstr (name
->nodename
);
2873 /* Event class of HLE sent to subprocess. */
2874 const OSType kEmacsSubprocessSend
= 'ESND';
2876 /* Event class of HLE sent back from subprocess. */
2877 const OSType kEmacsSubprocessReply
= 'ERPY';
2881 mystrchr (char *s
, char c
)
2883 while (*s
&& *s
!= c
)
2911 mystrcpy (char *to
, char *from
)
2923 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2924 terminated). The process should run with the default directory
2925 "workdir", read input from "infn", and write output and error to
2926 "outfn" and "errfn", resp. The Process Manager call
2927 LaunchApplication is used to start the subprocess. We use high
2928 level events as the mechanism to pass arguments to the subprocess
2929 and to make Emacs wait for the subprocess to terminate and pass
2930 back a result code. The bulk of the code here packs the arguments
2931 into one message to be passed together with the high level event.
2932 Emacs also sometimes starts a subprocess using a shell to perform
2933 wildcard filename expansion. Since we don't really have a shell on
2934 the Mac, this case is detected and the starting of the shell is
2935 by-passed. We really need to add code here to do filename
2936 expansion to support such functionality. */
2939 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2940 unsigned char **argv
;
2941 const char *workdir
;
2942 const char *infn
, *outfn
, *errfn
;
2944 #if TARGET_API_MAC_CARBON
2946 #else /* not TARGET_API_MAC_CARBON */
2947 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2948 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2949 int paramlen
, argc
, newargc
, j
, retries
;
2950 char **newargv
, *param
, *p
;
2953 LaunchParamBlockRec lpbr
;
2954 EventRecord send_event
, reply_event
;
2955 RgnHandle cursor_region_handle
;
2957 unsigned long ref_con
, len
;
2959 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2961 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2963 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2965 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2968 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2969 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2978 /* If a subprocess is invoked with a shell, we receive 3 arguments
2979 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2980 bins>/<command> <command args>" */
2981 j
= strlen (argv
[0]);
2982 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2983 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2985 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2987 /* The arguments for the command in argv[2] are separated by
2988 spaces. Count them and put the count in newargc. */
2989 command
= (char *) alloca (strlen (argv
[2])+2);
2990 strcpy (command
, argv
[2]);
2991 if (command
[strlen (command
) - 1] != ' ')
2992 strcat (command
, " ");
2996 t
= mystrchr (t
, ' ');
3000 t
= mystrchr (t
+1, ' ');
3003 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3006 for (j
= 0; j
< newargc
; j
++)
3008 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3009 mystrcpy (newargv
[j
], t
);
3012 paramlen
+= strlen (newargv
[j
]) + 1;
3015 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3017 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3022 { /* sometimes Emacs call "sh" without a path for the command */
3024 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3025 strcpy (t
, "~emacs/");
3026 strcat (t
, newargv
[0]);
3029 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3030 make_number (X_OK
));
3034 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3038 strcpy (macappname
, tempmacpathname
);
3042 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3045 newargv
= (char **) alloca (sizeof (char *) * argc
);
3047 for (j
= 1; j
< argc
; j
++)
3049 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3051 char *t
= strchr (argv
[j
], ' ');
3054 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3055 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3056 tempcmdname
[t
-argv
[j
]] = '\0';
3057 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3060 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3062 strcpy (newargv
[j
], tempmaccmdname
);
3063 strcat (newargv
[j
], t
);
3067 char tempmaccmdname
[MAXPATHLEN
+1];
3068 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3071 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3072 strcpy (newargv
[j
], tempmaccmdname
);
3076 newargv
[j
] = argv
[j
];
3077 paramlen
+= strlen (newargv
[j
]) + 1;
3081 /* After expanding all the arguments, we now know the length of the
3082 parameter block to be sent to the subprocess as a message
3083 attached to the HLE. */
3084 param
= (char *) malloc (paramlen
+ 1);
3090 /* first byte of message contains number of arguments for command */
3091 strcpy (p
, macworkdir
);
3092 p
+= strlen (macworkdir
);
3094 /* null terminate strings sent so it's possible to use strcpy over there */
3095 strcpy (p
, macinfn
);
3096 p
+= strlen (macinfn
);
3098 strcpy (p
, macoutfn
);
3099 p
+= strlen (macoutfn
);
3101 strcpy (p
, macerrfn
);
3102 p
+= strlen (macerrfn
);
3104 for (j
= 1; j
< newargc
; j
++)
3106 strcpy (p
, newargv
[j
]);
3107 p
+= strlen (newargv
[j
]);
3111 c2pstr (macappname
);
3113 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3121 lpbr
.launchBlockID
= extendedBlock
;
3122 lpbr
.launchEPBLength
= extendedBlockLen
;
3123 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3124 lpbr
.launchAppSpec
= &spec
;
3125 lpbr
.launchAppParameters
= NULL
;
3127 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3134 send_event
.what
= kHighLevelEvent
;
3135 send_event
.message
= kEmacsSubprocessSend
;
3136 /* Event ID stored in "where" unused */
3139 /* OS may think current subprocess has terminated if previous one
3140 terminated recently. */
3143 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3144 paramlen
+ 1, receiverIDisPSN
);
3146 while (iErr
== sessClosedErr
&& retries
-- > 0);
3154 cursor_region_handle
= NewRgn ();
3156 /* Wait for the subprocess to finish, when it will send us a ERPY
3157 high level event. */
3159 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3160 cursor_region_handle
)
3161 && reply_event
.message
== kEmacsSubprocessReply
)
3164 /* The return code is sent through the refCon */
3165 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3168 DisposeHandle ((Handle
) cursor_region_handle
);
3173 DisposeHandle ((Handle
) cursor_region_handle
);
3177 #endif /* not TARGET_API_MAC_CARBON */
3182 opendir (const char *dirname
)
3184 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3185 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3189 int len
, vol_name_len
;
3191 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3194 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3196 fully_resolved_name
[len
] = '\0';
3198 strcpy (fully_resolved_name
, true_pathname
);
3200 dirp
= (DIR *) malloc (sizeof(DIR));
3204 /* Handle special case when dirname is "/": sets up for readir to
3205 get all mount volumes. */
3206 if (strcmp (fully_resolved_name
, "/") == 0)
3208 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3209 dirp
->current_index
= 1; /* index for first volume */
3213 /* Handle typical cases: not accessing all mounted volumes. */
3214 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3217 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3218 len
= strlen (mac_pathname
);
3219 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3220 strcat (mac_pathname
, ":");
3222 /* Extract volume name */
3223 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3224 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3225 vol_name
[vol_name_len
] = '\0';
3226 strcat (vol_name
, ":");
3228 c2pstr (mac_pathname
);
3229 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3230 /* using full pathname so vRefNum and DirID ignored */
3231 cipb
.hFileInfo
.ioVRefNum
= 0;
3232 cipb
.hFileInfo
.ioDirID
= 0;
3233 cipb
.hFileInfo
.ioFDirIndex
= 0;
3234 /* set to 0 to get information about specific dir or file */
3236 errno
= PBGetCatInfo (&cipb
, false);
3243 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3244 return 0; /* not a directory */
3246 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3247 dirp
->getting_volumes
= 0;
3248 dirp
->current_index
= 1; /* index for first file/directory */
3251 vpb
.ioNamePtr
= vol_name
;
3252 /* using full pathname so vRefNum and DirID ignored */
3254 vpb
.ioVolIndex
= -1;
3255 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3262 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3279 HParamBlockRec hpblock
;
3281 static struct dirent s_dirent
;
3282 static Str255 s_name
;
3286 /* Handle the root directory containing the mounted volumes. Call
3287 PBHGetVInfo specifying an index to obtain the info for a volume.
3288 PBHGetVInfo returns an error when it receives an index beyond the
3289 last volume, at which time we should return a nil dirent struct
3291 if (dp
->getting_volumes
)
3293 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3294 hpblock
.volumeParam
.ioVRefNum
= 0;
3295 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3297 errno
= PBHGetVInfo (&hpblock
, false);
3305 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3307 dp
->current_index
++;
3309 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3310 s_dirent
.d_name
= s_name
;
3316 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3317 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3318 /* location to receive filename returned */
3320 /* return only visible files */
3324 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3325 /* directory ID found by opendir */
3326 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3328 errno
= PBGetCatInfo (&cipb
, false);
3335 /* insist on a visible entry */
3336 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3337 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3339 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3341 dp
->current_index
++;
3354 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3355 /* value unimportant: non-zero for valid file */
3356 s_dirent
.d_name
= s_name
;
3366 char mac_pathname
[MAXPATHLEN
+1];
3367 Str255 directory_name
;
3371 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3374 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3380 #endif /* ! MAC_OSX */
3384 initialize_applescript ()
3389 /* if open fails, as_scripting_component is set to NULL. Its
3390 subsequent use in OSA calls will fail with badComponentInstance
3392 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3393 kAppleScriptSubtype
);
3395 null_desc
.descriptorType
= typeNull
;
3396 null_desc
.dataHandle
= 0;
3397 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3398 kOSANullScript
, &as_script_context
);
3400 as_script_context
= kOSANullScript
;
3401 /* use default context if create fails */
3406 terminate_applescript()
3408 OSADispose (as_scripting_component
, as_script_context
);
3409 CloseComponent (as_scripting_component
);
3412 /* Convert a lisp string to the 4 byte character code. */
3415 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3424 /* check type string */
3426 if (SBYTES (arg
) != 4)
3428 error ("Wrong argument: need string of length 4 for code");
3430 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3435 /* Convert the 4 byte character code into a 4 byte string. */
3438 mac_get_object_from_code(OSType defCode
)
3440 UInt32 code
= EndianU32_NtoB (defCode
);
3442 return make_unibyte_string ((char *)&code
, 4);
3446 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3447 doc
: /* Get the creator code of FILENAME as a four character string. */)
3449 Lisp_Object filename
;
3458 Lisp_Object result
= Qnil
;
3459 CHECK_STRING (filename
);
3461 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3464 filename
= Fexpand_file_name (filename
, Qnil
);
3468 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3470 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3473 if (status
== noErr
)
3476 FSCatalogInfo catalogInfo
;
3478 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3479 &catalogInfo
, NULL
, NULL
, NULL
);
3483 status
= FSpGetFInfo (&fss
, &finder_info
);
3485 if (status
== noErr
)
3488 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
3490 result
= mac_get_object_from_code (finder_info
.fdCreator
);
3495 if (status
!= noErr
) {
3496 error ("Error while getting file information.");
3501 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
3502 doc
: /* Get the type code of FILENAME as a four character string. */)
3504 Lisp_Object filename
;
3513 Lisp_Object result
= Qnil
;
3514 CHECK_STRING (filename
);
3516 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3519 filename
= Fexpand_file_name (filename
, Qnil
);
3523 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3525 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3528 if (status
== noErr
)
3531 FSCatalogInfo catalogInfo
;
3533 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3534 &catalogInfo
, NULL
, NULL
, NULL
);
3538 status
= FSpGetFInfo (&fss
, &finder_info
);
3540 if (status
== noErr
)
3543 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
3545 result
= mac_get_object_from_code (finder_info
.fdType
);
3550 if (status
!= noErr
) {
3551 error ("Error while getting file information.");
3556 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
3557 doc
: /* Set creator code of file FILENAME to CODE.
3558 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
3559 assumed. Return non-nil if successful. */)
3561 Lisp_Object filename
, code
;
3570 CHECK_STRING (filename
);
3572 cCode
= mac_get_code_from_arg(code
, 'EMAx');
3574 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3577 filename
= Fexpand_file_name (filename
, Qnil
);
3581 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3583 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3586 if (status
== noErr
)
3589 FSCatalogInfo catalogInfo
;
3591 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3592 &catalogInfo
, NULL
, NULL
, &parentDir
);
3596 status
= FSpGetFInfo (&fss
, &finder_info
);
3598 if (status
== noErr
)
3601 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
3602 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3603 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3605 finder_info
.fdCreator
= cCode
;
3606 status
= FSpSetFInfo (&fss
, &finder_info
);
3611 if (status
!= noErr
) {
3612 error ("Error while setting creator information.");
3617 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
3618 doc
: /* Set file code of file FILENAME to CODE.
3619 CODE must be a 4-character string. Return non-nil if successful. */)
3621 Lisp_Object filename
, code
;
3630 CHECK_STRING (filename
);
3632 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
3634 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3637 filename
= Fexpand_file_name (filename
, Qnil
);
3641 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3643 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3646 if (status
== noErr
)
3649 FSCatalogInfo catalogInfo
;
3651 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3652 &catalogInfo
, NULL
, NULL
, &parentDir
);
3656 status
= FSpGetFInfo (&fss
, &finder_info
);
3658 if (status
== noErr
)
3661 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
3662 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3663 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3665 finder_info
.fdType
= cCode
;
3666 status
= FSpSetFInfo (&fss
, &finder_info
);
3671 if (status
!= noErr
) {
3672 error ("Error while setting creator information.");
3678 /* Compile and execute the AppleScript SCRIPT and return the error
3679 status as function value. A zero is returned if compilation and
3680 execution is successful, in which case RESULT returns a pointer to
3681 a string containing the resulting script value. Otherwise, the Mac
3682 error code is returned and RESULT returns a pointer to an error
3683 string. In both cases the caller should deallocate the storage
3684 used by the string pointed to by RESULT if it is non-NULL. For
3685 documentation on the MacOS scripting architecture, see Inside
3686 Macintosh - Interapplication Communications: Scripting Components. */
3689 do_applescript (char *script
, char **result
)
3691 AEDesc script_desc
, result_desc
, error_desc
;
3698 if (!as_scripting_component
)
3699 initialize_applescript();
3701 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3705 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3706 typeChar
, kOSAModeNull
, &result_desc
);
3708 if (osaerror
== errOSAScriptError
)
3710 /* error executing AppleScript: retrieve error message */
3711 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3714 #if TARGET_API_MAC_CARBON
3715 length
= AEGetDescDataSize (&error_desc
);
3716 *result
= (char *) xmalloc (length
+ 1);
3719 AEGetDescData (&error_desc
, *result
, length
);
3720 *(*result
+ length
) = '\0';
3722 #else /* not TARGET_API_MAC_CARBON */
3723 HLock (error_desc
.dataHandle
);
3724 length
= GetHandleSize(error_desc
.dataHandle
);
3725 *result
= (char *) xmalloc (length
+ 1);
3728 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3729 *(*result
+ length
) = '\0';
3731 HUnlock (error_desc
.dataHandle
);
3732 #endif /* not TARGET_API_MAC_CARBON */
3733 AEDisposeDesc (&error_desc
);
3736 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3738 #if TARGET_API_MAC_CARBON
3739 length
= AEGetDescDataSize (&result_desc
);
3740 *result
= (char *) xmalloc (length
+ 1);
3743 AEGetDescData (&result_desc
, *result
, length
);
3744 *(*result
+ length
) = '\0';
3746 #else /* not TARGET_API_MAC_CARBON */
3747 HLock (result_desc
.dataHandle
);
3748 length
= GetHandleSize(result_desc
.dataHandle
);
3749 *result
= (char *) xmalloc (length
+ 1);
3752 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3753 *(*result
+ length
) = '\0';
3755 HUnlock (result_desc
.dataHandle
);
3756 #endif /* not TARGET_API_MAC_CARBON */
3757 AEDisposeDesc (&result_desc
);
3760 AEDisposeDesc (&script_desc
);
3766 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3767 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
3768 If compilation and execution are successful, the resulting script
3769 value is returned as a string. Otherwise the function aborts and
3770 displays the error message returned by the AppleScript scripting
3775 char *result
, *temp
;
3776 Lisp_Object lisp_result
;
3779 CHECK_STRING (script
);
3782 status
= do_applescript (SDATA (script
), &result
);
3787 error ("AppleScript error %d", status
);
3790 /* Unfortunately only OSADoScript in do_applescript knows how
3791 how large the resulting script value or error message is
3792 going to be and therefore as caller memory must be
3793 deallocated here. It is necessary to free the error
3794 message before calling error to avoid a memory leak. */
3795 temp
= (char *) alloca (strlen (result
) + 1);
3796 strcpy (temp
, result
);
3803 lisp_result
= build_string (result
);
3810 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3811 Smac_file_name_to_posix
, 1, 1, 0,
3812 doc
: /* Convert Macintosh FILENAME to Posix form. */)
3814 Lisp_Object filename
;
3816 char posix_filename
[MAXPATHLEN
+1];
3818 CHECK_STRING (filename
);
3820 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
3821 return build_string (posix_filename
);
3827 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3828 Sposix_file_name_to_mac
, 1, 1, 0,
3829 doc
: /* Convert Posix FILENAME to Mac form. */)
3831 Lisp_Object filename
;
3833 char mac_filename
[MAXPATHLEN
+1];
3835 CHECK_STRING (filename
);
3837 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
3838 return build_string (mac_filename
);
3844 #if TARGET_API_MAC_CARBON
3845 static Lisp_Object Qxml
, Qmime_charset
;
3846 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
3848 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3849 doc
: /* Return the application preference value for KEY.
3850 KEY is either a string specifying a preference key, or a list of key
3851 strings. If it is a list, the (i+1)-th element is used as a key for
3852 the CFDictionary value obtained by the i-th element. Return nil if
3853 lookup is failed at some stage.
3855 Optional arg APPLICATION is an application ID string. If omitted or
3856 nil, that stands for the current application.
3858 Optional arg FORMAT specifies the data format of the return value. If
3859 omitted or nil, each Core Foundation object is converted into a
3860 corresponding Lisp object as follows:
3862 Core Foundation Lisp Tag
3863 ------------------------------------------------------------
3864 CFString Multibyte string string
3865 CFNumber Integer or float number
3866 CFBoolean Symbol (t or nil) boolean
3867 CFDate List of three integers date
3868 (cf. `current-time')
3869 CFData Unibyte string data
3870 CFArray Vector array
3871 CFDictionary Alist or hash table dictionary
3872 (depending on HASH-BOUND)
3874 If it is t, a symbol that represents the type of the original Core
3875 Foundation object is prepended. If it is `xml', the value is returned
3876 as an XML representation.
3878 Optional arg HASH-BOUND specifies which kinds of the list objects,
3879 alists or hash tables, are used as the targets of the conversion from
3880 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3881 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3882 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3884 (key
, application
, format
, hash_bound
)
3885 Lisp_Object key
, application
, format
, hash_bound
;
3887 CFStringRef app_id
, key_str
;
3888 CFPropertyListRef app_plist
= NULL
, plist
;
3889 Lisp_Object result
= Qnil
, tmp
;
3892 key
= Fcons (key
, Qnil
);
3896 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3897 CHECK_STRING_CAR (tmp
);
3899 wrong_type_argument (Qlistp
, key
);
3901 if (!NILP (application
))
3902 CHECK_STRING (application
);
3903 CHECK_SYMBOL (format
);
3904 if (!NILP (hash_bound
))
3905 CHECK_NUMBER (hash_bound
);
3909 app_id
= kCFPreferencesCurrentApplication
;
3910 if (!NILP (application
))
3912 app_id
= cfstring_create_with_string (application
);
3916 key_str
= cfstring_create_with_string (XCAR (key
));
3917 if (key_str
== NULL
)
3919 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3920 CFRelease (key_str
);
3921 if (app_plist
== NULL
)
3925 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3927 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3929 key_str
= cfstring_create_with_string (XCAR (key
));
3930 if (key_str
== NULL
)
3932 plist
= CFDictionaryGetValue (plist
, key_str
);
3933 CFRelease (key_str
);
3939 if (EQ (format
, Qxml
))
3941 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3944 result
= cfdata_to_lisp (data
);
3949 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3950 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3954 CFRelease (app_plist
);
3963 static CFStringEncoding
3964 get_cfstring_encoding_from_lisp (obj
)
3967 CFStringRef iana_name
;
3968 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
3973 if (SYMBOLP (obj
) && !NILP (obj
) && !NILP (Fcoding_system_p (obj
)))
3975 Lisp_Object coding_spec
, plist
;
3977 coding_spec
= Fget (obj
, Qcoding_system
);
3978 plist
= XVECTOR (coding_spec
)->contents
[3];
3979 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
3983 obj
= SYMBOL_NAME (obj
);
3987 iana_name
= cfstring_create_with_string (obj
);
3990 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
3991 CFRelease (iana_name
);
3998 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4000 cfstring_create_normalized (str
, symbol
)
4005 TextEncodingVariant variant
;
4006 float initial_mag
= 0.0;
4007 CFStringRef result
= NULL
;
4009 if (EQ (symbol
, QNFD
))
4010 form
= kCFStringNormalizationFormD
;
4011 else if (EQ (symbol
, QNFKD
))
4012 form
= kCFStringNormalizationFormKD
;
4013 else if (EQ (symbol
, QNFC
))
4014 form
= kCFStringNormalizationFormC
;
4015 else if (EQ (symbol
, QNFKC
))
4016 form
= kCFStringNormalizationFormKC
;
4017 else if (EQ (symbol
, QHFS_plus_D
))
4019 variant
= kUnicodeHFSPlusDecompVariant
;
4022 else if (EQ (symbol
, QHFS_plus_C
))
4024 variant
= kUnicodeHFSPlusCompVariant
;
4030 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4034 CFStringNormalize (mut_str
, form
);
4038 else if (initial_mag
> 0.0)
4040 UnicodeToTextInfo uni
= NULL
;
4043 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4045 ByteCount out_read
, out_size
, out_len
;
4047 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4049 kTextEncodingDefaultFormat
);
4050 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4052 kTextEncodingDefaultFormat
);
4053 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4055 length
= CFStringGetLength (str
);
4056 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4060 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4061 if (in_text
== NULL
)
4063 buffer
= xmalloc (sizeof (UniChar
) * length
);
4066 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4072 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4073 while (err
== noErr
)
4075 out_buf
= xmalloc (out_size
);
4076 if (out_buf
== NULL
)
4079 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4081 kUnicodeDefaultDirectionMask
,
4082 0, NULL
, NULL
, NULL
,
4083 out_size
, &out_read
, &out_len
,
4085 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4094 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4095 out_len
/ sizeof (UniChar
));
4097 DisposeUnicodeToTextInfo (&uni
);
4113 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4114 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4115 The conversion is performed using the converter provided by the system.
4116 Each encoding is specified by either a coding system symbol, a mime
4117 charset string, or an integer as a CFStringEncoding value.
4118 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4119 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4120 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4121 On successful conversion, return the result string, else return nil. */)
4122 (string
, source
, target
, normalization_form
)
4123 Lisp_Object string
, source
, target
, normalization_form
;
4125 Lisp_Object result
= Qnil
;
4126 CFStringEncoding src_encoding
, tgt_encoding
;
4127 CFStringRef str
= NULL
;
4128 CFDataRef data
= NULL
;
4130 CHECK_STRING (string
);
4131 if (!INTEGERP (source
) && !STRINGP (source
))
4132 CHECK_SYMBOL (source
);
4133 if (!INTEGERP (target
) && !STRINGP (target
))
4134 CHECK_SYMBOL (target
);
4135 CHECK_SYMBOL (normalization_form
);
4139 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4140 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4142 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4143 use string_as_unibyte which works as well, except for the fact that
4144 it's too permissive (it doesn't check that the multibyte string only
4145 contain single-byte chars). */
4146 string
= Fstring_as_unibyte (string
);
4147 if (src_encoding
!= kCFStringEncodingInvalidId
4148 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4149 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4150 src_encoding
, true);
4151 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4154 CFStringRef saved_str
= str
;
4156 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4157 CFRelease (saved_str
);
4162 data
= CFStringCreateExternalRepresentation (NULL
, str
,
4163 tgt_encoding
, '\0');
4168 result
= cfdata_to_lisp (data
);
4176 #endif /* TARGET_API_MAC_CARBON */
4179 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4180 doc
: /* Clear the font name table. */)
4184 mac_clear_font_name_table ();
4191 extern int inhibit_window_system
;
4192 extern int noninteractive
;
4194 /* Unlike in X11, window events in Carbon do not come from sockets.
4195 So we cannot simply use `select' to monitor two kinds of inputs:
4196 window events and process outputs. We emulate such functionality
4197 by regarding fd 0 as the window event channel and simultaneously
4198 monitoring both kinds of input channels. It is implemented by
4199 dividing into some cases:
4200 1. The window event channel is not involved.
4202 2. Sockets are not involved.
4203 -> Use ReceiveNextEvent.
4204 3. [If SELECT_USE_CFSOCKET is defined]
4205 Only the window event channel and socket read channels are
4206 involved, and timeout is not too short (greater than
4207 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4208 -> Create CFSocket for each socket and add it into the current
4209 event RunLoop so that an `ready-to-read' event can be posted
4210 to the event queue that is also used for window events. Then
4211 ReceiveNextEvent can wait for both kinds of inputs.
4213 -> Periodically poll the window input channel while repeatedly
4214 executing `select' with a short timeout
4215 (SELECT_POLLING_PERIOD_USEC microseconds). */
4217 #define SELECT_POLLING_PERIOD_USEC 20000
4218 #ifdef SELECT_USE_CFSOCKET
4219 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4220 #define EVENT_CLASS_SOCK 'Sock'
4223 socket_callback (s
, type
, address
, data
, info
)
4225 CFSocketCallBackType type
;
4232 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4233 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4234 ReleaseEvent (event
);
4236 #endif /* SELECT_USE_CFSOCKET */
4239 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4244 struct timeval
*timeout
;
4249 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4253 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4254 kEventLeaveInQueue
, NULL
);
4265 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4266 #undef SELECT_INVALIDATE_CFSOCKET
4270 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4275 struct timeval
*timeout
;
4279 EMACS_TIME select_timeout
;
4281 if (inhibit_window_system
|| noninteractive
4282 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4283 return select (n
, rfds
, wfds
, efds
, timeout
);
4287 if (wfds
== NULL
&& efds
== NULL
)
4290 SELECT_TYPE orfds
= *rfds
;
4292 EventTimeout timeout_sec
=
4294 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4295 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4296 : kEventDurationForever
);
4298 for (i
= 1; i
< n
; i
++)
4299 if (FD_ISSET (i
, rfds
))
4305 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4306 kEventLeaveInQueue
, NULL
);
4317 /* Avoid initial overhead of RunLoop setup for the case that
4318 some input is already available. */
4319 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4320 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4321 if (r
!= 0 || timeout_sec
== 0.0)
4326 #ifdef SELECT_USE_CFSOCKET
4327 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4328 goto poll_periodically
;
4331 CFRunLoopRef runloop
=
4332 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4333 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4334 #ifdef SELECT_INVALIDATE_CFSOCKET
4335 CFSocketRef
*shead
, *s
;
4337 CFRunLoopSourceRef
*shead
, *s
;
4342 #ifdef SELECT_INVALIDATE_CFSOCKET
4343 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4345 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4348 for (i
= 1; i
< n
; i
++)
4349 if (FD_ISSET (i
, rfds
))
4351 CFSocketRef socket
=
4352 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4353 socket_callback
, NULL
);
4354 CFRunLoopSourceRef source
=
4355 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4357 #ifdef SELECT_INVALIDATE_CFSOCKET
4358 CFSocketSetSocketFlags (socket
, 0);
4360 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4361 #ifdef SELECT_INVALIDATE_CFSOCKET
4371 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4376 #ifdef SELECT_INVALIDATE_CFSOCKET
4377 CFSocketInvalidate (*s
);
4379 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4394 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4395 GetEventTypeCount (specs
),
4397 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4398 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4405 #endif /* SELECT_USE_CFSOCKET */
4410 EMACS_TIME end_time
, now
, remaining_time
;
4411 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4419 remaining_time
= *timeout
;
4420 EMACS_GET_TIME (now
);
4421 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4426 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4427 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4428 select_timeout
= remaining_time
;
4429 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4441 EMACS_GET_TIME (now
);
4442 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4445 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4456 /* Set up environment variables so that Emacs can correctly find its
4457 support files when packaged as an application bundle. Directories
4458 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4459 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4460 by `make install' by default can instead be placed in
4461 .../Emacs.app/Contents/Resources/ and
4462 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4463 is changed only if it is not already set. Presumably if the user
4464 sets an environment variable, he will want to use files in his path
4465 instead of ones in the application bundle. */
4467 init_mac_osx_environment ()
4471 CFStringRef cf_app_bundle_pathname
;
4472 int app_bundle_pathname_len
;
4473 char *app_bundle_pathname
;
4477 /* Fetch the pathname of the application bundle as a C string into
4478 app_bundle_pathname. */
4480 bundle
= CFBundleGetMainBundle ();
4481 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
4483 /* We could not find the bundle identifier. For now, prevent
4484 the fatal error by bringing it up in the terminal. */
4485 inhibit_window_system
= 1;
4489 bundleURL
= CFBundleCopyBundleURL (bundle
);
4493 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4494 kCFURLPOSIXPathStyle
);
4495 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4496 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4498 if (!CFStringGetCString (cf_app_bundle_pathname
,
4499 app_bundle_pathname
,
4500 app_bundle_pathname_len
+ 1,
4501 kCFStringEncodingISOLatin1
))
4503 CFRelease (cf_app_bundle_pathname
);
4507 CFRelease (cf_app_bundle_pathname
);
4509 /* P should have sufficient room for the pathname of the bundle plus
4510 the subpath in it leading to the respective directories. Q
4511 should have three times that much room because EMACSLOADPATH can
4512 have the value "<path to lisp dir>:<path to leim dir>:<path to
4514 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4515 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4516 if (!getenv ("EMACSLOADPATH"))
4520 strcpy (p
, app_bundle_pathname
);
4521 strcat (p
, "/Contents/Resources/lisp");
4522 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4525 strcpy (p
, app_bundle_pathname
);
4526 strcat (p
, "/Contents/Resources/leim");
4527 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4534 strcpy (p
, app_bundle_pathname
);
4535 strcat (p
, "/Contents/Resources/site-lisp");
4536 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4544 setenv ("EMACSLOADPATH", q
, 1);
4547 if (!getenv ("EMACSPATH"))
4551 strcpy (p
, app_bundle_pathname
);
4552 strcat (p
, "/Contents/MacOS/libexec");
4553 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4556 strcpy (p
, app_bundle_pathname
);
4557 strcat (p
, "/Contents/MacOS/bin");
4558 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4566 setenv ("EMACSPATH", q
, 1);
4569 if (!getenv ("EMACSDATA"))
4571 strcpy (p
, app_bundle_pathname
);
4572 strcat (p
, "/Contents/Resources/etc");
4573 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4574 setenv ("EMACSDATA", p
, 1);
4577 if (!getenv ("EMACSDOC"))
4579 strcpy (p
, app_bundle_pathname
);
4580 strcat (p
, "/Contents/Resources/etc");
4581 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4582 setenv ("EMACSDOC", p
, 1);
4585 if (!getenv ("INFOPATH"))
4587 strcpy (p
, app_bundle_pathname
);
4588 strcat (p
, "/Contents/Resources/info");
4589 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4590 setenv ("INFOPATH", p
, 1);
4593 #endif /* MAC_OSX */
4597 mac_get_system_locale ()
4605 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4606 region
= GetScriptManagerVariable (smRegionCode
);
4607 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4609 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4612 return build_string (str
);
4621 #if TARGET_API_MAC_CARBON
4622 Qstring
= intern ("string"); staticpro (&Qstring
);
4623 Qnumber
= intern ("number"); staticpro (&Qnumber
);
4624 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
4625 Qdate
= intern ("date"); staticpro (&Qdate
);
4626 Qdata
= intern ("data"); staticpro (&Qdata
);
4627 Qarray
= intern ("array"); staticpro (&Qarray
);
4628 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
4630 Qxml
= intern ("xml");
4633 Qmime_charset
= intern ("mime-charset");
4634 staticpro (&Qmime_charset
);
4636 QNFD
= intern ("NFD"); staticpro (&QNFD
);
4637 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
4638 QNFC
= intern ("NFC"); staticpro (&QNFC
);
4639 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
4640 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
4641 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
4644 #if TARGET_API_MAC_CARBON
4645 defsubr (&Smac_get_preference
);
4646 defsubr (&Smac_code_convert_string
);
4648 defsubr (&Smac_clear_font_name_table
);
4650 defsubr (&Smac_set_file_creator
);
4651 defsubr (&Smac_set_file_type
);
4652 defsubr (&Smac_get_file_creator
);
4653 defsubr (&Smac_get_file_type
);
4654 defsubr (&Sdo_applescript
);
4655 defsubr (&Smac_file_name_to_posix
);
4656 defsubr (&Sposix_file_name_to_mac
);
4658 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
4659 doc
: /* The system script code. */);
4660 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4662 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
4663 doc
: /* The system locale identifier string.
4664 This is not a POSIX locale ID, but an ICU locale ID. So encoding
4665 information is not included. */);
4666 Vmac_system_locale
= mac_get_system_locale ();
4669 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4670 (do not change this comment) */