1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
33 #include "sysselect.h"
34 #include "blockinput.h"
40 #if !TARGET_API_MAC_CARBON
43 #include <TextUtils.h>
45 #include <Resources.h>
50 #include <AppleScript.h>
53 #include <Processes.h>
55 #include <MacLocales.h>
57 #endif /* not TARGET_API_MAC_CARBON */
61 #include <sys/types.h>
65 #include <sys/param.h>
71 /* The system script code. */
72 static int mac_system_script_code
;
74 /* The system locale identifier string. */
75 static Lisp_Object Vmac_system_locale
;
77 /* An instance of the AppleScript component. */
78 static ComponentInstance as_scripting_component
;
79 /* The single script context used for all script executions. */
80 static OSAID as_script_context
;
83 /* When converting from Mac to Unix pathnames, /'s in folder names are
84 converted to :'s. This function, used in copying folder names,
85 performs a strncat and converts all character a to b in the copy of
86 the string s2 appended to the end of s1. */
89 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
97 for (i
= 0; i
< l2
; i
++)
106 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
107 that does not begin with a ':' and contains at least one ':'. A Mac
108 full pathname causes a '/' to be prepended to the Posix pathname.
109 The algorithm for the rest of the pathname is as follows:
110 For each segment between two ':',
111 if it is non-null, copy as is and then add a '/' at the end,
112 otherwise, insert a "../" into the Posix pathname.
113 Returns 1 if successful; 0 if fails. */
116 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
118 const char *p
, *q
, *pe
;
125 p
= strchr (mfn
, ':');
126 if (p
!= 0 && p
!= mfn
) /* full pathname */
133 pe
= mfn
+ strlen (mfn
);
140 { /* two consecutive ':' */
141 if (strlen (ufn
) + 3 >= ufnbuflen
)
147 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
149 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
156 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
158 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
159 /* no separator for last one */
168 extern char *get_temp_dir_name ();
171 /* Convert a Posix pathname to Mac form. Approximately reverse of the
172 above in algorithm. */
175 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
177 const char *p
, *q
, *pe
;
178 char expanded_pathname
[MAXPATHLEN
+1];
187 /* Check for and handle volume names. Last comparison: strangely
188 somewhere "/.emacs" is passed. A temporary fix for now. */
189 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
191 if (strlen (p
) + 1 > mfnbuflen
)
198 /* expand to emacs dir found by init_emacs_passwd_dir */
199 if (strncmp (p
, "~emacs/", 7) == 0)
201 struct passwd
*pw
= getpwnam ("emacs");
203 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
205 strcpy (expanded_pathname
, pw
->pw_dir
);
206 strcat (expanded_pathname
, p
);
207 p
= expanded_pathname
;
208 /* now p points to the pathname with emacs dir prefix */
210 else if (strncmp (p
, "/tmp/", 5) == 0)
212 char *t
= get_temp_dir_name ();
214 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
216 strcpy (expanded_pathname
, t
);
217 strcat (expanded_pathname
, p
);
218 p
= expanded_pathname
;
219 /* now p points to the pathname with emacs dir prefix */
221 else if (*p
!= '/') /* relative pathname */
233 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
235 if (strlen (mfn
) + 1 >= mfnbuflen
)
241 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
243 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
250 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
252 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
261 /***********************************************************************
262 Conversions on Apple event objects
263 ***********************************************************************/
265 static Lisp_Object Qundecoded_file_name
;
268 mac_aelist_to_lisp (desc_list
)
269 AEDescList
*desc_list
;
273 Lisp_Object result
, elem
;
279 err
= AECountItems (desc_list
, &count
);
285 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
292 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
296 elem
= mac_aelist_to_lisp (&desc
);
297 AEDisposeDesc (&desc
);
301 if (desc_type
== typeNull
)
305 elem
= make_uninit_string (size
);
306 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
307 &desc_type
, SDATA (elem
), size
, &size
);
311 desc_type
= EndianU32_NtoB (desc_type
);
312 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
318 else if (desc_list
->descriptorType
!= typeAEList
)
320 keyword
= EndianU32_NtoB (keyword
);
321 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
324 result
= Fcons (elem
, result
);
328 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
329 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
333 mac_aedesc_to_lisp (desc
)
337 DescType desc_type
= desc
->descriptorType
;
349 return mac_aelist_to_lisp (desc
);
351 /* The following one is much simpler, but creates and disposes
352 of Apple event descriptors many times. */
359 err
= AECountItems (desc
, &count
);
365 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
368 elem
= mac_aedesc_to_lisp (&desc1
);
369 AEDisposeDesc (&desc1
);
370 if (desc_type
!= typeAEList
)
372 keyword
= EndianU32_NtoB (keyword
);
373 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
375 result
= Fcons (elem
, result
);
383 #if TARGET_API_MAC_CARBON
384 result
= make_uninit_string (AEGetDescDataSize (desc
));
385 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
387 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
388 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
396 desc_type
= EndianU32_NtoB (desc_type
);
397 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
400 #if TARGET_API_MAC_CARBON
402 create_apple_event_from_event_ref (event
, num_params
, names
,
403 types
, sizes
, result
)
406 EventParamName
*names
;
407 EventParamType
*types
;
412 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
413 AEAddressDesc address_desc
;
419 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
420 sizeof (ProcessSerialNumber
), &address_desc
);
423 err
= AECreateAppleEvent (0, 0, /* Dummy class and ID. */
424 &address_desc
, /* NULL is not allowed
425 on Mac OS Classic. */
426 kAutoGenerateReturnID
,
427 kAnyTransactionID
, result
);
428 AEDisposeDesc (&address_desc
);
433 for (i
= 0; i
< num_params
; i
++)
437 case typeCFStringRef
:
438 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
439 sizeof (CFStringRef
), NULL
, &string
);
442 data
= CFStringCreateExternalRepresentation (NULL
, string
,
443 kCFStringEncodingUTF8
,
447 /* typeUTF8Text is not available on Mac OS X 10.1. */
448 AEPutParamPtr (result
, names
[i
], 'utf8',
449 CFDataGetBytePtr (data
), CFDataGetLength (data
));
455 buf
= xmalloc (sizes
[i
]);
458 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
459 sizes
[i
], NULL
, buf
);
461 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, sizes
[i
]);
471 /***********************************************************************
472 Conversion between Lisp and Core Foundation objects
473 ***********************************************************************/
475 #if TARGET_API_MAC_CARBON
476 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
477 static Lisp_Object Qarray
, Qdictionary
;
479 struct cfdict_context
482 int with_tag
, hash_bound
;
485 /* C string to CFString. */
488 cfstring_create_with_utf8_cstring (c_str
)
493 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
495 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
496 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
502 /* Lisp string to CFString. */
505 cfstring_create_with_string (s
)
508 CFStringRef string
= NULL
;
510 if (STRING_MULTIBYTE (s
))
512 char *p
, *end
= SDATA (s
) + SBYTES (s
);
514 for (p
= SDATA (s
); p
< end
; p
++)
517 s
= ENCODE_UTF_8 (s
);
520 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
521 kCFStringEncodingUTF8
, false);
525 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
526 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
527 kCFStringEncodingMacRoman
, false);
533 /* From CFData to a lisp string. Always returns a unibyte string. */
536 cfdata_to_lisp (data
)
539 CFIndex len
= CFDataGetLength (data
);
540 Lisp_Object result
= make_uninit_string (len
);
542 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
548 /* From CFString to a lisp string. Returns a unibyte string
549 containing a UTF-8 byte sequence. */
552 cfstring_to_lisp_nodecode (string
)
555 Lisp_Object result
= Qnil
;
556 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
559 result
= make_unibyte_string (s
, strlen (s
));
563 CFStringCreateExternalRepresentation (NULL
, string
,
564 kCFStringEncodingUTF8
, '?');
568 result
= cfdata_to_lisp (data
);
577 /* From CFString to a lisp string. Never returns a unibyte string
578 (even if it only contains ASCII characters).
579 This may cause GC during code conversion. */
582 cfstring_to_lisp (string
)
585 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
589 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
590 /* This may be superfluous. Just to make sure that the result
591 is a multibyte string. */
592 result
= string_to_multibyte (result
);
599 /* CFNumber to a lisp integer or a lisp float. */
602 cfnumber_to_lisp (number
)
605 Lisp_Object result
= Qnil
;
606 #if BITS_PER_EMACS_INT > 32
608 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
611 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
615 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
616 && !FIXNUM_OVERFLOW_P (int_val
))
617 result
= make_number (int_val
);
619 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
620 result
= make_float (float_val
);
625 /* CFDate to a list of three integers as in a return value of
629 cfdate_to_lisp (date
)
632 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
633 static CFAbsoluteTime epoch
= 0.0, sec
;
637 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
639 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
640 high
= sec
/ 65536.0;
641 low
= sec
- high
* 65536.0;
643 return list3 (make_number (high
), make_number (low
), make_number (0));
647 /* CFBoolean to a lisp symbol, `t' or `nil'. */
650 cfboolean_to_lisp (boolean
)
651 CFBooleanRef boolean
;
653 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
657 /* Any Core Foundation object to a (lengthy) lisp string. */
660 cfobject_desc_to_lisp (object
)
663 Lisp_Object result
= Qnil
;
664 CFStringRef desc
= CFCopyDescription (object
);
668 result
= cfstring_to_lisp (desc
);
676 /* Callback functions for cfproperty_list_to_lisp. */
679 cfdictionary_add_to_list (key
, value
, context
)
684 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
687 Fcons (Fcons (cfstring_to_lisp (key
),
688 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
694 cfdictionary_puthash (key
, value
, context
)
699 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
700 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
701 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
704 hash_lookup (h
, lisp_key
, &hash_code
);
705 hash_put (h
, lisp_key
,
706 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
711 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
712 non-zero, a symbol that represents the type of the original Core
713 Foundation object is prepended. HASH_BOUND specifies which kinds
714 of the lisp objects, alists or hash tables, are used as the targets
715 of the conversion from CFDictionary. If HASH_BOUND is negative,
716 always generate alists. If HASH_BOUND >= 0, generate an alist if
717 the number of keys in the dictionary is smaller than HASH_BOUND,
718 and a hash table otherwise. */
721 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
722 CFPropertyListRef plist
;
723 int with_tag
, hash_bound
;
725 CFTypeID type_id
= CFGetTypeID (plist
);
726 Lisp_Object tag
= Qnil
, result
= Qnil
;
727 struct gcpro gcpro1
, gcpro2
;
729 GCPRO2 (tag
, result
);
731 if (type_id
== CFStringGetTypeID ())
734 result
= cfstring_to_lisp (plist
);
736 else if (type_id
== CFNumberGetTypeID ())
739 result
= cfnumber_to_lisp (plist
);
741 else if (type_id
== CFBooleanGetTypeID ())
744 result
= cfboolean_to_lisp (plist
);
746 else if (type_id
== CFDateGetTypeID ())
749 result
= cfdate_to_lisp (plist
);
751 else if (type_id
== CFDataGetTypeID ())
754 result
= cfdata_to_lisp (plist
);
756 else if (type_id
== CFArrayGetTypeID ())
758 CFIndex index
, count
= CFArrayGetCount (plist
);
761 result
= Fmake_vector (make_number (count
), Qnil
);
762 for (index
= 0; index
< count
; index
++)
763 XVECTOR (result
)->contents
[index
] =
764 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
765 with_tag
, hash_bound
);
767 else if (type_id
== CFDictionaryGetTypeID ())
769 struct cfdict_context context
;
770 CFIndex count
= CFDictionaryGetCount (plist
);
773 context
.result
= &result
;
774 context
.with_tag
= with_tag
;
775 context
.hash_bound
= hash_bound
;
776 if (hash_bound
< 0 || count
< hash_bound
)
779 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
784 result
= make_hash_table (Qequal
,
786 make_float (DEFAULT_REHASH_SIZE
),
787 make_float (DEFAULT_REHASH_THRESHOLD
),
789 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
799 result
= Fcons (tag
, result
);
806 /***********************************************************************
807 Emulation of the X Resource Manager
808 ***********************************************************************/
810 /* Parser functions for resource lines. Each function takes an
811 address of a variable whose value points to the head of a string.
812 The value will be advanced so that it points to the next character
813 of the parsed part when the function returns.
815 A resource name such as "Emacs*font" is parsed into a non-empty
816 list called `quarks'. Each element is either a Lisp string that
817 represents a concrete component, a Lisp symbol LOOSE_BINDING
818 (actually Qlambda) that represents any number (>=0) of intervening
819 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
820 that represents as any single component. */
824 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
825 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
831 /* WhiteSpace = {<space> | <horizontal tab>} */
832 while (*P
== ' ' || *P
== '\t')
840 /* Comment = "!" {<any character except null or newline>} */
853 /* Don't interpret filename. Just skip until the newline. */
855 parse_include_file (p
)
858 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
875 /* Binding = "." | "*" */
876 if (*P
== '.' || *P
== '*')
880 while (*P
== '.' || *P
== '*')
893 /* Component = "?" | ComponentName
894 ComponentName = NameChar {NameChar}
895 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
899 return SINGLE_COMPONENT
;
901 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
905 while (isalnum (*P
) || *P
== '_' || *P
== '-')
908 return make_unibyte_string (start
, P
- start
);
915 parse_resource_name (p
)
918 Lisp_Object result
= Qnil
, component
;
921 /* ResourceName = [Binding] {Component Binding} ComponentName */
922 if (parse_binding (p
) == '*')
923 result
= Fcons (LOOSE_BINDING
, result
);
925 component
= parse_component (p
);
926 if (NILP (component
))
929 result
= Fcons (component
, result
);
930 while ((binding
= parse_binding (p
)) != '\0')
933 result
= Fcons (LOOSE_BINDING
, result
);
934 component
= parse_component (p
);
935 if (NILP (component
))
938 result
= Fcons (component
, result
);
941 /* The final component should not be '?'. */
942 if (EQ (component
, SINGLE_COMPONENT
))
945 return Fnreverse (result
);
953 Lisp_Object seq
= Qnil
, result
;
954 int buf_len
, total_len
= 0, len
, continue_p
;
956 q
= strchr (P
, '\n');
957 buf_len
= q
? q
- P
: strlen (P
);
958 buf
= xmalloc (buf_len
);
987 else if ('0' <= P
[0] && P
[0] <= '7'
988 && '0' <= P
[1] && P
[1] <= '7'
989 && '0' <= P
[2] && P
[2] <= '7')
991 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
1001 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1006 q
= strchr (P
, '\n');
1007 len
= q
? q
- P
: strlen (P
);
1012 buf
= xmalloc (buf_len
);
1020 if (SBYTES (XCAR (seq
)) == total_len
)
1021 return make_string (SDATA (XCAR (seq
)), total_len
);
1024 buf
= xmalloc (total_len
);
1025 q
= buf
+ total_len
;
1026 for (; CONSP (seq
); seq
= XCDR (seq
))
1028 len
= SBYTES (XCAR (seq
));
1030 memcpy (q
, SDATA (XCAR (seq
)), len
);
1032 result
= make_string (buf
, total_len
);
1039 parse_resource_line (p
)
1042 Lisp_Object quarks
, value
;
1044 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1045 if (parse_comment (p
) || parse_include_file (p
))
1048 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1049 skip_white_space (p
);
1050 quarks
= parse_resource_name (p
);
1053 skip_white_space (p
);
1057 skip_white_space (p
);
1058 value
= parse_value (p
);
1059 return Fcons (quarks
, value
);
1062 /* Skip the remaining data as a dummy value. */
1069 /* Equivalents of X Resource Manager functions.
1071 An X Resource Database acts as a collection of resource names and
1072 associated values. It is implemented as a trie on quarks. Namely,
1073 each edge is labeled by either a string, LOOSE_BINDING, or
1074 SINGLE_COMPONENT. Each node has a node id, which is a unique
1075 nonnegative integer, and the root node id is 0. A database is
1076 implemented as a hash table that maps a pair (SRC-NODE-ID .
1077 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1078 in the table as a value for HASHKEY_MAX_NID. A value associated to
1079 a node is recorded as a value for the node id.
1081 A database also has a cache for past queries as a value for
1082 HASHKEY_QUERY_CACHE. It is another hash table that maps
1083 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1085 #define HASHKEY_MAX_NID (make_number (0))
1086 #define HASHKEY_QUERY_CACHE (make_number (-1))
1089 xrm_create_database ()
1091 XrmDatabase database
;
1093 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1094 make_float (DEFAULT_REHASH_SIZE
),
1095 make_float (DEFAULT_REHASH_THRESHOLD
),
1097 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1098 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1104 xrm_q_put_resource (database
, quarks
, value
)
1105 XrmDatabase database
;
1106 Lisp_Object quarks
, value
;
1108 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1111 Lisp_Object node_id
, key
;
1113 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1115 XSETINT (node_id
, 0);
1116 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1118 key
= Fcons (node_id
, XCAR (quarks
));
1119 i
= hash_lookup (h
, key
, &hash_code
);
1123 XSETINT (node_id
, max_nid
);
1124 hash_put (h
, key
, node_id
, hash_code
);
1127 node_id
= HASH_VALUE (h
, i
);
1129 Fputhash (node_id
, value
, database
);
1131 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1132 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1135 /* Merge multiple resource entries specified by DATA into a resource
1136 database DATABASE. DATA points to the head of a null-terminated
1137 string consisting of multiple resource lines. It's like a
1138 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1141 xrm_merge_string_database (database
, data
)
1142 XrmDatabase database
;
1145 Lisp_Object quarks_value
;
1149 quarks_value
= parse_resource_line (&data
);
1150 if (!NILP (quarks_value
))
1151 xrm_q_put_resource (database
,
1152 XCAR (quarks_value
), XCDR (quarks_value
));
1157 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1158 XrmDatabase database
;
1159 Lisp_Object node_id
, quark_name
, quark_class
;
1161 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1162 Lisp_Object key
, labels
[3], value
;
1165 if (!CONSP (quark_name
))
1166 return Fgethash (node_id
, database
, Qnil
);
1168 /* First, try tight bindings */
1169 labels
[0] = XCAR (quark_name
);
1170 labels
[1] = XCAR (quark_class
);
1171 labels
[2] = SINGLE_COMPONENT
;
1173 key
= Fcons (node_id
, Qnil
);
1174 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1176 XSETCDR (key
, labels
[k
]);
1177 i
= hash_lookup (h
, key
, NULL
);
1180 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1181 XCDR (quark_name
), XCDR (quark_class
));
1187 /* Then, try loose bindings */
1188 XSETCDR (key
, LOOSE_BINDING
);
1189 i
= hash_lookup (h
, key
, NULL
);
1192 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1193 quark_name
, quark_class
);
1197 return xrm_q_get_resource_1 (database
, node_id
,
1198 XCDR (quark_name
), XCDR (quark_class
));
1205 xrm_q_get_resource (database
, quark_name
, quark_class
)
1206 XrmDatabase database
;
1207 Lisp_Object quark_name
, quark_class
;
1209 return xrm_q_get_resource_1 (database
, make_number (0),
1210 quark_name
, quark_class
);
1213 /* Retrieve a resource value for the specified NAME and CLASS from the
1214 resource database DATABASE. It corresponds to XrmGetResource. */
1217 xrm_get_resource (database
, name
, class)
1218 XrmDatabase database
;
1221 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1223 struct Lisp_Hash_Table
*h
;
1227 nc
= strlen (class);
1228 key
= make_uninit_string (nn
+ nc
+ 1);
1229 strcpy (SDATA (key
), name
);
1230 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1232 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1233 if (NILP (query_cache
))
1235 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1236 make_float (DEFAULT_REHASH_SIZE
),
1237 make_float (DEFAULT_REHASH_THRESHOLD
),
1239 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1241 h
= XHASH_TABLE (query_cache
);
1242 i
= hash_lookup (h
, key
, &hash_code
);
1244 return HASH_VALUE (h
, i
);
1246 quark_name
= parse_resource_name (&name
);
1249 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1250 if (!STRINGP (XCAR (tmp
)))
1253 quark_class
= parse_resource_name (&class);
1256 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1257 if (!STRINGP (XCAR (tmp
)))
1264 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1265 hash_put (h
, key
, tmp
, hash_code
);
1270 #if TARGET_API_MAC_CARBON
1272 xrm_cfproperty_list_to_value (plist
)
1273 CFPropertyListRef plist
;
1275 CFTypeID type_id
= CFGetTypeID (plist
);
1277 if (type_id
== CFStringGetTypeID ())
1278 return cfstring_to_lisp (plist
);
1279 else if (type_id
== CFNumberGetTypeID ())
1282 Lisp_Object result
= Qnil
;
1284 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1287 result
= cfstring_to_lisp (string
);
1292 else if (type_id
== CFBooleanGetTypeID ())
1293 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1294 else if (type_id
== CFDataGetTypeID ())
1295 return cfdata_to_lisp (plist
);
1301 /* Create a new resource database from the preferences for the
1302 application APPLICATION. APPLICATION is either a string that
1303 specifies an application ID, or NULL that represents the current
1307 xrm_get_preference_database (application
)
1310 #if TARGET_API_MAC_CARBON
1311 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1312 CFMutableSetRef key_set
= NULL
;
1313 CFArrayRef key_array
;
1314 CFIndex index
, count
;
1316 XrmDatabase database
;
1317 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1318 CFPropertyListRef plist
;
1320 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1322 user_doms
[0] = kCFPreferencesCurrentUser
;
1323 user_doms
[1] = kCFPreferencesAnyUser
;
1324 host_doms
[0] = kCFPreferencesCurrentHost
;
1325 host_doms
[1] = kCFPreferencesAnyHost
;
1327 database
= xrm_create_database ();
1329 GCPRO3 (database
, quarks
, value
);
1333 app_id
= kCFPreferencesCurrentApplication
;
1336 app_id
= cfstring_create_with_utf8_cstring (application
);
1341 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1342 if (key_set
== NULL
)
1344 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1345 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1347 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1351 count
= CFArrayGetCount (key_array
);
1352 for (index
= 0; index
< count
; index
++)
1353 CFSetAddValue (key_set
,
1354 CFArrayGetValueAtIndex (key_array
, index
));
1355 CFRelease (key_array
);
1359 count
= CFSetGetCount (key_set
);
1360 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1363 CFSetGetValues (key_set
, (const void **)keys
);
1364 for (index
= 0; index
< count
; index
++)
1366 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1367 quarks
= parse_resource_name (&res_name
);
1368 if (!(NILP (quarks
) || *res_name
))
1370 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1371 value
= xrm_cfproperty_list_to_value (plist
);
1374 xrm_q_put_resource (database
, quarks
, value
);
1381 CFRelease (key_set
);
1390 return xrm_create_database ();
1397 /* The following functions with "sys_" prefix are stubs to Unix
1398 functions that have already been implemented by CW or MPW. The
1399 calls to them in Emacs source course are #define'd to call the sys_
1400 versions by the header files s-mac.h. In these stubs pathnames are
1401 converted between their Unix and Mac forms. */
1404 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1405 + 17 leap days. These are for adjusting time values returned by
1406 MacOS Toolbox functions. */
1408 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1411 #if __MSL__ < 0x6000
1412 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1413 a leap year! This is for adjusting time_t values returned by MSL
1415 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1416 #else /* __MSL__ >= 0x6000 */
1417 /* CW changes Pro 6 to follow Unix! */
1418 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1419 #endif /* __MSL__ >= 0x6000 */
1421 /* MPW library functions follow Unix (confused?). */
1422 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1423 #else /* not __MRC__ */
1425 #endif /* not __MRC__ */
1428 /* Define our own stat function for both MrC and CW. The reason for
1429 doing this: "stat" is both the name of a struct and function name:
1430 can't use the same trick like that for sys_open, sys_close, etc. to
1431 redirect Emacs's calls to our own version that converts Unix style
1432 filenames to Mac style filename because all sorts of compilation
1433 errors will be generated if stat is #define'd to be sys_stat. */
1436 stat_noalias (const char *path
, struct stat
*buf
)
1438 char mac_pathname
[MAXPATHLEN
+1];
1441 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1444 c2pstr (mac_pathname
);
1445 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1446 cipb
.hFileInfo
.ioVRefNum
= 0;
1447 cipb
.hFileInfo
.ioDirID
= 0;
1448 cipb
.hFileInfo
.ioFDirIndex
= 0;
1449 /* set to 0 to get information about specific dir or file */
1451 errno
= PBGetCatInfo (&cipb
, false);
1452 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1457 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1459 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1461 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1462 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1463 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1464 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1465 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1466 /* size of dir = number of files and dirs */
1469 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1470 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1474 buf
->st_mode
= S_IFREG
| S_IREAD
;
1475 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1476 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1477 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1478 buf
->st_mode
|= S_IEXEC
;
1479 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1480 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1481 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1484 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1485 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1488 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1490 /* identify alias files as symlinks */
1491 buf
->st_mode
&= ~S_IFREG
;
1492 buf
->st_mode
|= S_IFLNK
;
1496 buf
->st_uid
= getuid ();
1497 buf
->st_gid
= getgid ();
1505 lstat (const char *path
, struct stat
*buf
)
1508 char true_pathname
[MAXPATHLEN
+1];
1510 /* Try looking for the file without resolving aliases first. */
1511 if ((result
= stat_noalias (path
, buf
)) >= 0)
1514 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1517 return stat_noalias (true_pathname
, buf
);
1522 stat (const char *path
, struct stat
*sb
)
1525 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1528 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1529 ! (sb
->st_mode
& S_IFLNK
))
1532 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1535 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1538 fully_resolved_name
[len
] = '\0';
1539 /* in fact our readlink terminates strings */
1540 return lstat (fully_resolved_name
, sb
);
1543 return lstat (true_pathname
, sb
);
1548 /* CW defines fstat in stat.mac.c while MPW does not provide this
1549 function. Without the information of how to get from a file
1550 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1551 to implement this function. Fortunately, there is only one place
1552 where this function is called in our configuration: in fileio.c,
1553 where only the st_dev and st_ino fields are used to determine
1554 whether two fildes point to different i-nodes to prevent copying
1555 a file onto itself equal. What we have here probably needs
1559 fstat (int fildes
, struct stat
*buf
)
1562 buf
->st_ino
= fildes
;
1563 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1564 return 0; /* success */
1566 #endif /* __MRC__ */
1570 mkdir (const char *dirname
, int mode
)
1572 #pragma unused(mode)
1575 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1577 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1580 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1583 c2pstr (mac_pathname
);
1584 hfpb
.ioNamePtr
= mac_pathname
;
1585 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1586 hfpb
.ioDirID
= 0; /* parent is the root */
1588 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1589 /* just return the Mac OSErr code for now */
1590 return errno
== noErr
? 0 : -1;
1595 sys_rmdir (const char *dirname
)
1598 char mac_pathname
[MAXPATHLEN
+1];
1600 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1603 c2pstr (mac_pathname
);
1604 hfpb
.ioNamePtr
= mac_pathname
;
1605 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1606 hfpb
.ioDirID
= 0; /* parent is the root */
1608 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1609 return errno
== noErr
? 0 : -1;
1614 /* No implementation yet. */
1616 execvp (const char *path
, ...)
1620 #endif /* __MRC__ */
1624 utime (const char *path
, const struct utimbuf
*times
)
1626 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1628 char mac_pathname
[MAXPATHLEN
+1];
1631 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1634 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1636 fully_resolved_name
[len
] = '\0';
1638 strcpy (fully_resolved_name
, true_pathname
);
1640 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1643 c2pstr (mac_pathname
);
1644 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1645 cipb
.hFileInfo
.ioVRefNum
= 0;
1646 cipb
.hFileInfo
.ioDirID
= 0;
1647 cipb
.hFileInfo
.ioFDirIndex
= 0;
1648 /* set to 0 to get information about specific dir or file */
1650 errno
= PBGetCatInfo (&cipb
, false);
1654 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1657 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1659 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1664 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1666 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1669 errno
= PBSetCatInfo (&cipb
, false);
1670 return errno
== noErr
? 0 : -1;
1684 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1686 access (const char *path
, int mode
)
1688 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1690 char mac_pathname
[MAXPATHLEN
+1];
1693 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1696 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1698 fully_resolved_name
[len
] = '\0';
1700 strcpy (fully_resolved_name
, true_pathname
);
1702 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1705 c2pstr (mac_pathname
);
1706 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1707 cipb
.hFileInfo
.ioVRefNum
= 0;
1708 cipb
.hFileInfo
.ioDirID
= 0;
1709 cipb
.hFileInfo
.ioFDirIndex
= 0;
1710 /* set to 0 to get information about specific dir or file */
1712 errno
= PBGetCatInfo (&cipb
, false);
1716 if (mode
== F_OK
) /* got this far, file exists */
1720 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1724 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1731 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1732 /* don't allow if lock bit is on */
1738 #define DEV_NULL_FD 0x10000
1742 sys_open (const char *path
, int oflag
)
1744 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1746 char mac_pathname
[MAXPATHLEN
+1];
1748 if (strcmp (path
, "/dev/null") == 0)
1749 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1751 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1754 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1756 fully_resolved_name
[len
] = '\0';
1758 strcpy (fully_resolved_name
, true_pathname
);
1760 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1765 int res
= open (mac_pathname
, oflag
);
1766 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1767 if (oflag
& O_CREAT
)
1768 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1770 #else /* not __MRC__ */
1771 return open (mac_pathname
, oflag
);
1772 #endif /* not __MRC__ */
1779 sys_creat (const char *path
, mode_t mode
)
1781 char true_pathname
[MAXPATHLEN
+1];
1783 char mac_pathname
[MAXPATHLEN
+1];
1785 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1788 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1793 int result
= creat (mac_pathname
);
1794 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1796 #else /* not __MRC__ */
1797 return creat (mac_pathname
, mode
);
1798 #endif /* not __MRC__ */
1805 sys_unlink (const char *path
)
1807 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1809 char mac_pathname
[MAXPATHLEN
+1];
1811 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1814 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1816 fully_resolved_name
[len
] = '\0';
1818 strcpy (fully_resolved_name
, true_pathname
);
1820 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1823 return unlink (mac_pathname
);
1829 sys_read (int fildes
, char *buf
, int count
)
1831 if (fildes
== 0) /* this should not be used for console input */
1834 #if __MSL__ >= 0x6000
1835 return _read (fildes
, buf
, count
);
1837 return read (fildes
, buf
, count
);
1844 sys_write (int fildes
, const char *buf
, int count
)
1846 if (fildes
== DEV_NULL_FD
)
1849 #if __MSL__ >= 0x6000
1850 return _write (fildes
, buf
, count
);
1852 return write (fildes
, buf
, count
);
1859 sys_rename (const char * old_name
, const char * new_name
)
1861 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1862 char fully_resolved_old_name
[MAXPATHLEN
+1];
1864 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1866 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1869 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1871 fully_resolved_old_name
[len
] = '\0';
1873 strcpy (fully_resolved_old_name
, true_old_pathname
);
1875 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1878 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1881 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1886 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1889 /* If a file with new_name already exists, rename deletes the old
1890 file in Unix. CW version fails in these situation. So we add a
1891 call to unlink here. */
1892 (void) unlink (mac_new_name
);
1894 return rename (mac_old_name
, mac_new_name
);
1899 extern FILE *fopen (const char *name
, const char *mode
);
1901 sys_fopen (const char *name
, const char *mode
)
1903 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1905 char mac_pathname
[MAXPATHLEN
+1];
1907 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1910 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1912 fully_resolved_name
[len
] = '\0';
1914 strcpy (fully_resolved_name
, true_pathname
);
1916 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1921 if (mode
[0] == 'w' || mode
[0] == 'a')
1922 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1923 #endif /* not __MRC__ */
1924 return fopen (mac_pathname
, mode
);
1929 #include "keyboard.h"
1930 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1933 select (n
, rfds
, wfds
, efds
, timeout
)
1938 struct timeval
*timeout
;
1941 #if TARGET_API_MAC_CARBON
1942 EventTimeout timeout_sec
=
1944 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1945 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1946 : kEventDurationForever
);
1949 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1951 #else /* not TARGET_API_MAC_CARBON */
1953 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1954 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1956 /* Can only handle wait for keyboard input. */
1957 if (n
> 1 || wfds
|| efds
)
1960 /* Also return true if an event other than a keyDown has occurred.
1961 This causes kbd_buffer_get_event in keyboard.c to call
1962 read_avail_input which in turn calls XTread_socket to poll for
1963 these events. Otherwise these never get processed except but a
1964 very slow poll timer. */
1965 if (mac_wait_next_event (&e
, sleep_time
, false))
1968 err
= -9875; /* eventLoopTimedOutErr */
1969 #endif /* not TARGET_API_MAC_CARBON */
1971 if (FD_ISSET (0, rfds
))
1982 if (input_polling_used ())
1984 /* It could be confusing if a real alarm arrives while
1985 processing the fake one. Turn it off and let the
1986 handler reset it. */
1987 extern void poll_for_input_1
P_ ((void));
1988 int old_poll_suppress_count
= poll_suppress_count
;
1989 poll_suppress_count
= 1;
1990 poll_for_input_1 ();
1991 poll_suppress_count
= old_poll_suppress_count
;
2001 /* Simulation of SIGALRM. The stub for function signal stores the
2002 signal handler function in alarm_signal_func if a SIGALRM is
2006 #include "syssignal.h"
2008 static TMTask mac_atimer_task
;
2010 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2012 static int signal_mask
= 0;
2015 __sigfun alarm_signal_func
= (__sigfun
) 0;
2017 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2018 #else /* not __MRC__ and not __MWERKS__ */
2020 #endif /* not __MRC__ and not __MWERKS__ */
2024 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2026 sys_signal (int signal_num
, __sigfun signal_func
)
2028 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2030 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2031 #else /* not __MRC__ and not __MWERKS__ */
2033 #endif /* not __MRC__ and not __MWERKS__ */
2035 if (signal_num
!= SIGALRM
)
2036 return signal (signal_num
, signal_func
);
2040 __sigfun old_signal_func
;
2042 __signal_func_ptr old_signal_func
;
2046 old_signal_func
= alarm_signal_func
;
2047 alarm_signal_func
= signal_func
;
2048 return old_signal_func
;
2054 mac_atimer_handler (qlink
)
2057 if (alarm_signal_func
)
2058 (alarm_signal_func
) (SIGALRM
);
2063 set_mac_atimer (count
)
2066 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2068 if (mac_atimer_handlerUPP
== NULL
)
2069 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2070 mac_atimer_task
.tmCount
= 0;
2071 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2072 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2073 InsTime (mac_atimer_qlink
);
2075 PrimeTime (mac_atimer_qlink
, count
);
2080 remove_mac_atimer (remaining_count
)
2081 long *remaining_count
;
2083 if (mac_atimer_qlink
)
2085 RmvTime (mac_atimer_qlink
);
2086 if (remaining_count
)
2087 *remaining_count
= mac_atimer_task
.tmCount
;
2088 mac_atimer_qlink
= NULL
;
2100 int old_mask
= signal_mask
;
2102 signal_mask
|= mask
;
2104 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2105 remove_mac_atimer (NULL
);
2112 sigsetmask (int mask
)
2114 int old_mask
= signal_mask
;
2118 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2119 if (signal_mask
& sigmask (SIGALRM
))
2120 remove_mac_atimer (NULL
);
2122 set_mac_atimer (mac_atimer_task
.tmCount
);
2131 long remaining_count
;
2133 if (remove_mac_atimer (&remaining_count
) == 0)
2135 set_mac_atimer (seconds
* 1000);
2137 return remaining_count
/ 1000;
2141 mac_atimer_task
.tmCount
= seconds
* 1000;
2149 setitimer (which
, value
, ovalue
)
2151 const struct itimerval
*value
;
2152 struct itimerval
*ovalue
;
2154 long remaining_count
;
2155 long count
= (EMACS_SECS (value
->it_value
) * 1000
2156 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2158 if (remove_mac_atimer (&remaining_count
) == 0)
2162 bzero (ovalue
, sizeof (*ovalue
));
2163 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2164 (remaining_count
% 1000) * 1000);
2166 set_mac_atimer (count
);
2169 mac_atimer_task
.tmCount
= count
;
2175 /* gettimeofday should return the amount of time (in a timeval
2176 structure) since midnight today. The toolbox function Microseconds
2177 returns the number of microseconds (in a UnsignedWide value) since
2178 the machine was booted. Also making this complicated is WideAdd,
2179 WideSubtract, etc. take wide values. */
2186 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2187 UnsignedWide uw_microseconds
;
2188 wide w_microseconds
;
2189 time_t sys_time (time_t *);
2191 /* If this function is called for the first time, record the number
2192 of seconds since midnight and the number of microseconds since
2193 boot at the time of this first call. */
2198 systime
= sys_time (NULL
);
2199 /* Store microseconds since midnight in wall_clock_at_epoch. */
2200 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2201 Microseconds (&uw_microseconds
);
2202 /* Store microseconds since boot in clicks_at_epoch. */
2203 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2204 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2207 /* Get time since boot */
2208 Microseconds (&uw_microseconds
);
2210 /* Convert to time since midnight*/
2211 w_microseconds
.hi
= uw_microseconds
.hi
;
2212 w_microseconds
.lo
= uw_microseconds
.lo
;
2213 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2214 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2215 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2223 sleep (unsigned int seconds
)
2225 unsigned long time_up
;
2228 time_up
= TickCount () + seconds
* 60;
2229 while (TickCount () < time_up
)
2231 /* Accept no event; just wait. by T.I. */
2232 WaitNextEvent (0, &e
, 30, NULL
);
2237 #endif /* __MRC__ */
2240 /* The time functions adjust time values according to the difference
2241 between the Unix and CW epoches. */
2244 extern struct tm
*gmtime (const time_t *);
2246 sys_gmtime (const time_t *timer
)
2248 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2250 return gmtime (&unix_time
);
2255 extern struct tm
*localtime (const time_t *);
2257 sys_localtime (const time_t *timer
)
2259 #if __MSL__ >= 0x6000
2260 time_t unix_time
= *timer
;
2262 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2265 return localtime (&unix_time
);
2270 extern char *ctime (const time_t *);
2272 sys_ctime (const time_t *timer
)
2274 #if __MSL__ >= 0x6000
2275 time_t unix_time
= *timer
;
2277 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2280 return ctime (&unix_time
);
2285 extern time_t time (time_t *);
2287 sys_time (time_t *timer
)
2289 #if __MSL__ >= 0x6000
2290 time_t mac_time
= time (NULL
);
2292 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2302 /* no subprocesses, empty wait */
2312 croak (char *badfunc
)
2314 printf ("%s not yet implemented\r\n", badfunc
);
2320 mktemp (char *template)
2325 len
= strlen (template);
2327 while (k
>= 0 && template[k
] == 'X')
2330 k
++; /* make k index of first 'X' */
2334 /* Zero filled, number of digits equal to the number of X's. */
2335 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2344 /* Emulate getpwuid, getpwnam and others. */
2346 #define PASSWD_FIELD_SIZE 256
2348 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2349 static char my_passwd_dir
[MAXPATHLEN
+1];
2351 static struct passwd my_passwd
=
2357 static struct group my_group
=
2359 /* There are no groups on the mac, so we just return "root" as the
2365 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2367 char emacs_passwd_dir
[MAXPATHLEN
+1];
2373 init_emacs_passwd_dir ()
2377 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2379 /* Need pathname of first ancestor that begins with "emacs"
2380 since Mac emacs application is somewhere in the emacs-*
2382 int len
= strlen (emacs_passwd_dir
);
2384 /* j points to the "/" following the directory name being
2387 while (i
>= 0 && !found
)
2389 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2391 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2392 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2394 emacs_passwd_dir
[j
+1] = '\0';
2405 /* Setting to "/" probably won't work but set it to something
2407 strcpy (emacs_passwd_dir
, "/");
2408 strcpy (my_passwd_dir
, "/");
2413 static struct passwd emacs_passwd
=
2419 static int my_passwd_inited
= 0;
2427 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2428 directory where Emacs was started. */
2430 owner_name
= (char **) GetResource ('STR ',-16096);
2434 BlockMove ((unsigned char *) *owner_name
,
2435 (unsigned char *) my_passwd_name
,
2437 HUnlock (owner_name
);
2438 p2cstr ((unsigned char *) my_passwd_name
);
2441 my_passwd_name
[0] = 0;
2446 getpwuid (uid_t uid
)
2448 if (!my_passwd_inited
)
2451 my_passwd_inited
= 1;
2459 getgrgid (gid_t gid
)
2466 getpwnam (const char *name
)
2468 if (strcmp (name
, "emacs") == 0)
2469 return &emacs_passwd
;
2471 if (!my_passwd_inited
)
2474 my_passwd_inited
= 1;
2481 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2482 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2503 error ("Can't spawn subshell");
2508 request_sigio (void)
2514 unrequest_sigio (void)
2529 pipe (int _fildes
[2])
2536 /* Hard and symbolic links. */
2539 symlink (const char *name1
, const char *name2
)
2547 link (const char *name1
, const char *name2
)
2553 #endif /* ! MAC_OSX */
2555 /* Determine the path name of the file specified by VREFNUM, DIRID,
2556 and NAME and place that in the buffer PATH of length
2559 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2560 long dir_id
, ConstStr255Param name
)
2566 if (strlen (name
) > man_path_len
)
2569 memcpy (dir_name
, name
, name
[0]+1);
2570 memcpy (path
, name
, name
[0]+1);
2573 cipb
.dirInfo
.ioDrParID
= dir_id
;
2574 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2578 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2579 cipb
.dirInfo
.ioFDirIndex
= -1;
2580 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2581 /* go up to parent each time */
2583 err
= PBGetCatInfo (&cipb
, false);
2588 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2591 strcat (dir_name
, ":");
2592 strcat (dir_name
, path
);
2593 /* attach to front since we're going up directory tree */
2594 strcpy (path
, dir_name
);
2596 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2597 /* stop when we see the volume's root directory */
2599 return 1; /* success */
2604 posix_pathname_to_fsspec (ufn
, fs
)
2608 Str255 mac_pathname
;
2610 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2614 c2pstr (mac_pathname
);
2615 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2620 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2625 char mac_pathname
[MAXPATHLEN
];
2627 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2628 fs
->vRefNum
, fs
->parID
, fs
->name
)
2629 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2638 readlink (const char *path
, char *buf
, int bufsiz
)
2640 char mac_sym_link_name
[MAXPATHLEN
+1];
2643 Boolean target_is_folder
, was_aliased
;
2644 Str255 directory_name
, mac_pathname
;
2647 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2650 c2pstr (mac_sym_link_name
);
2651 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2658 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2659 if (err
!= noErr
|| !was_aliased
)
2665 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2672 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2678 return strlen (buf
);
2682 /* Convert a path to one with aliases fully expanded. */
2685 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2687 char *q
, temp
[MAXPATHLEN
+1];
2691 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2698 q
= strchr (p
+ 1, '/');
2700 q
= strchr (p
, '/');
2701 len
= 0; /* loop may not be entered, e.g., for "/" */
2706 strncat (temp
, p
, q
- p
);
2707 len
= readlink (temp
, buf
, bufsiz
);
2710 if (strlen (temp
) + 1 > bufsiz
)
2720 if (len
+ strlen (p
) + 1 >= bufsiz
)
2724 return len
+ strlen (p
);
2729 umask (mode_t numask
)
2731 static mode_t mask
= 022;
2732 mode_t oldmask
= mask
;
2739 chmod (const char *path
, mode_t mode
)
2741 /* say it always succeed for now */
2747 fchmod (int fd
, mode_t mode
)
2749 /* say it always succeed for now */
2755 fchown (int fd
, uid_t owner
, gid_t group
)
2757 /* say it always succeed for now */
2766 return fcntl (oldd
, F_DUPFD
, 0);
2768 /* current implementation of fcntl in fcntl.mac.c simply returns old
2770 return fcntl (oldd
, F_DUPFD
);
2777 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2778 newd if it already exists. Then, attempt to dup oldd. If not
2779 successful, call dup2 recursively until we are, then close the
2780 unsuccessful ones. */
2783 dup2 (int oldd
, int newd
)
2794 ret
= dup2 (oldd
, newd
);
2800 /* let it fail for now */
2817 ioctl (int d
, int request
, void *argp
)
2827 if (fildes
>=0 && fildes
<= 2)
2860 #endif /* __MRC__ */
2864 #if __MSL__ < 0x6000
2872 #endif /* __MWERKS__ */
2874 #endif /* ! MAC_OSX */
2877 /* Return the path to the directory in which Emacs can create
2878 temporary files. The MacOS "temporary items" directory cannot be
2879 used because it removes the file written by a process when it
2880 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2881 again not exactly). And of course Emacs needs to read back the
2882 files written by its subprocesses. So here we write the files to a
2883 directory "Emacs" in the Preferences Folder. This directory is
2884 created if it does not exist. */
2887 get_temp_dir_name ()
2889 static char *temp_dir_name
= NULL
;
2893 Str255 dir_name
, full_path
;
2895 char unix_dir_name
[MAXPATHLEN
+1];
2898 /* Cache directory name with pointer temp_dir_name.
2899 Look for it only the first time. */
2902 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2903 &vol_ref_num
, &dir_id
);
2907 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2910 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2911 strcat (full_path
, "Emacs:");
2915 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2918 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2921 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2924 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2925 strcpy (temp_dir_name
, unix_dir_name
);
2928 return temp_dir_name
;
2933 /* Allocate and construct an array of pointers to strings from a list
2934 of strings stored in a 'STR#' resource. The returned pointer array
2935 is stored in the style of argv and environ: if the 'STR#' resource
2936 contains numString strings, a pointer array with numString+1
2937 elements is returned in which the last entry contains a null
2938 pointer. The pointer to the pointer array is passed by pointer in
2939 parameter t. The resource ID of the 'STR#' resource is passed in
2940 parameter StringListID.
2944 get_string_list (char ***t
, short string_list_id
)
2950 h
= GetResource ('STR#', string_list_id
);
2955 num_strings
= * (short *) p
;
2957 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2958 for (i
= 0; i
< num_strings
; i
++)
2960 short length
= *p
++;
2961 (*t
)[i
] = (char *) malloc (length
+ 1);
2962 strncpy ((*t
)[i
], p
, length
);
2963 (*t
)[i
][length
] = '\0';
2966 (*t
)[num_strings
] = 0;
2971 /* Return no string in case GetResource fails. Bug fixed by
2972 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2973 option (no sym -on implies -opt local). */
2974 *t
= (char **) malloc (sizeof (char *));
2981 get_path_to_system_folder ()
2986 Str255 dir_name
, full_path
;
2988 static char system_folder_unix_name
[MAXPATHLEN
+1];
2991 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2992 &vol_ref_num
, &dir_id
);
2996 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2999 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3003 return system_folder_unix_name
;
3009 #define ENVIRON_STRING_LIST_ID 128
3011 /* Get environment variable definitions from STR# resource. */
3018 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3024 /* Make HOME directory the one Emacs starts up in if not specified
3026 if (getenv ("HOME") == NULL
)
3028 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3031 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3034 strcpy (environ
[i
], "HOME=");
3035 strcat (environ
[i
], my_passwd_dir
);
3042 /* Make HOME directory the one Emacs starts up in if not specified
3044 if (getenv ("MAIL") == NULL
)
3046 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3049 char * path_to_system_folder
= get_path_to_system_folder ();
3050 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3053 strcpy (environ
[i
], "MAIL=");
3054 strcat (environ
[i
], path_to_system_folder
);
3055 strcat (environ
[i
], "Eudora Folder/In");
3063 /* Return the value of the environment variable NAME. */
3066 getenv (const char *name
)
3068 int length
= strlen(name
);
3071 for (e
= environ
; *e
!= 0; e
++)
3072 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3073 return &(*e
)[length
+ 1];
3075 if (strcmp (name
, "TMPDIR") == 0)
3076 return get_temp_dir_name ();
3083 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3084 char *sys_siglist
[] =
3086 "Zero is not a signal!!!",
3088 "Interactive user interrupt", /* 2 */ "?",
3089 "Floating point exception", /* 4 */ "?", "?", "?",
3090 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3091 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3092 "?", "?", "?", "?", "?", "?", "?", "?",
3096 char *sys_siglist
[] =
3098 "Zero is not a signal!!!",
3100 "Floating point exception",
3101 "Illegal instruction",
3102 "Interactive user interrupt",
3103 "Segment violation",
3106 #else /* not __MRC__ and not __MWERKS__ */
3108 #endif /* not __MRC__ and not __MWERKS__ */
3111 #include <utsname.h>
3114 uname (struct utsname
*name
)
3117 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3120 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3121 p2cstr (name
->nodename
);
3129 /* Event class of HLE sent to subprocess. */
3130 const OSType kEmacsSubprocessSend
= 'ESND';
3132 /* Event class of HLE sent back from subprocess. */
3133 const OSType kEmacsSubprocessReply
= 'ERPY';
3137 mystrchr (char *s
, char c
)
3139 while (*s
&& *s
!= c
)
3167 mystrcpy (char *to
, char *from
)
3179 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3180 terminated). The process should run with the default directory
3181 "workdir", read input from "infn", and write output and error to
3182 "outfn" and "errfn", resp. The Process Manager call
3183 LaunchApplication is used to start the subprocess. We use high
3184 level events as the mechanism to pass arguments to the subprocess
3185 and to make Emacs wait for the subprocess to terminate and pass
3186 back a result code. The bulk of the code here packs the arguments
3187 into one message to be passed together with the high level event.
3188 Emacs also sometimes starts a subprocess using a shell to perform
3189 wildcard filename expansion. Since we don't really have a shell on
3190 the Mac, this case is detected and the starting of the shell is
3191 by-passed. We really need to add code here to do filename
3192 expansion to support such functionality. */
3195 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3196 unsigned char **argv
;
3197 const char *workdir
;
3198 const char *infn
, *outfn
, *errfn
;
3200 #if TARGET_API_MAC_CARBON
3202 #else /* not TARGET_API_MAC_CARBON */
3203 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3204 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3205 int paramlen
, argc
, newargc
, j
, retries
;
3206 char **newargv
, *param
, *p
;
3209 LaunchParamBlockRec lpbr
;
3210 EventRecord send_event
, reply_event
;
3211 RgnHandle cursor_region_handle
;
3213 unsigned long ref_con
, len
;
3215 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3217 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3219 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3221 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3224 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3225 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3234 /* If a subprocess is invoked with a shell, we receive 3 arguments
3235 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3236 bins>/<command> <command args>" */
3237 j
= strlen (argv
[0]);
3238 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3239 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3241 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3243 /* The arguments for the command in argv[2] are separated by
3244 spaces. Count them and put the count in newargc. */
3245 command
= (char *) alloca (strlen (argv
[2])+2);
3246 strcpy (command
, argv
[2]);
3247 if (command
[strlen (command
) - 1] != ' ')
3248 strcat (command
, " ");
3252 t
= mystrchr (t
, ' ');
3256 t
= mystrchr (t
+1, ' ');
3259 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3262 for (j
= 0; j
< newargc
; j
++)
3264 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3265 mystrcpy (newargv
[j
], t
);
3268 paramlen
+= strlen (newargv
[j
]) + 1;
3271 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3273 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3278 { /* sometimes Emacs call "sh" without a path for the command */
3280 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3281 strcpy (t
, "~emacs/");
3282 strcat (t
, newargv
[0]);
3285 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3286 make_number (X_OK
));
3290 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3294 strcpy (macappname
, tempmacpathname
);
3298 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3301 newargv
= (char **) alloca (sizeof (char *) * argc
);
3303 for (j
= 1; j
< argc
; j
++)
3305 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3307 char *t
= strchr (argv
[j
], ' ');
3310 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3311 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3312 tempcmdname
[t
-argv
[j
]] = '\0';
3313 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3316 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3318 strcpy (newargv
[j
], tempmaccmdname
);
3319 strcat (newargv
[j
], t
);
3323 char tempmaccmdname
[MAXPATHLEN
+1];
3324 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3327 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3328 strcpy (newargv
[j
], tempmaccmdname
);
3332 newargv
[j
] = argv
[j
];
3333 paramlen
+= strlen (newargv
[j
]) + 1;
3337 /* After expanding all the arguments, we now know the length of the
3338 parameter block to be sent to the subprocess as a message
3339 attached to the HLE. */
3340 param
= (char *) malloc (paramlen
+ 1);
3346 /* first byte of message contains number of arguments for command */
3347 strcpy (p
, macworkdir
);
3348 p
+= strlen (macworkdir
);
3350 /* null terminate strings sent so it's possible to use strcpy over there */
3351 strcpy (p
, macinfn
);
3352 p
+= strlen (macinfn
);
3354 strcpy (p
, macoutfn
);
3355 p
+= strlen (macoutfn
);
3357 strcpy (p
, macerrfn
);
3358 p
+= strlen (macerrfn
);
3360 for (j
= 1; j
< newargc
; j
++)
3362 strcpy (p
, newargv
[j
]);
3363 p
+= strlen (newargv
[j
]);
3367 c2pstr (macappname
);
3369 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3377 lpbr
.launchBlockID
= extendedBlock
;
3378 lpbr
.launchEPBLength
= extendedBlockLen
;
3379 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3380 lpbr
.launchAppSpec
= &spec
;
3381 lpbr
.launchAppParameters
= NULL
;
3383 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3390 send_event
.what
= kHighLevelEvent
;
3391 send_event
.message
= kEmacsSubprocessSend
;
3392 /* Event ID stored in "where" unused */
3395 /* OS may think current subprocess has terminated if previous one
3396 terminated recently. */
3399 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3400 paramlen
+ 1, receiverIDisPSN
);
3402 while (iErr
== sessClosedErr
&& retries
-- > 0);
3410 cursor_region_handle
= NewRgn ();
3412 /* Wait for the subprocess to finish, when it will send us a ERPY
3413 high level event. */
3415 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3416 cursor_region_handle
)
3417 && reply_event
.message
== kEmacsSubprocessReply
)
3420 /* The return code is sent through the refCon */
3421 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3424 DisposeHandle ((Handle
) cursor_region_handle
);
3429 DisposeHandle ((Handle
) cursor_region_handle
);
3433 #endif /* not TARGET_API_MAC_CARBON */
3438 opendir (const char *dirname
)
3440 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3441 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3445 int len
, vol_name_len
;
3447 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3450 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3452 fully_resolved_name
[len
] = '\0';
3454 strcpy (fully_resolved_name
, true_pathname
);
3456 dirp
= (DIR *) malloc (sizeof(DIR));
3460 /* Handle special case when dirname is "/": sets up for readir to
3461 get all mount volumes. */
3462 if (strcmp (fully_resolved_name
, "/") == 0)
3464 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3465 dirp
->current_index
= 1; /* index for first volume */
3469 /* Handle typical cases: not accessing all mounted volumes. */
3470 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3473 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3474 len
= strlen (mac_pathname
);
3475 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3476 strcat (mac_pathname
, ":");
3478 /* Extract volume name */
3479 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3480 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3481 vol_name
[vol_name_len
] = '\0';
3482 strcat (vol_name
, ":");
3484 c2pstr (mac_pathname
);
3485 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3486 /* using full pathname so vRefNum and DirID ignored */
3487 cipb
.hFileInfo
.ioVRefNum
= 0;
3488 cipb
.hFileInfo
.ioDirID
= 0;
3489 cipb
.hFileInfo
.ioFDirIndex
= 0;
3490 /* set to 0 to get information about specific dir or file */
3492 errno
= PBGetCatInfo (&cipb
, false);
3499 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3500 return 0; /* not a directory */
3502 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3503 dirp
->getting_volumes
= 0;
3504 dirp
->current_index
= 1; /* index for first file/directory */
3507 vpb
.ioNamePtr
= vol_name
;
3508 /* using full pathname so vRefNum and DirID ignored */
3510 vpb
.ioVolIndex
= -1;
3511 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3518 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3535 HParamBlockRec hpblock
;
3537 static struct dirent s_dirent
;
3538 static Str255 s_name
;
3542 /* Handle the root directory containing the mounted volumes. Call
3543 PBHGetVInfo specifying an index to obtain the info for a volume.
3544 PBHGetVInfo returns an error when it receives an index beyond the
3545 last volume, at which time we should return a nil dirent struct
3547 if (dp
->getting_volumes
)
3549 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3550 hpblock
.volumeParam
.ioVRefNum
= 0;
3551 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3553 errno
= PBHGetVInfo (&hpblock
, false);
3561 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3563 dp
->current_index
++;
3565 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3566 s_dirent
.d_name
= s_name
;
3572 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3573 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3574 /* location to receive filename returned */
3576 /* return only visible files */
3580 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3581 /* directory ID found by opendir */
3582 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3584 errno
= PBGetCatInfo (&cipb
, false);
3591 /* insist on a visible entry */
3592 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3593 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3595 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3597 dp
->current_index
++;
3610 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3611 /* value unimportant: non-zero for valid file */
3612 s_dirent
.d_name
= s_name
;
3622 char mac_pathname
[MAXPATHLEN
+1];
3623 Str255 directory_name
;
3627 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3630 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3636 #endif /* ! MAC_OSX */
3640 initialize_applescript ()
3645 /* if open fails, as_scripting_component is set to NULL. Its
3646 subsequent use in OSA calls will fail with badComponentInstance
3648 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3649 kAppleScriptSubtype
);
3651 null_desc
.descriptorType
= typeNull
;
3652 null_desc
.dataHandle
= 0;
3653 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3654 kOSANullScript
, &as_script_context
);
3656 as_script_context
= kOSANullScript
;
3657 /* use default context if create fails */
3662 terminate_applescript()
3664 OSADispose (as_scripting_component
, as_script_context
);
3665 CloseComponent (as_scripting_component
);
3668 /* Convert a lisp string to the 4 byte character code. */
3671 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3680 /* check type string */
3682 if (SBYTES (arg
) != 4)
3684 error ("Wrong argument: need string of length 4 for code");
3686 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3691 /* Convert the 4 byte character code into a 4 byte string. */
3694 mac_get_object_from_code(OSType defCode
)
3696 UInt32 code
= EndianU32_NtoB (defCode
);
3698 return make_unibyte_string ((char *)&code
, 4);
3702 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3703 doc
: /* Get the creator code of FILENAME as a four character string. */)
3705 Lisp_Object filename
;
3714 Lisp_Object result
= Qnil
;
3715 CHECK_STRING (filename
);
3717 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3720 filename
= Fexpand_file_name (filename
, Qnil
);
3724 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3726 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3729 if (status
== noErr
)
3732 FSCatalogInfo catalogInfo
;
3734 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3735 &catalogInfo
, NULL
, NULL
, NULL
);
3739 status
= FSpGetFInfo (&fss
, &finder_info
);
3741 if (status
== noErr
)
3744 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
3746 result
= mac_get_object_from_code (finder_info
.fdCreator
);
3751 if (status
!= noErr
) {
3752 error ("Error while getting file information.");
3757 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
3758 doc
: /* Get the type code of FILENAME as a four character string. */)
3760 Lisp_Object filename
;
3769 Lisp_Object result
= Qnil
;
3770 CHECK_STRING (filename
);
3772 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3775 filename
= Fexpand_file_name (filename
, Qnil
);
3779 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3781 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3784 if (status
== noErr
)
3787 FSCatalogInfo catalogInfo
;
3789 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3790 &catalogInfo
, NULL
, NULL
, NULL
);
3794 status
= FSpGetFInfo (&fss
, &finder_info
);
3796 if (status
== noErr
)
3799 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
3801 result
= mac_get_object_from_code (finder_info
.fdType
);
3806 if (status
!= noErr
) {
3807 error ("Error while getting file information.");
3812 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
3813 doc
: /* Set creator code of file FILENAME to CODE.
3814 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
3815 assumed. Return non-nil if successful. */)
3817 Lisp_Object filename
, code
;
3826 CHECK_STRING (filename
);
3828 cCode
= mac_get_code_from_arg(code
, 'EMAx');
3830 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3833 filename
= Fexpand_file_name (filename
, Qnil
);
3837 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3839 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3842 if (status
== noErr
)
3845 FSCatalogInfo catalogInfo
;
3847 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3848 &catalogInfo
, NULL
, NULL
, &parentDir
);
3852 status
= FSpGetFInfo (&fss
, &finder_info
);
3854 if (status
== noErr
)
3857 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
3858 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3859 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3861 finder_info
.fdCreator
= cCode
;
3862 status
= FSpSetFInfo (&fss
, &finder_info
);
3867 if (status
!= noErr
) {
3868 error ("Error while setting creator information.");
3873 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
3874 doc
: /* Set file code of file FILENAME to CODE.
3875 CODE must be a 4-character string. Return non-nil if successful. */)
3877 Lisp_Object filename
, code
;
3886 CHECK_STRING (filename
);
3888 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
3890 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3893 filename
= Fexpand_file_name (filename
, Qnil
);
3897 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3899 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3902 if (status
== noErr
)
3905 FSCatalogInfo catalogInfo
;
3907 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3908 &catalogInfo
, NULL
, NULL
, &parentDir
);
3912 status
= FSpGetFInfo (&fss
, &finder_info
);
3914 if (status
== noErr
)
3917 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
3918 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
3919 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3921 finder_info
.fdType
= cCode
;
3922 status
= FSpSetFInfo (&fss
, &finder_info
);
3927 if (status
!= noErr
) {
3928 error ("Error while setting creator information.");
3934 /* Compile and execute the AppleScript SCRIPT and return the error
3935 status as function value. A zero is returned if compilation and
3936 execution is successful, in which case RESULT returns a pointer to
3937 a string containing the resulting script value. Otherwise, the Mac
3938 error code is returned and RESULT returns a pointer to an error
3939 string. In both cases the caller should deallocate the storage
3940 used by the string pointed to by RESULT if it is non-NULL. For
3941 documentation on the MacOS scripting architecture, see Inside
3942 Macintosh - Interapplication Communications: Scripting Components. */
3945 do_applescript (char *script
, char **result
)
3947 AEDesc script_desc
, result_desc
, error_desc
;
3954 if (!as_scripting_component
)
3955 initialize_applescript();
3957 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3961 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3962 typeChar
, kOSAModeNull
, &result_desc
);
3964 if (osaerror
== errOSAScriptError
)
3966 /* error executing AppleScript: retrieve error message */
3967 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3970 #if TARGET_API_MAC_CARBON
3971 length
= AEGetDescDataSize (&error_desc
);
3972 *result
= (char *) xmalloc (length
+ 1);
3975 AEGetDescData (&error_desc
, *result
, length
);
3976 *(*result
+ length
) = '\0';
3978 #else /* not TARGET_API_MAC_CARBON */
3979 HLock (error_desc
.dataHandle
);
3980 length
= GetHandleSize(error_desc
.dataHandle
);
3981 *result
= (char *) xmalloc (length
+ 1);
3984 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3985 *(*result
+ length
) = '\0';
3987 HUnlock (error_desc
.dataHandle
);
3988 #endif /* not TARGET_API_MAC_CARBON */
3989 AEDisposeDesc (&error_desc
);
3992 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3994 #if TARGET_API_MAC_CARBON
3995 length
= AEGetDescDataSize (&result_desc
);
3996 *result
= (char *) xmalloc (length
+ 1);
3999 AEGetDescData (&result_desc
, *result
, length
);
4000 *(*result
+ length
) = '\0';
4002 #else /* not TARGET_API_MAC_CARBON */
4003 HLock (result_desc
.dataHandle
);
4004 length
= GetHandleSize(result_desc
.dataHandle
);
4005 *result
= (char *) xmalloc (length
+ 1);
4008 memcpy (*result
, *(result_desc
.dataHandle
), length
);
4009 *(*result
+ length
) = '\0';
4011 HUnlock (result_desc
.dataHandle
);
4012 #endif /* not TARGET_API_MAC_CARBON */
4013 AEDisposeDesc (&result_desc
);
4016 AEDisposeDesc (&script_desc
);
4022 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4023 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4024 If compilation and execution are successful, the resulting script
4025 value is returned as a string. Otherwise the function aborts and
4026 displays the error message returned by the AppleScript scripting
4031 char *result
, *temp
;
4032 Lisp_Object lisp_result
;
4035 CHECK_STRING (script
);
4038 status
= do_applescript (SDATA (script
), &result
);
4043 error ("AppleScript error %d", status
);
4046 /* Unfortunately only OSADoScript in do_applescript knows how
4047 how large the resulting script value or error message is
4048 going to be and therefore as caller memory must be
4049 deallocated here. It is necessary to free the error
4050 message before calling error to avoid a memory leak. */
4051 temp
= (char *) alloca (strlen (result
) + 1);
4052 strcpy (temp
, result
);
4059 lisp_result
= build_string (result
);
4066 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4067 Smac_file_name_to_posix
, 1, 1, 0,
4068 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4070 Lisp_Object filename
;
4072 char posix_filename
[MAXPATHLEN
+1];
4074 CHECK_STRING (filename
);
4076 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4077 return build_string (posix_filename
);
4083 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4084 Sposix_file_name_to_mac
, 1, 1, 0,
4085 doc
: /* Convert Posix FILENAME to Mac form. */)
4087 Lisp_Object filename
;
4089 char mac_filename
[MAXPATHLEN
+1];
4091 CHECK_STRING (filename
);
4093 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4094 return build_string (mac_filename
);
4100 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4101 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4102 Each type should be a string of length 4 or the symbol
4103 `undecoded-file-name'. */)
4104 (src_type
, src_data
, dst_type
)
4105 Lisp_Object src_type
, src_data
, dst_type
;
4108 Lisp_Object result
= Qnil
;
4109 DescType src_desc_type
, dst_desc_type
;
4117 CHECK_STRING (src_data
);
4118 if (EQ (src_type
, Qundecoded_file_name
))
4121 src_desc_type
= typeFileURL
;
4123 src_desc_type
= typeFSS
;
4127 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4129 if (EQ (dst_type
, Qundecoded_file_name
))
4132 dst_desc_type
= typeFSRef
;
4134 dst_desc_type
= typeFSS
;
4138 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4141 if (EQ (src_type
, Qundecoded_file_name
))
4145 CFURLRef url
= NULL
;
4146 CFDataRef data
= NULL
;
4148 str
= cfstring_create_with_utf8_cstring (SDATA (src_data
));
4151 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
4152 kCFURLPOSIXPathStyle
, false);
4157 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
4161 err
= AECoercePtr (src_desc_type
, CFDataGetBytePtr (data
),
4162 CFDataGetLength (data
),
4163 dst_desc_type
, &dst_desc
);
4167 err
= posix_pathname_to_fsspec (SDATA (src_data
), &fs
);
4169 AECoercePtr (src_desc_type
, &fs
, sizeof (FSSpec
),
4170 dst_desc_type
, &dst_desc
);
4174 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4175 dst_desc_type
, &dst_desc
);
4179 if (EQ (dst_type
, Qundecoded_file_name
))
4181 char file_name
[MAXPATHLEN
];
4184 err
= AEGetDescData (&dst_desc
, &fref
, sizeof (FSRef
));
4186 err
= FSRefMakePath (&fref
, file_name
, sizeof (file_name
));
4188 #if TARGET_API_MAC_CARBON
4189 err
= AEGetDescData (&dst_desc
, &fs
, sizeof (FSSpec
));
4191 memcpy (&fs
, *(dst_desc
.dataHandle
), sizeof (FSSpec
));
4194 err
= fsspec_to_posix_pathname (&fs
, file_name
,
4195 sizeof (file_name
) - 1);
4198 result
= make_unibyte_string (file_name
, strlen (file_name
));
4201 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4202 AEDisposeDesc (&dst_desc
);
4210 #if TARGET_API_MAC_CARBON
4211 static Lisp_Object Qxml
, Qmime_charset
;
4212 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4214 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4215 doc
: /* Return the application preference value for KEY.
4216 KEY is either a string specifying a preference key, or a list of key
4217 strings. If it is a list, the (i+1)-th element is used as a key for
4218 the CFDictionary value obtained by the i-th element. Return nil if
4219 lookup is failed at some stage.
4221 Optional arg APPLICATION is an application ID string. If omitted or
4222 nil, that stands for the current application.
4224 Optional arg FORMAT specifies the data format of the return value. If
4225 omitted or nil, each Core Foundation object is converted into a
4226 corresponding Lisp object as follows:
4228 Core Foundation Lisp Tag
4229 ------------------------------------------------------------
4230 CFString Multibyte string string
4231 CFNumber Integer or float number
4232 CFBoolean Symbol (t or nil) boolean
4233 CFDate List of three integers date
4234 (cf. `current-time')
4235 CFData Unibyte string data
4236 CFArray Vector array
4237 CFDictionary Alist or hash table dictionary
4238 (depending on HASH-BOUND)
4240 If it is t, a symbol that represents the type of the original Core
4241 Foundation object is prepended. If it is `xml', the value is returned
4242 as an XML representation.
4244 Optional arg HASH-BOUND specifies which kinds of the list objects,
4245 alists or hash tables, are used as the targets of the conversion from
4246 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4247 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4248 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4250 (key
, application
, format
, hash_bound
)
4251 Lisp_Object key
, application
, format
, hash_bound
;
4253 CFStringRef app_id
, key_str
;
4254 CFPropertyListRef app_plist
= NULL
, plist
;
4255 Lisp_Object result
= Qnil
, tmp
;
4258 key
= Fcons (key
, Qnil
);
4262 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4263 CHECK_STRING_CAR (tmp
);
4265 wrong_type_argument (Qlistp
, key
);
4267 if (!NILP (application
))
4268 CHECK_STRING (application
);
4269 CHECK_SYMBOL (format
);
4270 if (!NILP (hash_bound
))
4271 CHECK_NUMBER (hash_bound
);
4275 app_id
= kCFPreferencesCurrentApplication
;
4276 if (!NILP (application
))
4278 app_id
= cfstring_create_with_string (application
);
4282 key_str
= cfstring_create_with_string (XCAR (key
));
4283 if (key_str
== NULL
)
4285 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4286 CFRelease (key_str
);
4287 if (app_plist
== NULL
)
4291 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4293 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4295 key_str
= cfstring_create_with_string (XCAR (key
));
4296 if (key_str
== NULL
)
4298 plist
= CFDictionaryGetValue (plist
, key_str
);
4299 CFRelease (key_str
);
4305 if (EQ (format
, Qxml
))
4307 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4310 result
= cfdata_to_lisp (data
);
4315 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4316 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4320 CFRelease (app_plist
);
4329 static CFStringEncoding
4330 get_cfstring_encoding_from_lisp (obj
)
4333 CFStringRef iana_name
;
4334 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4337 return kCFStringEncodingUnicode
;
4342 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4344 Lisp_Object coding_spec
, plist
;
4346 coding_spec
= Fget (obj
, Qcoding_system
);
4347 plist
= XVECTOR (coding_spec
)->contents
[3];
4348 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4352 obj
= SYMBOL_NAME (obj
);
4356 iana_name
= cfstring_create_with_string (obj
);
4359 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4360 CFRelease (iana_name
);
4367 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4369 cfstring_create_normalized (str
, symbol
)
4374 TextEncodingVariant variant
;
4375 float initial_mag
= 0.0;
4376 CFStringRef result
= NULL
;
4378 if (EQ (symbol
, QNFD
))
4379 form
= kCFStringNormalizationFormD
;
4380 else if (EQ (symbol
, QNFKD
))
4381 form
= kCFStringNormalizationFormKD
;
4382 else if (EQ (symbol
, QNFC
))
4383 form
= kCFStringNormalizationFormC
;
4384 else if (EQ (symbol
, QNFKC
))
4385 form
= kCFStringNormalizationFormKC
;
4386 else if (EQ (symbol
, QHFS_plus_D
))
4388 variant
= kUnicodeHFSPlusDecompVariant
;
4391 else if (EQ (symbol
, QHFS_plus_C
))
4393 variant
= kUnicodeHFSPlusCompVariant
;
4399 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4403 CFStringNormalize (mut_str
, form
);
4407 else if (initial_mag
> 0.0)
4409 UnicodeToTextInfo uni
= NULL
;
4412 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4414 ByteCount out_read
, out_size
, out_len
;
4416 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4418 kTextEncodingDefaultFormat
);
4419 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4421 kTextEncodingDefaultFormat
);
4422 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4424 length
= CFStringGetLength (str
);
4425 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4429 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4430 if (in_text
== NULL
)
4432 buffer
= xmalloc (sizeof (UniChar
) * length
);
4435 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4441 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4442 while (err
== noErr
)
4444 out_buf
= xmalloc (out_size
);
4445 if (out_buf
== NULL
)
4448 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4450 kUnicodeDefaultDirectionMask
,
4451 0, NULL
, NULL
, NULL
,
4452 out_size
, &out_read
, &out_len
,
4454 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4463 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4464 out_len
/ sizeof (UniChar
));
4466 DisposeUnicodeToTextInfo (&uni
);
4482 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4483 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4484 The conversion is performed using the converter provided by the system.
4485 Each encoding is specified by either a coding system symbol, a mime
4486 charset string, or an integer as a CFStringEncoding value. Nil for
4487 encoding means UTF-16 in native byte order, no byte order mark.
4488 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4489 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4490 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4491 On successful conversion, return the result string, else return nil. */)
4492 (string
, source
, target
, normalization_form
)
4493 Lisp_Object string
, source
, target
, normalization_form
;
4495 Lisp_Object result
= Qnil
;
4496 CFStringEncoding src_encoding
, tgt_encoding
;
4497 CFStringRef str
= NULL
;
4499 CHECK_STRING (string
);
4500 if (!INTEGERP (source
) && !STRINGP (source
))
4501 CHECK_SYMBOL (source
);
4502 if (!INTEGERP (target
) && !STRINGP (target
))
4503 CHECK_SYMBOL (target
);
4504 CHECK_SYMBOL (normalization_form
);
4508 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4509 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4511 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4512 use string_as_unibyte which works as well, except for the fact that
4513 it's too permissive (it doesn't check that the multibyte string only
4514 contain single-byte chars). */
4515 string
= Fstring_as_unibyte (string
);
4516 if (src_encoding
!= kCFStringEncodingInvalidId
4517 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4518 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4519 src_encoding
, !NILP (source
));
4520 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4523 CFStringRef saved_str
= str
;
4525 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4526 CFRelease (saved_str
);
4531 CFIndex str_len
, buf_len
;
4533 str_len
= CFStringGetLength (str
);
4534 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4535 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4537 result
= make_uninit_string (buf_len
);
4538 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4539 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4548 #endif /* TARGET_API_MAC_CARBON */
4551 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4552 doc
: /* Clear the font name table. */)
4556 mac_clear_font_name_table ();
4562 mac_get_system_locale ()
4570 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4571 region
= GetScriptManagerVariable (smRegionCode
);
4572 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4574 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4577 return build_string (str
);
4586 extern int inhibit_window_system
;
4587 extern int noninteractive
;
4589 /* Unlike in X11, window events in Carbon do not come from sockets.
4590 So we cannot simply use `select' to monitor two kinds of inputs:
4591 window events and process outputs. We emulate such functionality
4592 by regarding fd 0 as the window event channel and simultaneously
4593 monitoring both kinds of input channels. It is implemented by
4594 dividing into some cases:
4595 1. The window event channel is not involved.
4597 2. Sockets are not involved.
4598 -> Use ReceiveNextEvent.
4599 3. [If SELECT_USE_CFSOCKET is defined]
4600 Only the window event channel and socket read channels are
4601 involved, and timeout is not too short (greater than
4602 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4603 -> Create CFSocket for each socket and add it into the current
4604 event RunLoop so that a `ready-to-read' event can be posted
4605 to the event queue that is also used for window events. Then
4606 ReceiveNextEvent can wait for both kinds of inputs.
4608 -> Periodically poll the window input channel while repeatedly
4609 executing `select' with a short timeout
4610 (SELECT_POLLING_PERIOD_USEC microseconds). */
4612 #define SELECT_POLLING_PERIOD_USEC 20000
4613 #ifdef SELECT_USE_CFSOCKET
4614 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4615 #define EVENT_CLASS_SOCK 'Sock'
4618 socket_callback (s
, type
, address
, data
, info
)
4620 CFSocketCallBackType type
;
4627 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4628 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4629 ReleaseEvent (event
);
4631 #endif /* SELECT_USE_CFSOCKET */
4634 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4639 struct timeval
*timeout
;
4644 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4648 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4649 kEventLeaveInQueue
, NULL
);
4660 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4661 #undef SELECT_INVALIDATE_CFSOCKET
4665 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4670 struct timeval
*timeout
;
4674 EMACS_TIME select_timeout
;
4676 if (inhibit_window_system
|| noninteractive
4677 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4678 return select (n
, rfds
, wfds
, efds
, timeout
);
4682 if (wfds
== NULL
&& efds
== NULL
)
4685 SELECT_TYPE orfds
= *rfds
;
4687 EventTimeout timeout_sec
=
4689 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4690 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4691 : kEventDurationForever
);
4693 for (i
= 1; i
< n
; i
++)
4694 if (FD_ISSET (i
, rfds
))
4700 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4701 kEventLeaveInQueue
, NULL
);
4712 /* Avoid initial overhead of RunLoop setup for the case that
4713 some input is already available. */
4714 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4715 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4716 if (r
!= 0 || timeout_sec
== 0.0)
4721 #ifdef SELECT_USE_CFSOCKET
4722 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4723 goto poll_periodically
;
4726 CFRunLoopRef runloop
=
4727 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4728 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4729 #ifdef SELECT_INVALIDATE_CFSOCKET
4730 CFSocketRef
*shead
, *s
;
4732 CFRunLoopSourceRef
*shead
, *s
;
4737 #ifdef SELECT_INVALIDATE_CFSOCKET
4738 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4740 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4743 for (i
= 1; i
< n
; i
++)
4744 if (FD_ISSET (i
, rfds
))
4746 CFSocketRef socket
=
4747 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4748 socket_callback
, NULL
);
4749 CFRunLoopSourceRef source
=
4750 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4752 #ifdef SELECT_INVALIDATE_CFSOCKET
4753 CFSocketSetSocketFlags (socket
, 0);
4755 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4756 #ifdef SELECT_INVALIDATE_CFSOCKET
4766 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4771 #ifdef SELECT_INVALIDATE_CFSOCKET
4772 CFSocketInvalidate (*s
);
4774 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4789 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4790 GetEventTypeCount (specs
),
4792 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4793 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4800 #endif /* SELECT_USE_CFSOCKET */
4805 EMACS_TIME end_time
, now
, remaining_time
;
4806 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4814 remaining_time
= *timeout
;
4815 EMACS_GET_TIME (now
);
4816 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4821 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4822 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4823 select_timeout
= remaining_time
;
4824 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4836 EMACS_GET_TIME (now
);
4837 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4840 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4851 /* Set up environment variables so that Emacs can correctly find its
4852 support files when packaged as an application bundle. Directories
4853 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4854 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4855 by `make install' by default can instead be placed in
4856 .../Emacs.app/Contents/Resources/ and
4857 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4858 is changed only if it is not already set. Presumably if the user
4859 sets an environment variable, he will want to use files in his path
4860 instead of ones in the application bundle. */
4862 init_mac_osx_environment ()
4866 CFStringRef cf_app_bundle_pathname
;
4867 int app_bundle_pathname_len
;
4868 char *app_bundle_pathname
;
4872 /* Initialize locale related variables. */
4873 mac_system_script_code
=
4874 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4875 Vmac_system_locale
= mac_get_system_locale ();
4877 /* Fetch the pathname of the application bundle as a C string into
4878 app_bundle_pathname. */
4880 bundle
= CFBundleGetMainBundle ();
4881 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
4883 /* We could not find the bundle identifier. For now, prevent
4884 the fatal error by bringing it up in the terminal. */
4885 inhibit_window_system
= 1;
4889 bundleURL
= CFBundleCopyBundleURL (bundle
);
4893 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4894 kCFURLPOSIXPathStyle
);
4895 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4896 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4898 if (!CFStringGetCString (cf_app_bundle_pathname
,
4899 app_bundle_pathname
,
4900 app_bundle_pathname_len
+ 1,
4901 kCFStringEncodingISOLatin1
))
4903 CFRelease (cf_app_bundle_pathname
);
4907 CFRelease (cf_app_bundle_pathname
);
4909 /* P should have sufficient room for the pathname of the bundle plus
4910 the subpath in it leading to the respective directories. Q
4911 should have three times that much room because EMACSLOADPATH can
4912 have the value "<path to lisp dir>:<path to leim dir>:<path to
4914 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4915 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4916 if (!getenv ("EMACSLOADPATH"))
4920 strcpy (p
, app_bundle_pathname
);
4921 strcat (p
, "/Contents/Resources/lisp");
4922 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4925 strcpy (p
, app_bundle_pathname
);
4926 strcat (p
, "/Contents/Resources/leim");
4927 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4934 strcpy (p
, app_bundle_pathname
);
4935 strcat (p
, "/Contents/Resources/site-lisp");
4936 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4944 setenv ("EMACSLOADPATH", q
, 1);
4947 if (!getenv ("EMACSPATH"))
4951 strcpy (p
, app_bundle_pathname
);
4952 strcat (p
, "/Contents/MacOS/libexec");
4953 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4956 strcpy (p
, app_bundle_pathname
);
4957 strcat (p
, "/Contents/MacOS/bin");
4958 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4966 setenv ("EMACSPATH", q
, 1);
4969 if (!getenv ("EMACSDATA"))
4971 strcpy (p
, app_bundle_pathname
);
4972 strcat (p
, "/Contents/Resources/etc");
4973 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4974 setenv ("EMACSDATA", p
, 1);
4977 if (!getenv ("EMACSDOC"))
4979 strcpy (p
, app_bundle_pathname
);
4980 strcat (p
, "/Contents/Resources/etc");
4981 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4982 setenv ("EMACSDOC", p
, 1);
4985 if (!getenv ("INFOPATH"))
4987 strcpy (p
, app_bundle_pathname
);
4988 strcat (p
, "/Contents/Resources/info");
4989 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4990 setenv ("INFOPATH", p
, 1);
4993 #endif /* MAC_OSX */
4999 Qundecoded_file_name
= intern ("undecoded-file-name");
5000 staticpro (&Qundecoded_file_name
);
5002 #if TARGET_API_MAC_CARBON
5003 Qstring
= intern ("string"); staticpro (&Qstring
);
5004 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5005 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5006 Qdate
= intern ("date"); staticpro (&Qdate
);
5007 Qdata
= intern ("data"); staticpro (&Qdata
);
5008 Qarray
= intern ("array"); staticpro (&Qarray
);
5009 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5011 Qxml
= intern ("xml");
5014 Qmime_charset
= intern ("mime-charset");
5015 staticpro (&Qmime_charset
);
5017 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5018 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5019 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5020 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5021 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5022 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5025 defsubr (&Smac_coerce_ae_data
);
5026 #if TARGET_API_MAC_CARBON
5027 defsubr (&Smac_get_preference
);
5028 defsubr (&Smac_code_convert_string
);
5030 defsubr (&Smac_clear_font_name_table
);
5032 defsubr (&Smac_set_file_creator
);
5033 defsubr (&Smac_set_file_type
);
5034 defsubr (&Smac_get_file_creator
);
5035 defsubr (&Smac_get_file_type
);
5036 defsubr (&Sdo_applescript
);
5037 defsubr (&Smac_file_name_to_posix
);
5038 defsubr (&Sposix_file_name_to_mac
);
5040 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5041 doc
: /* The system script code. */);
5042 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5044 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5045 doc
: /* The system locale identifier string.
5046 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5047 information is not included. */);
5048 Vmac_system_locale
= mac_get_system_locale ();
5051 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5052 (do not change this comment) */