1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 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). */
35 #include "sysselect.h"
36 #include "blockinput.h"
42 #if !TARGET_API_MAC_CARBON
45 #include <TextUtils.h>
47 #include <Resources.h>
52 #include <AppleScript.h>
55 #include <Processes.h>
57 #include <MacLocales.h>
59 #endif /* not TARGET_API_MAC_CARBON */
63 #include <sys/types.h>
67 #include <sys/param.h>
73 /* The system script code. */
74 static int mac_system_script_code
;
76 /* The system locale identifier string. */
77 static Lisp_Object Vmac_system_locale
;
79 /* An instance of the AppleScript component. */
80 static ComponentInstance as_scripting_component
;
81 /* The single script context used for all script executions. */
82 static OSAID as_script_context
;
85 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
86 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
89 /* When converting from Mac to Unix pathnames, /'s in folder names are
90 converted to :'s. This function, used in copying folder names,
91 performs a strncat and converts all character a to b in the copy of
92 the string s2 appended to the end of s1. */
95 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
103 for (i
= 0; i
< l2
; i
++)
112 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
113 that does not begin with a ':' and contains at least one ':'. A Mac
114 full pathname causes a '/' to be prepended to the Posix pathname.
115 The algorithm for the rest of the pathname is as follows:
116 For each segment between two ':',
117 if it is non-null, copy as is and then add a '/' at the end,
118 otherwise, insert a "../" into the Posix pathname.
119 Returns 1 if successful; 0 if fails. */
122 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
124 const char *p
, *q
, *pe
;
131 p
= strchr (mfn
, ':');
132 if (p
!= 0 && p
!= mfn
) /* full pathname */
139 pe
= mfn
+ strlen (mfn
);
146 { /* two consecutive ':' */
147 if (strlen (ufn
) + 3 >= ufnbuflen
)
153 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
155 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
162 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
164 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
165 /* no separator for last one */
174 extern char *get_temp_dir_name ();
177 /* Convert a Posix pathname to Mac form. Approximately reverse of the
178 above in algorithm. */
181 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
183 const char *p
, *q
, *pe
;
184 char expanded_pathname
[MAXPATHLEN
+1];
193 /* Check for and handle volume names. Last comparison: strangely
194 somewhere "/.emacs" is passed. A temporary fix for now. */
195 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
197 if (strlen (p
) + 1 > mfnbuflen
)
204 /* expand to emacs dir found by init_emacs_passwd_dir */
205 if (strncmp (p
, "~emacs/", 7) == 0)
207 struct passwd
*pw
= getpwnam ("emacs");
209 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
211 strcpy (expanded_pathname
, pw
->pw_dir
);
212 strcat (expanded_pathname
, p
);
213 p
= expanded_pathname
;
214 /* now p points to the pathname with emacs dir prefix */
216 else if (strncmp (p
, "/tmp/", 5) == 0)
218 char *t
= get_temp_dir_name ();
220 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
222 strcpy (expanded_pathname
, t
);
223 strcat (expanded_pathname
, p
);
224 p
= expanded_pathname
;
225 /* now p points to the pathname with emacs dir prefix */
227 else if (*p
!= '/') /* relative pathname */
239 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
241 if (strlen (mfn
) + 1 >= mfnbuflen
)
247 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
249 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
256 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
258 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
267 /***********************************************************************
268 Conversions on Apple event objects
269 ***********************************************************************/
271 static Lisp_Object Qundecoded_file_name
;
274 mac_aelist_to_lisp (desc_list
)
275 AEDescList
*desc_list
;
279 Lisp_Object result
, elem
;
285 err
= AECountItems (desc_list
, &count
);
291 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
298 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
302 elem
= mac_aelist_to_lisp (&desc
);
303 AEDisposeDesc (&desc
);
307 if (desc_type
== typeNull
)
311 elem
= make_uninit_string (size
);
312 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
313 &desc_type
, SDATA (elem
), size
, &size
);
317 desc_type
= EndianU32_NtoB (desc_type
);
318 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
324 else if (desc_list
->descriptorType
!= typeAEList
)
326 keyword
= EndianU32_NtoB (keyword
);
327 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
330 result
= Fcons (elem
, result
);
334 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
335 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
339 mac_aedesc_to_lisp (desc
)
343 DescType desc_type
= desc
->descriptorType
;
355 return mac_aelist_to_lisp (desc
);
357 /* The following one is much simpler, but creates and disposes
358 of Apple event descriptors many times. */
365 err
= AECountItems (desc
, &count
);
371 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
374 elem
= mac_aedesc_to_lisp (&desc1
);
375 AEDisposeDesc (&desc1
);
376 if (desc_type
!= typeAEList
)
378 keyword
= EndianU32_NtoB (keyword
);
379 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
381 result
= Fcons (elem
, result
);
389 #if TARGET_API_MAC_CARBON
390 result
= make_uninit_string (AEGetDescDataSize (desc
));
391 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
393 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
394 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
402 desc_type
= EndianU32_NtoB (desc_type
);
403 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
407 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
408 to_type
, handler_refcon
, result
)
410 const void *data_ptr
;
418 if (type_code
== typeNull
)
419 err
= errAECoercionFail
;
420 else if (type_code
== to_type
|| to_type
== typeWildCard
)
421 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
422 else if (type_code
== TYPE_FILE_NAME
)
423 /* Coercion from undecoded file name. */
428 CFDataRef data
= NULL
;
430 str
= CFStringCreateWithBytes (NULL
, data_ptr
, data_size
,
431 kCFStringEncodingUTF8
, false);
434 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
435 kCFURLPOSIXPathStyle
, false);
440 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
445 err
= AECoercePtr (typeFileURL
, CFDataGetBytePtr (data
),
446 CFDataGetLength (data
), to_type
, result
);
455 buf
= xmalloc (data_size
+ 1);
458 memcpy (buf
, data_ptr
, data_size
);
459 buf
[data_size
] = '\0';
460 err
= posix_pathname_to_fsspec (buf
, &fs
);
466 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
469 else if (to_type
== TYPE_FILE_NAME
)
470 /* Coercion to undecoded file name. */
474 CFStringRef str
= NULL
;
475 CFDataRef data
= NULL
;
477 if (type_code
== typeFileURL
)
478 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
479 kCFStringEncodingUTF8
, NULL
);
486 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
490 size
= AEGetDescDataSize (&desc
);
491 buf
= xmalloc (size
);
494 err
= AEGetDescData (&desc
, buf
, size
);
496 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
497 kCFStringEncodingUTF8
, NULL
);
500 AEDisposeDesc (&desc
);
505 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
510 data
= CFStringCreateExternalRepresentation (NULL
, str
,
511 kCFStringEncodingUTF8
,
517 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
518 CFDataGetLength (data
), result
);
522 char file_name
[MAXPATHLEN
];
524 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
525 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
526 sizeof (file_name
) - 1);
532 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
535 #if TARGET_API_MAC_CARBON
536 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
538 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
541 err
= fsspec_to_posix_pathname (&fs
, file_name
,
542 sizeof (file_name
) - 1);
543 AEDisposeDesc (&desc
);
547 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
548 strlen (file_name
), result
);
555 return errAECoercionFail
;
560 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
561 const AEDesc
*from_desc
;
567 DescType from_type
= from_desc
->descriptorType
;
569 if (from_type
== typeNull
)
570 err
= errAECoercionFail
;
571 else if (from_type
== to_type
|| to_type
== typeWildCard
)
572 err
= AEDuplicateDesc (from_desc
, result
);
578 #if TARGET_API_MAC_CARBON
579 data_size
= AEGetDescDataSize (from_desc
);
581 data_size
= GetHandleSize (from_desc
->dataHandle
);
583 data_ptr
= xmalloc (data_size
);
586 #if TARGET_API_MAC_CARBON
587 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
589 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
592 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
594 handler_refcon
, result
);
602 return errAECoercionFail
;
607 init_coercion_handler ()
611 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
612 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
614 if (coerce_file_name_ptrUPP
== NULL
)
616 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
617 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
620 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
621 (AECoercionHandlerUPP
)
622 coerce_file_name_ptrUPP
, 0, false, false);
624 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
625 (AECoercionHandlerUPP
)
626 coerce_file_name_ptrUPP
, 0, false, false);
628 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
629 coerce_file_name_descUPP
, 0, true, false);
631 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
632 coerce_file_name_descUPP
, 0, true, false);
636 #if TARGET_API_MAC_CARBON
638 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
641 EventParamName
*names
;
642 EventParamType
*types
;
646 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
647 AEAddressDesc address_desc
;
653 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
654 sizeof (ProcessSerialNumber
), &address_desc
);
657 err
= AECreateAppleEvent (0, 0, /* Dummy class and ID. */
658 &address_desc
, /* NULL is not allowed
659 on Mac OS Classic. */
660 kAutoGenerateReturnID
,
661 kAnyTransactionID
, result
);
662 AEDisposeDesc (&address_desc
);
667 for (i
= 0; i
< num_params
; i
++)
671 case typeCFStringRef
:
672 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
673 sizeof (CFStringRef
), NULL
, &string
);
676 data
= CFStringCreateExternalRepresentation (NULL
, string
,
677 kCFStringEncodingUTF8
,
681 /* typeUTF8Text is not available on Mac OS X 10.1. */
682 AEPutParamPtr (result
, names
[i
], 'utf8',
683 CFDataGetBytePtr (data
), CFDataGetLength (data
));
689 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
693 buf
= xmalloc (size
);
696 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
699 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
709 /***********************************************************************
710 Conversion between Lisp and Core Foundation objects
711 ***********************************************************************/
713 #if TARGET_API_MAC_CARBON
714 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
715 static Lisp_Object Qarray
, Qdictionary
;
717 struct cfdict_context
720 int with_tag
, hash_bound
;
723 /* C string to CFString. */
726 cfstring_create_with_utf8_cstring (c_str
)
731 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
733 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
734 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
740 /* Lisp string to CFString. */
743 cfstring_create_with_string (s
)
746 CFStringRef string
= NULL
;
748 if (STRING_MULTIBYTE (s
))
750 char *p
, *end
= SDATA (s
) + SBYTES (s
);
752 for (p
= SDATA (s
); p
< end
; p
++)
755 s
= ENCODE_UTF_8 (s
);
758 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
759 kCFStringEncodingUTF8
, false);
763 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
764 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
765 kCFStringEncodingMacRoman
, false);
771 /* From CFData to a lisp string. Always returns a unibyte string. */
774 cfdata_to_lisp (data
)
777 CFIndex len
= CFDataGetLength (data
);
778 Lisp_Object result
= make_uninit_string (len
);
780 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
786 /* From CFString to a lisp string. Returns a unibyte string
787 containing a UTF-8 byte sequence. */
790 cfstring_to_lisp_nodecode (string
)
793 Lisp_Object result
= Qnil
;
794 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
797 result
= make_unibyte_string (s
, strlen (s
));
801 CFStringCreateExternalRepresentation (NULL
, string
,
802 kCFStringEncodingUTF8
, '?');
806 result
= cfdata_to_lisp (data
);
815 /* From CFString to a lisp string. Never returns a unibyte string
816 (even if it only contains ASCII characters).
817 This may cause GC during code conversion. */
820 cfstring_to_lisp (string
)
823 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
827 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
828 /* This may be superfluous. Just to make sure that the result
829 is a multibyte string. */
830 result
= string_to_multibyte (result
);
837 /* CFNumber to a lisp integer or a lisp float. */
840 cfnumber_to_lisp (number
)
843 Lisp_Object result
= Qnil
;
844 #if BITS_PER_EMACS_INT > 32
846 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
849 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
853 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
854 && !FIXNUM_OVERFLOW_P (int_val
))
855 result
= make_number (int_val
);
857 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
858 result
= make_float (float_val
);
863 /* CFDate to a list of three integers as in a return value of
867 cfdate_to_lisp (date
)
870 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
871 static CFAbsoluteTime epoch
= 0.0, sec
;
875 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
877 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
878 high
= sec
/ 65536.0;
879 low
= sec
- high
* 65536.0;
881 return list3 (make_number (high
), make_number (low
), make_number (0));
885 /* CFBoolean to a lisp symbol, `t' or `nil'. */
888 cfboolean_to_lisp (boolean
)
889 CFBooleanRef boolean
;
891 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
895 /* Any Core Foundation object to a (lengthy) lisp string. */
898 cfobject_desc_to_lisp (object
)
901 Lisp_Object result
= Qnil
;
902 CFStringRef desc
= CFCopyDescription (object
);
906 result
= cfstring_to_lisp (desc
);
914 /* Callback functions for cfproperty_list_to_lisp. */
917 cfdictionary_add_to_list (key
, value
, context
)
922 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
925 Fcons (Fcons (cfstring_to_lisp (key
),
926 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
932 cfdictionary_puthash (key
, value
, context
)
937 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
938 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
939 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
942 hash_lookup (h
, lisp_key
, &hash_code
);
943 hash_put (h
, lisp_key
,
944 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
949 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
950 non-zero, a symbol that represents the type of the original Core
951 Foundation object is prepended. HASH_BOUND specifies which kinds
952 of the lisp objects, alists or hash tables, are used as the targets
953 of the conversion from CFDictionary. If HASH_BOUND is negative,
954 always generate alists. If HASH_BOUND >= 0, generate an alist if
955 the number of keys in the dictionary is smaller than HASH_BOUND,
956 and a hash table otherwise. */
959 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
960 CFPropertyListRef plist
;
961 int with_tag
, hash_bound
;
963 CFTypeID type_id
= CFGetTypeID (plist
);
964 Lisp_Object tag
= Qnil
, result
= Qnil
;
965 struct gcpro gcpro1
, gcpro2
;
967 GCPRO2 (tag
, result
);
969 if (type_id
== CFStringGetTypeID ())
972 result
= cfstring_to_lisp (plist
);
974 else if (type_id
== CFNumberGetTypeID ())
977 result
= cfnumber_to_lisp (plist
);
979 else if (type_id
== CFBooleanGetTypeID ())
982 result
= cfboolean_to_lisp (plist
);
984 else if (type_id
== CFDateGetTypeID ())
987 result
= cfdate_to_lisp (plist
);
989 else if (type_id
== CFDataGetTypeID ())
992 result
= cfdata_to_lisp (plist
);
994 else if (type_id
== CFArrayGetTypeID ())
996 CFIndex index
, count
= CFArrayGetCount (plist
);
999 result
= Fmake_vector (make_number (count
), Qnil
);
1000 for (index
= 0; index
< count
; index
++)
1001 XVECTOR (result
)->contents
[index
] =
1002 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1003 with_tag
, hash_bound
);
1005 else if (type_id
== CFDictionaryGetTypeID ())
1007 struct cfdict_context context
;
1008 CFIndex count
= CFDictionaryGetCount (plist
);
1011 context
.result
= &result
;
1012 context
.with_tag
= with_tag
;
1013 context
.hash_bound
= hash_bound
;
1014 if (hash_bound
< 0 || count
< hash_bound
)
1017 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1022 result
= make_hash_table (Qequal
,
1023 make_number (count
),
1024 make_float (DEFAULT_REHASH_SIZE
),
1025 make_float (DEFAULT_REHASH_THRESHOLD
),
1027 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1037 result
= Fcons (tag
, result
);
1044 /***********************************************************************
1045 Emulation of the X Resource Manager
1046 ***********************************************************************/
1048 /* Parser functions for resource lines. Each function takes an
1049 address of a variable whose value points to the head of a string.
1050 The value will be advanced so that it points to the next character
1051 of the parsed part when the function returns.
1053 A resource name such as "Emacs*font" is parsed into a non-empty
1054 list called `quarks'. Each element is either a Lisp string that
1055 represents a concrete component, a Lisp symbol LOOSE_BINDING
1056 (actually Qlambda) that represents any number (>=0) of intervening
1057 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1058 that represents as any single component. */
1062 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1063 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1066 skip_white_space (p
)
1069 /* WhiteSpace = {<space> | <horizontal tab>} */
1070 while (*P
== ' ' || *P
== '\t')
1078 /* Comment = "!" {<any character except null or newline>} */
1091 /* Don't interpret filename. Just skip until the newline. */
1093 parse_include_file (p
)
1096 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1113 /* Binding = "." | "*" */
1114 if (*P
== '.' || *P
== '*')
1116 char binding
= *P
++;
1118 while (*P
== '.' || *P
== '*')
1131 /* Component = "?" | ComponentName
1132 ComponentName = NameChar {NameChar}
1133 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1137 return SINGLE_COMPONENT
;
1139 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1143 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1146 return make_unibyte_string (start
, P
- start
);
1153 parse_resource_name (p
)
1156 Lisp_Object result
= Qnil
, component
;
1159 /* ResourceName = [Binding] {Component Binding} ComponentName */
1160 if (parse_binding (p
) == '*')
1161 result
= Fcons (LOOSE_BINDING
, result
);
1163 component
= parse_component (p
);
1164 if (NILP (component
))
1167 result
= Fcons (component
, result
);
1168 while ((binding
= parse_binding (p
)) != '\0')
1171 result
= Fcons (LOOSE_BINDING
, result
);
1172 component
= parse_component (p
);
1173 if (NILP (component
))
1176 result
= Fcons (component
, result
);
1179 /* The final component should not be '?'. */
1180 if (EQ (component
, SINGLE_COMPONENT
))
1183 return Fnreverse (result
);
1191 Lisp_Object seq
= Qnil
, result
;
1192 int buf_len
, total_len
= 0, len
, continue_p
;
1194 q
= strchr (P
, '\n');
1195 buf_len
= q
? q
- P
: strlen (P
);
1196 buf
= xmalloc (buf_len
);
1209 else if (*P
== '\\')
1214 else if (*P
== '\n')
1225 else if ('0' <= P
[0] && P
[0] <= '7'
1226 && '0' <= P
[1] && P
[1] <= '7'
1227 && '0' <= P
[2] && P
[2] <= '7')
1229 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1239 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1244 q
= strchr (P
, '\n');
1245 len
= q
? q
- P
: strlen (P
);
1250 buf
= xmalloc (buf_len
);
1258 if (SBYTES (XCAR (seq
)) == total_len
)
1259 return make_string (SDATA (XCAR (seq
)), total_len
);
1262 buf
= xmalloc (total_len
);
1263 q
= buf
+ total_len
;
1264 for (; CONSP (seq
); seq
= XCDR (seq
))
1266 len
= SBYTES (XCAR (seq
));
1268 memcpy (q
, SDATA (XCAR (seq
)), len
);
1270 result
= make_string (buf
, total_len
);
1277 parse_resource_line (p
)
1280 Lisp_Object quarks
, value
;
1282 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1283 if (parse_comment (p
) || parse_include_file (p
))
1286 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1287 skip_white_space (p
);
1288 quarks
= parse_resource_name (p
);
1291 skip_white_space (p
);
1295 skip_white_space (p
);
1296 value
= parse_value (p
);
1297 return Fcons (quarks
, value
);
1300 /* Skip the remaining data as a dummy value. */
1307 /* Equivalents of X Resource Manager functions.
1309 An X Resource Database acts as a collection of resource names and
1310 associated values. It is implemented as a trie on quarks. Namely,
1311 each edge is labeled by either a string, LOOSE_BINDING, or
1312 SINGLE_COMPONENT. Each node has a node id, which is a unique
1313 nonnegative integer, and the root node id is 0. A database is
1314 implemented as a hash table that maps a pair (SRC-NODE-ID .
1315 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1316 in the table as a value for HASHKEY_MAX_NID. A value associated to
1317 a node is recorded as a value for the node id.
1319 A database also has a cache for past queries as a value for
1320 HASHKEY_QUERY_CACHE. It is another hash table that maps
1321 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1323 #define HASHKEY_MAX_NID (make_number (0))
1324 #define HASHKEY_QUERY_CACHE (make_number (-1))
1327 xrm_create_database ()
1329 XrmDatabase database
;
1331 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1332 make_float (DEFAULT_REHASH_SIZE
),
1333 make_float (DEFAULT_REHASH_THRESHOLD
),
1335 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1336 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1342 xrm_q_put_resource (database
, quarks
, value
)
1343 XrmDatabase database
;
1344 Lisp_Object quarks
, value
;
1346 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1349 Lisp_Object node_id
, key
;
1351 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1353 XSETINT (node_id
, 0);
1354 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1356 key
= Fcons (node_id
, XCAR (quarks
));
1357 i
= hash_lookup (h
, key
, &hash_code
);
1361 XSETINT (node_id
, max_nid
);
1362 hash_put (h
, key
, node_id
, hash_code
);
1365 node_id
= HASH_VALUE (h
, i
);
1367 Fputhash (node_id
, value
, database
);
1369 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1370 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1373 /* Merge multiple resource entries specified by DATA into a resource
1374 database DATABASE. DATA points to the head of a null-terminated
1375 string consisting of multiple resource lines. It's like a
1376 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1379 xrm_merge_string_database (database
, data
)
1380 XrmDatabase database
;
1383 Lisp_Object quarks_value
;
1387 quarks_value
= parse_resource_line (&data
);
1388 if (!NILP (quarks_value
))
1389 xrm_q_put_resource (database
,
1390 XCAR (quarks_value
), XCDR (quarks_value
));
1395 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1396 XrmDatabase database
;
1397 Lisp_Object node_id
, quark_name
, quark_class
;
1399 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1400 Lisp_Object key
, labels
[3], value
;
1403 if (!CONSP (quark_name
))
1404 return Fgethash (node_id
, database
, Qnil
);
1406 /* First, try tight bindings */
1407 labels
[0] = XCAR (quark_name
);
1408 labels
[1] = XCAR (quark_class
);
1409 labels
[2] = SINGLE_COMPONENT
;
1411 key
= Fcons (node_id
, Qnil
);
1412 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1414 XSETCDR (key
, labels
[k
]);
1415 i
= hash_lookup (h
, key
, NULL
);
1418 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1419 XCDR (quark_name
), XCDR (quark_class
));
1425 /* Then, try loose bindings */
1426 XSETCDR (key
, LOOSE_BINDING
);
1427 i
= hash_lookup (h
, key
, NULL
);
1430 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1431 quark_name
, quark_class
);
1435 return xrm_q_get_resource_1 (database
, node_id
,
1436 XCDR (quark_name
), XCDR (quark_class
));
1443 xrm_q_get_resource (database
, quark_name
, quark_class
)
1444 XrmDatabase database
;
1445 Lisp_Object quark_name
, quark_class
;
1447 return xrm_q_get_resource_1 (database
, make_number (0),
1448 quark_name
, quark_class
);
1451 /* Retrieve a resource value for the specified NAME and CLASS from the
1452 resource database DATABASE. It corresponds to XrmGetResource. */
1455 xrm_get_resource (database
, name
, class)
1456 XrmDatabase database
;
1459 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1461 struct Lisp_Hash_Table
*h
;
1465 nc
= strlen (class);
1466 key
= make_uninit_string (nn
+ nc
+ 1);
1467 strcpy (SDATA (key
), name
);
1468 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1470 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1471 if (NILP (query_cache
))
1473 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1474 make_float (DEFAULT_REHASH_SIZE
),
1475 make_float (DEFAULT_REHASH_THRESHOLD
),
1477 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1479 h
= XHASH_TABLE (query_cache
);
1480 i
= hash_lookup (h
, key
, &hash_code
);
1482 return HASH_VALUE (h
, i
);
1484 quark_name
= parse_resource_name (&name
);
1487 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1488 if (!STRINGP (XCAR (tmp
)))
1491 quark_class
= parse_resource_name (&class);
1494 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1495 if (!STRINGP (XCAR (tmp
)))
1502 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1503 hash_put (h
, key
, tmp
, hash_code
);
1508 #if TARGET_API_MAC_CARBON
1510 xrm_cfproperty_list_to_value (plist
)
1511 CFPropertyListRef plist
;
1513 CFTypeID type_id
= CFGetTypeID (plist
);
1515 if (type_id
== CFStringGetTypeID ())
1516 return cfstring_to_lisp (plist
);
1517 else if (type_id
== CFNumberGetTypeID ())
1520 Lisp_Object result
= Qnil
;
1522 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1525 result
= cfstring_to_lisp (string
);
1530 else if (type_id
== CFBooleanGetTypeID ())
1531 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1532 else if (type_id
== CFDataGetTypeID ())
1533 return cfdata_to_lisp (plist
);
1539 /* Create a new resource database from the preferences for the
1540 application APPLICATION. APPLICATION is either a string that
1541 specifies an application ID, or NULL that represents the current
1545 xrm_get_preference_database (application
)
1548 #if TARGET_API_MAC_CARBON
1549 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1550 CFMutableSetRef key_set
= NULL
;
1551 CFArrayRef key_array
;
1552 CFIndex index
, count
;
1554 XrmDatabase database
;
1555 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1556 CFPropertyListRef plist
;
1558 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1560 user_doms
[0] = kCFPreferencesCurrentUser
;
1561 user_doms
[1] = kCFPreferencesAnyUser
;
1562 host_doms
[0] = kCFPreferencesCurrentHost
;
1563 host_doms
[1] = kCFPreferencesAnyHost
;
1565 database
= xrm_create_database ();
1567 GCPRO3 (database
, quarks
, value
);
1571 app_id
= kCFPreferencesCurrentApplication
;
1574 app_id
= cfstring_create_with_utf8_cstring (application
);
1579 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1580 if (key_set
== NULL
)
1582 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1583 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1585 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1589 count
= CFArrayGetCount (key_array
);
1590 for (index
= 0; index
< count
; index
++)
1591 CFSetAddValue (key_set
,
1592 CFArrayGetValueAtIndex (key_array
, index
));
1593 CFRelease (key_array
);
1597 count
= CFSetGetCount (key_set
);
1598 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1601 CFSetGetValues (key_set
, (const void **)keys
);
1602 for (index
= 0; index
< count
; index
++)
1604 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1605 quarks
= parse_resource_name (&res_name
);
1606 if (!(NILP (quarks
) || *res_name
))
1608 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1609 value
= xrm_cfproperty_list_to_value (plist
);
1612 xrm_q_put_resource (database
, quarks
, value
);
1619 CFRelease (key_set
);
1628 return xrm_create_database ();
1635 /* The following functions with "sys_" prefix are stubs to Unix
1636 functions that have already been implemented by CW or MPW. The
1637 calls to them in Emacs source course are #define'd to call the sys_
1638 versions by the header files s-mac.h. In these stubs pathnames are
1639 converted between their Unix and Mac forms. */
1642 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1643 + 17 leap days. These are for adjusting time values returned by
1644 MacOS Toolbox functions. */
1646 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1649 #if __MSL__ < 0x6000
1650 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1651 a leap year! This is for adjusting time_t values returned by MSL
1653 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1654 #else /* __MSL__ >= 0x6000 */
1655 /* CW changes Pro 6 to follow Unix! */
1656 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1657 #endif /* __MSL__ >= 0x6000 */
1659 /* MPW library functions follow Unix (confused?). */
1660 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1661 #else /* not __MRC__ */
1663 #endif /* not __MRC__ */
1666 /* Define our own stat function for both MrC and CW. The reason for
1667 doing this: "stat" is both the name of a struct and function name:
1668 can't use the same trick like that for sys_open, sys_close, etc. to
1669 redirect Emacs's calls to our own version that converts Unix style
1670 filenames to Mac style filename because all sorts of compilation
1671 errors will be generated if stat is #define'd to be sys_stat. */
1674 stat_noalias (const char *path
, struct stat
*buf
)
1676 char mac_pathname
[MAXPATHLEN
+1];
1679 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1682 c2pstr (mac_pathname
);
1683 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1684 cipb
.hFileInfo
.ioVRefNum
= 0;
1685 cipb
.hFileInfo
.ioDirID
= 0;
1686 cipb
.hFileInfo
.ioFDirIndex
= 0;
1687 /* set to 0 to get information about specific dir or file */
1689 errno
= PBGetCatInfo (&cipb
, false);
1690 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1695 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1697 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1699 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1700 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1701 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1702 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1703 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1704 /* size of dir = number of files and dirs */
1707 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1708 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1712 buf
->st_mode
= S_IFREG
| S_IREAD
;
1713 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1714 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1715 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1716 buf
->st_mode
|= S_IEXEC
;
1717 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1718 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1719 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1722 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1723 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1726 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1728 /* identify alias files as symlinks */
1729 buf
->st_mode
&= ~S_IFREG
;
1730 buf
->st_mode
|= S_IFLNK
;
1734 buf
->st_uid
= getuid ();
1735 buf
->st_gid
= getgid ();
1743 lstat (const char *path
, struct stat
*buf
)
1746 char true_pathname
[MAXPATHLEN
+1];
1748 /* Try looking for the file without resolving aliases first. */
1749 if ((result
= stat_noalias (path
, buf
)) >= 0)
1752 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1755 return stat_noalias (true_pathname
, buf
);
1760 stat (const char *path
, struct stat
*sb
)
1763 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1766 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1767 ! (sb
->st_mode
& S_IFLNK
))
1770 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1773 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1776 fully_resolved_name
[len
] = '\0';
1777 /* in fact our readlink terminates strings */
1778 return lstat (fully_resolved_name
, sb
);
1781 return lstat (true_pathname
, sb
);
1786 /* CW defines fstat in stat.mac.c while MPW does not provide this
1787 function. Without the information of how to get from a file
1788 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1789 to implement this function. Fortunately, there is only one place
1790 where this function is called in our configuration: in fileio.c,
1791 where only the st_dev and st_ino fields are used to determine
1792 whether two fildes point to different i-nodes to prevent copying
1793 a file onto itself equal. What we have here probably needs
1797 fstat (int fildes
, struct stat
*buf
)
1800 buf
->st_ino
= fildes
;
1801 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1802 return 0; /* success */
1804 #endif /* __MRC__ */
1808 mkdir (const char *dirname
, int mode
)
1810 #pragma unused(mode)
1813 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1815 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1818 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1821 c2pstr (mac_pathname
);
1822 hfpb
.ioNamePtr
= mac_pathname
;
1823 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1824 hfpb
.ioDirID
= 0; /* parent is the root */
1826 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1827 /* just return the Mac OSErr code for now */
1828 return errno
== noErr
? 0 : -1;
1833 sys_rmdir (const char *dirname
)
1836 char mac_pathname
[MAXPATHLEN
+1];
1838 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1841 c2pstr (mac_pathname
);
1842 hfpb
.ioNamePtr
= mac_pathname
;
1843 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1844 hfpb
.ioDirID
= 0; /* parent is the root */
1846 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1847 return errno
== noErr
? 0 : -1;
1852 /* No implementation yet. */
1854 execvp (const char *path
, ...)
1858 #endif /* __MRC__ */
1862 utime (const char *path
, const struct utimbuf
*times
)
1864 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1866 char mac_pathname
[MAXPATHLEN
+1];
1869 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1872 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1874 fully_resolved_name
[len
] = '\0';
1876 strcpy (fully_resolved_name
, true_pathname
);
1878 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1881 c2pstr (mac_pathname
);
1882 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1883 cipb
.hFileInfo
.ioVRefNum
= 0;
1884 cipb
.hFileInfo
.ioDirID
= 0;
1885 cipb
.hFileInfo
.ioFDirIndex
= 0;
1886 /* set to 0 to get information about specific dir or file */
1888 errno
= PBGetCatInfo (&cipb
, false);
1892 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1895 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1897 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1902 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1904 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1907 errno
= PBSetCatInfo (&cipb
, false);
1908 return errno
== noErr
? 0 : -1;
1922 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1924 access (const char *path
, int mode
)
1926 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1928 char mac_pathname
[MAXPATHLEN
+1];
1931 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1934 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1936 fully_resolved_name
[len
] = '\0';
1938 strcpy (fully_resolved_name
, true_pathname
);
1940 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1943 c2pstr (mac_pathname
);
1944 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1945 cipb
.hFileInfo
.ioVRefNum
= 0;
1946 cipb
.hFileInfo
.ioDirID
= 0;
1947 cipb
.hFileInfo
.ioFDirIndex
= 0;
1948 /* set to 0 to get information about specific dir or file */
1950 errno
= PBGetCatInfo (&cipb
, false);
1954 if (mode
== F_OK
) /* got this far, file exists */
1958 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1962 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1969 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1970 /* don't allow if lock bit is on */
1976 #define DEV_NULL_FD 0x10000
1980 sys_open (const char *path
, int oflag
)
1982 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1984 char mac_pathname
[MAXPATHLEN
+1];
1986 if (strcmp (path
, "/dev/null") == 0)
1987 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1989 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1992 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1994 fully_resolved_name
[len
] = '\0';
1996 strcpy (fully_resolved_name
, true_pathname
);
1998 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2003 int res
= open (mac_pathname
, oflag
);
2004 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2005 if (oflag
& O_CREAT
)
2006 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2008 #else /* not __MRC__ */
2009 return open (mac_pathname
, oflag
);
2010 #endif /* not __MRC__ */
2017 sys_creat (const char *path
, mode_t mode
)
2019 char true_pathname
[MAXPATHLEN
+1];
2021 char mac_pathname
[MAXPATHLEN
+1];
2023 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2026 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2031 int result
= creat (mac_pathname
);
2032 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2034 #else /* not __MRC__ */
2035 return creat (mac_pathname
, mode
);
2036 #endif /* not __MRC__ */
2043 sys_unlink (const char *path
)
2045 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2047 char mac_pathname
[MAXPATHLEN
+1];
2049 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2052 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2054 fully_resolved_name
[len
] = '\0';
2056 strcpy (fully_resolved_name
, true_pathname
);
2058 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2061 return unlink (mac_pathname
);
2067 sys_read (int fildes
, char *buf
, int count
)
2069 if (fildes
== 0) /* this should not be used for console input */
2072 #if __MSL__ >= 0x6000
2073 return _read (fildes
, buf
, count
);
2075 return read (fildes
, buf
, count
);
2082 sys_write (int fildes
, const char *buf
, int count
)
2084 if (fildes
== DEV_NULL_FD
)
2087 #if __MSL__ >= 0x6000
2088 return _write (fildes
, buf
, count
);
2090 return write (fildes
, buf
, count
);
2097 sys_rename (const char * old_name
, const char * new_name
)
2099 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2100 char fully_resolved_old_name
[MAXPATHLEN
+1];
2102 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2104 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2107 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2109 fully_resolved_old_name
[len
] = '\0';
2111 strcpy (fully_resolved_old_name
, true_old_pathname
);
2113 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2116 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2119 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2124 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2127 /* If a file with new_name already exists, rename deletes the old
2128 file in Unix. CW version fails in these situation. So we add a
2129 call to unlink here. */
2130 (void) unlink (mac_new_name
);
2132 return rename (mac_old_name
, mac_new_name
);
2137 extern FILE *fopen (const char *name
, const char *mode
);
2139 sys_fopen (const char *name
, const char *mode
)
2141 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2143 char mac_pathname
[MAXPATHLEN
+1];
2145 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2148 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2150 fully_resolved_name
[len
] = '\0';
2152 strcpy (fully_resolved_name
, true_pathname
);
2154 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2159 if (mode
[0] == 'w' || mode
[0] == 'a')
2160 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2161 #endif /* not __MRC__ */
2162 return fopen (mac_pathname
, mode
);
2167 #include "keyboard.h"
2168 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2171 select (n
, rfds
, wfds
, efds
, timeout
)
2176 struct timeval
*timeout
;
2179 #if TARGET_API_MAC_CARBON
2180 EventTimeout timeout_sec
=
2182 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2183 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2184 : kEventDurationForever
);
2187 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2189 #else /* not TARGET_API_MAC_CARBON */
2191 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2192 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2194 /* Can only handle wait for keyboard input. */
2195 if (n
> 1 || wfds
|| efds
)
2198 /* Also return true if an event other than a keyDown has occurred.
2199 This causes kbd_buffer_get_event in keyboard.c to call
2200 read_avail_input which in turn calls XTread_socket to poll for
2201 these events. Otherwise these never get processed except but a
2202 very slow poll timer. */
2203 if (mac_wait_next_event (&e
, sleep_time
, false))
2206 err
= -9875; /* eventLoopTimedOutErr */
2207 #endif /* not TARGET_API_MAC_CARBON */
2209 if (FD_ISSET (0, rfds
))
2220 if (input_polling_used ())
2222 /* It could be confusing if a real alarm arrives while
2223 processing the fake one. Turn it off and let the
2224 handler reset it. */
2225 extern void poll_for_input_1
P_ ((void));
2226 int old_poll_suppress_count
= poll_suppress_count
;
2227 poll_suppress_count
= 1;
2228 poll_for_input_1 ();
2229 poll_suppress_count
= old_poll_suppress_count
;
2239 /* Simulation of SIGALRM. The stub for function signal stores the
2240 signal handler function in alarm_signal_func if a SIGALRM is
2244 #include "syssignal.h"
2246 static TMTask mac_atimer_task
;
2248 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2250 static int signal_mask
= 0;
2253 __sigfun alarm_signal_func
= (__sigfun
) 0;
2255 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2256 #else /* not __MRC__ and not __MWERKS__ */
2258 #endif /* not __MRC__ and not __MWERKS__ */
2262 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2264 sys_signal (int signal_num
, __sigfun signal_func
)
2266 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2268 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2269 #else /* not __MRC__ and not __MWERKS__ */
2271 #endif /* not __MRC__ and not __MWERKS__ */
2273 if (signal_num
!= SIGALRM
)
2274 return signal (signal_num
, signal_func
);
2278 __sigfun old_signal_func
;
2280 __signal_func_ptr old_signal_func
;
2284 old_signal_func
= alarm_signal_func
;
2285 alarm_signal_func
= signal_func
;
2286 return old_signal_func
;
2292 mac_atimer_handler (qlink
)
2295 if (alarm_signal_func
)
2296 (alarm_signal_func
) (SIGALRM
);
2301 set_mac_atimer (count
)
2304 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2306 if (mac_atimer_handlerUPP
== NULL
)
2307 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2308 mac_atimer_task
.tmCount
= 0;
2309 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2310 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2311 InsTime (mac_atimer_qlink
);
2313 PrimeTime (mac_atimer_qlink
, count
);
2318 remove_mac_atimer (remaining_count
)
2319 long *remaining_count
;
2321 if (mac_atimer_qlink
)
2323 RmvTime (mac_atimer_qlink
);
2324 if (remaining_count
)
2325 *remaining_count
= mac_atimer_task
.tmCount
;
2326 mac_atimer_qlink
= NULL
;
2338 int old_mask
= signal_mask
;
2340 signal_mask
|= mask
;
2342 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2343 remove_mac_atimer (NULL
);
2350 sigsetmask (int mask
)
2352 int old_mask
= signal_mask
;
2356 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2357 if (signal_mask
& sigmask (SIGALRM
))
2358 remove_mac_atimer (NULL
);
2360 set_mac_atimer (mac_atimer_task
.tmCount
);
2369 long remaining_count
;
2371 if (remove_mac_atimer (&remaining_count
) == 0)
2373 set_mac_atimer (seconds
* 1000);
2375 return remaining_count
/ 1000;
2379 mac_atimer_task
.tmCount
= seconds
* 1000;
2387 setitimer (which
, value
, ovalue
)
2389 const struct itimerval
*value
;
2390 struct itimerval
*ovalue
;
2392 long remaining_count
;
2393 long count
= (EMACS_SECS (value
->it_value
) * 1000
2394 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2396 if (remove_mac_atimer (&remaining_count
) == 0)
2400 bzero (ovalue
, sizeof (*ovalue
));
2401 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2402 (remaining_count
% 1000) * 1000);
2404 set_mac_atimer (count
);
2407 mac_atimer_task
.tmCount
= count
;
2413 /* gettimeofday should return the amount of time (in a timeval
2414 structure) since midnight today. The toolbox function Microseconds
2415 returns the number of microseconds (in a UnsignedWide value) since
2416 the machine was booted. Also making this complicated is WideAdd,
2417 WideSubtract, etc. take wide values. */
2424 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2425 UnsignedWide uw_microseconds
;
2426 wide w_microseconds
;
2427 time_t sys_time (time_t *);
2429 /* If this function is called for the first time, record the number
2430 of seconds since midnight and the number of microseconds since
2431 boot at the time of this first call. */
2436 systime
= sys_time (NULL
);
2437 /* Store microseconds since midnight in wall_clock_at_epoch. */
2438 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2439 Microseconds (&uw_microseconds
);
2440 /* Store microseconds since boot in clicks_at_epoch. */
2441 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2442 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2445 /* Get time since boot */
2446 Microseconds (&uw_microseconds
);
2448 /* Convert to time since midnight*/
2449 w_microseconds
.hi
= uw_microseconds
.hi
;
2450 w_microseconds
.lo
= uw_microseconds
.lo
;
2451 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2452 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2453 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2461 sleep (unsigned int seconds
)
2463 unsigned long time_up
;
2466 time_up
= TickCount () + seconds
* 60;
2467 while (TickCount () < time_up
)
2469 /* Accept no event; just wait. by T.I. */
2470 WaitNextEvent (0, &e
, 30, NULL
);
2475 #endif /* __MRC__ */
2478 /* The time functions adjust time values according to the difference
2479 between the Unix and CW epoches. */
2482 extern struct tm
*gmtime (const time_t *);
2484 sys_gmtime (const time_t *timer
)
2486 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2488 return gmtime (&unix_time
);
2493 extern struct tm
*localtime (const time_t *);
2495 sys_localtime (const time_t *timer
)
2497 #if __MSL__ >= 0x6000
2498 time_t unix_time
= *timer
;
2500 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2503 return localtime (&unix_time
);
2508 extern char *ctime (const time_t *);
2510 sys_ctime (const time_t *timer
)
2512 #if __MSL__ >= 0x6000
2513 time_t unix_time
= *timer
;
2515 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2518 return ctime (&unix_time
);
2523 extern time_t time (time_t *);
2525 sys_time (time_t *timer
)
2527 #if __MSL__ >= 0x6000
2528 time_t mac_time
= time (NULL
);
2530 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2540 /* no subprocesses, empty wait */
2550 croak (char *badfunc
)
2552 printf ("%s not yet implemented\r\n", badfunc
);
2558 mktemp (char *template)
2563 len
= strlen (template);
2565 while (k
>= 0 && template[k
] == 'X')
2568 k
++; /* make k index of first 'X' */
2572 /* Zero filled, number of digits equal to the number of X's. */
2573 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2582 /* Emulate getpwuid, getpwnam and others. */
2584 #define PASSWD_FIELD_SIZE 256
2586 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2587 static char my_passwd_dir
[MAXPATHLEN
+1];
2589 static struct passwd my_passwd
=
2595 static struct group my_group
=
2597 /* There are no groups on the mac, so we just return "root" as the
2603 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2605 char emacs_passwd_dir
[MAXPATHLEN
+1];
2611 init_emacs_passwd_dir ()
2615 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2617 /* Need pathname of first ancestor that begins with "emacs"
2618 since Mac emacs application is somewhere in the emacs-*
2620 int len
= strlen (emacs_passwd_dir
);
2622 /* j points to the "/" following the directory name being
2625 while (i
>= 0 && !found
)
2627 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2629 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2630 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2632 emacs_passwd_dir
[j
+1] = '\0';
2643 /* Setting to "/" probably won't work but set it to something
2645 strcpy (emacs_passwd_dir
, "/");
2646 strcpy (my_passwd_dir
, "/");
2651 static struct passwd emacs_passwd
=
2657 static int my_passwd_inited
= 0;
2665 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2666 directory where Emacs was started. */
2668 owner_name
= (char **) GetResource ('STR ',-16096);
2672 BlockMove ((unsigned char *) *owner_name
,
2673 (unsigned char *) my_passwd_name
,
2675 HUnlock (owner_name
);
2676 p2cstr ((unsigned char *) my_passwd_name
);
2679 my_passwd_name
[0] = 0;
2684 getpwuid (uid_t uid
)
2686 if (!my_passwd_inited
)
2689 my_passwd_inited
= 1;
2697 getgrgid (gid_t gid
)
2704 getpwnam (const char *name
)
2706 if (strcmp (name
, "emacs") == 0)
2707 return &emacs_passwd
;
2709 if (!my_passwd_inited
)
2712 my_passwd_inited
= 1;
2719 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2720 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2741 error ("Can't spawn subshell");
2746 request_sigio (void)
2752 unrequest_sigio (void)
2767 pipe (int _fildes
[2])
2774 /* Hard and symbolic links. */
2777 symlink (const char *name1
, const char *name2
)
2785 link (const char *name1
, const char *name2
)
2791 #endif /* ! MAC_OSX */
2793 /* Determine the path name of the file specified by VREFNUM, DIRID,
2794 and NAME and place that in the buffer PATH of length
2797 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2798 long dir_id
, ConstStr255Param name
)
2804 if (strlen (name
) > man_path_len
)
2807 memcpy (dir_name
, name
, name
[0]+1);
2808 memcpy (path
, name
, name
[0]+1);
2811 cipb
.dirInfo
.ioDrParID
= dir_id
;
2812 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2816 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2817 cipb
.dirInfo
.ioFDirIndex
= -1;
2818 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2819 /* go up to parent each time */
2821 err
= PBGetCatInfo (&cipb
, false);
2826 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2829 strcat (dir_name
, ":");
2830 strcat (dir_name
, path
);
2831 /* attach to front since we're going up directory tree */
2832 strcpy (path
, dir_name
);
2834 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2835 /* stop when we see the volume's root directory */
2837 return 1; /* success */
2844 posix_pathname_to_fsspec (ufn
, fs
)
2848 Str255 mac_pathname
;
2850 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2854 c2pstr (mac_pathname
);
2855 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2860 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2865 char mac_pathname
[MAXPATHLEN
];
2867 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2868 fs
->vRefNum
, fs
->parID
, fs
->name
)
2869 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2876 readlink (const char *path
, char *buf
, int bufsiz
)
2878 char mac_sym_link_name
[MAXPATHLEN
+1];
2881 Boolean target_is_folder
, was_aliased
;
2882 Str255 directory_name
, mac_pathname
;
2885 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2888 c2pstr (mac_sym_link_name
);
2889 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2896 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2897 if (err
!= noErr
|| !was_aliased
)
2903 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2910 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2916 return strlen (buf
);
2920 /* Convert a path to one with aliases fully expanded. */
2923 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2925 char *q
, temp
[MAXPATHLEN
+1];
2929 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2936 q
= strchr (p
+ 1, '/');
2938 q
= strchr (p
, '/');
2939 len
= 0; /* loop may not be entered, e.g., for "/" */
2944 strncat (temp
, p
, q
- p
);
2945 len
= readlink (temp
, buf
, bufsiz
);
2948 if (strlen (temp
) + 1 > bufsiz
)
2958 if (len
+ strlen (p
) + 1 >= bufsiz
)
2962 return len
+ strlen (p
);
2967 umask (mode_t numask
)
2969 static mode_t mask
= 022;
2970 mode_t oldmask
= mask
;
2977 chmod (const char *path
, mode_t mode
)
2979 /* say it always succeed for now */
2985 fchmod (int fd
, mode_t mode
)
2987 /* say it always succeed for now */
2993 fchown (int fd
, uid_t owner
, gid_t group
)
2995 /* say it always succeed for now */
3004 return fcntl (oldd
, F_DUPFD
, 0);
3006 /* current implementation of fcntl in fcntl.mac.c simply returns old
3008 return fcntl (oldd
, F_DUPFD
);
3015 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3016 newd if it already exists. Then, attempt to dup oldd. If not
3017 successful, call dup2 recursively until we are, then close the
3018 unsuccessful ones. */
3021 dup2 (int oldd
, int newd
)
3032 ret
= dup2 (oldd
, newd
);
3038 /* let it fail for now */
3055 ioctl (int d
, int request
, void *argp
)
3065 if (fildes
>=0 && fildes
<= 2)
3098 #endif /* __MRC__ */
3102 #if __MSL__ < 0x6000
3110 #endif /* __MWERKS__ */
3112 #endif /* ! MAC_OSX */
3115 /* Return the path to the directory in which Emacs can create
3116 temporary files. The MacOS "temporary items" directory cannot be
3117 used because it removes the file written by a process when it
3118 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3119 again not exactly). And of course Emacs needs to read back the
3120 files written by its subprocesses. So here we write the files to a
3121 directory "Emacs" in the Preferences Folder. This directory is
3122 created if it does not exist. */
3125 get_temp_dir_name ()
3127 static char *temp_dir_name
= NULL
;
3132 char unix_dir_name
[MAXPATHLEN
+1];
3135 /* Cache directory name with pointer temp_dir_name.
3136 Look for it only the first time. */
3139 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3140 &vol_ref_num
, &dir_id
);
3144 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3147 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3148 strcat (full_path
, "Emacs:");
3152 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3155 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3158 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3161 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3162 strcpy (temp_dir_name
, unix_dir_name
);
3165 return temp_dir_name
;
3170 /* Allocate and construct an array of pointers to strings from a list
3171 of strings stored in a 'STR#' resource. The returned pointer array
3172 is stored in the style of argv and environ: if the 'STR#' resource
3173 contains numString strings, a pointer array with numString+1
3174 elements is returned in which the last entry contains a null
3175 pointer. The pointer to the pointer array is passed by pointer in
3176 parameter t. The resource ID of the 'STR#' resource is passed in
3177 parameter StringListID.
3181 get_string_list (char ***t
, short string_list_id
)
3187 h
= GetResource ('STR#', string_list_id
);
3192 num_strings
= * (short *) p
;
3194 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3195 for (i
= 0; i
< num_strings
; i
++)
3197 short length
= *p
++;
3198 (*t
)[i
] = (char *) malloc (length
+ 1);
3199 strncpy ((*t
)[i
], p
, length
);
3200 (*t
)[i
][length
] = '\0';
3203 (*t
)[num_strings
] = 0;
3208 /* Return no string in case GetResource fails. Bug fixed by
3209 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3210 option (no sym -on implies -opt local). */
3211 *t
= (char **) malloc (sizeof (char *));
3218 get_path_to_system_folder ()
3224 static char system_folder_unix_name
[MAXPATHLEN
+1];
3227 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3228 &vol_ref_num
, &dir_id
);
3232 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3235 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3239 return system_folder_unix_name
;
3245 #define ENVIRON_STRING_LIST_ID 128
3247 /* Get environment variable definitions from STR# resource. */
3254 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3260 /* Make HOME directory the one Emacs starts up in if not specified
3262 if (getenv ("HOME") == NULL
)
3264 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3267 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3270 strcpy (environ
[i
], "HOME=");
3271 strcat (environ
[i
], my_passwd_dir
);
3278 /* Make HOME directory the one Emacs starts up in if not specified
3280 if (getenv ("MAIL") == NULL
)
3282 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3285 char * path_to_system_folder
= get_path_to_system_folder ();
3286 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3289 strcpy (environ
[i
], "MAIL=");
3290 strcat (environ
[i
], path_to_system_folder
);
3291 strcat (environ
[i
], "Eudora Folder/In");
3299 /* Return the value of the environment variable NAME. */
3302 getenv (const char *name
)
3304 int length
= strlen(name
);
3307 for (e
= environ
; *e
!= 0; e
++)
3308 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3309 return &(*e
)[length
+ 1];
3311 if (strcmp (name
, "TMPDIR") == 0)
3312 return get_temp_dir_name ();
3319 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3320 char *sys_siglist
[] =
3322 "Zero is not a signal!!!",
3324 "Interactive user interrupt", /* 2 */ "?",
3325 "Floating point exception", /* 4 */ "?", "?", "?",
3326 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3327 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3328 "?", "?", "?", "?", "?", "?", "?", "?",
3332 char *sys_siglist
[] =
3334 "Zero is not a signal!!!",
3336 "Floating point exception",
3337 "Illegal instruction",
3338 "Interactive user interrupt",
3339 "Segment violation",
3342 #else /* not __MRC__ and not __MWERKS__ */
3344 #endif /* not __MRC__ and not __MWERKS__ */
3347 #include <utsname.h>
3350 uname (struct utsname
*name
)
3353 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3356 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3357 p2cstr (name
->nodename
);
3365 /* Event class of HLE sent to subprocess. */
3366 const OSType kEmacsSubprocessSend
= 'ESND';
3368 /* Event class of HLE sent back from subprocess. */
3369 const OSType kEmacsSubprocessReply
= 'ERPY';
3373 mystrchr (char *s
, char c
)
3375 while (*s
&& *s
!= c
)
3403 mystrcpy (char *to
, char *from
)
3415 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3416 terminated). The process should run with the default directory
3417 "workdir", read input from "infn", and write output and error to
3418 "outfn" and "errfn", resp. The Process Manager call
3419 LaunchApplication is used to start the subprocess. We use high
3420 level events as the mechanism to pass arguments to the subprocess
3421 and to make Emacs wait for the subprocess to terminate and pass
3422 back a result code. The bulk of the code here packs the arguments
3423 into one message to be passed together with the high level event.
3424 Emacs also sometimes starts a subprocess using a shell to perform
3425 wildcard filename expansion. Since we don't really have a shell on
3426 the Mac, this case is detected and the starting of the shell is
3427 by-passed. We really need to add code here to do filename
3428 expansion to support such functionality.
3430 We can't use this strategy in Carbon because the High Level Event
3431 APIs are not available. */
3434 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3435 unsigned char **argv
;
3436 const char *workdir
;
3437 const char *infn
, *outfn
, *errfn
;
3439 #if TARGET_API_MAC_CARBON
3441 #else /* not TARGET_API_MAC_CARBON */
3442 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3443 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3444 int paramlen
, argc
, newargc
, j
, retries
;
3445 char **newargv
, *param
, *p
;
3448 LaunchParamBlockRec lpbr
;
3449 EventRecord send_event
, reply_event
;
3450 RgnHandle cursor_region_handle
;
3452 unsigned long ref_con
, len
;
3454 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3456 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3458 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3460 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3463 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3464 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3473 /* If a subprocess is invoked with a shell, we receive 3 arguments
3474 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3475 bins>/<command> <command args>" */
3476 j
= strlen (argv
[0]);
3477 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3478 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3480 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3482 /* The arguments for the command in argv[2] are separated by
3483 spaces. Count them and put the count in newargc. */
3484 command
= (char *) alloca (strlen (argv
[2])+2);
3485 strcpy (command
, argv
[2]);
3486 if (command
[strlen (command
) - 1] != ' ')
3487 strcat (command
, " ");
3491 t
= mystrchr (t
, ' ');
3495 t
= mystrchr (t
+1, ' ');
3498 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3501 for (j
= 0; j
< newargc
; j
++)
3503 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3504 mystrcpy (newargv
[j
], t
);
3507 paramlen
+= strlen (newargv
[j
]) + 1;
3510 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3512 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3517 { /* sometimes Emacs call "sh" without a path for the command */
3519 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3520 strcpy (t
, "~emacs/");
3521 strcat (t
, newargv
[0]);
3524 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3525 make_number (X_OK
));
3529 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3533 strcpy (macappname
, tempmacpathname
);
3537 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3540 newargv
= (char **) alloca (sizeof (char *) * argc
);
3542 for (j
= 1; j
< argc
; j
++)
3544 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3546 char *t
= strchr (argv
[j
], ' ');
3549 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3550 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3551 tempcmdname
[t
-argv
[j
]] = '\0';
3552 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3555 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3557 strcpy (newargv
[j
], tempmaccmdname
);
3558 strcat (newargv
[j
], t
);
3562 char tempmaccmdname
[MAXPATHLEN
+1];
3563 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3566 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3567 strcpy (newargv
[j
], tempmaccmdname
);
3571 newargv
[j
] = argv
[j
];
3572 paramlen
+= strlen (newargv
[j
]) + 1;
3576 /* After expanding all the arguments, we now know the length of the
3577 parameter block to be sent to the subprocess as a message
3578 attached to the HLE. */
3579 param
= (char *) malloc (paramlen
+ 1);
3585 /* first byte of message contains number of arguments for command */
3586 strcpy (p
, macworkdir
);
3587 p
+= strlen (macworkdir
);
3589 /* null terminate strings sent so it's possible to use strcpy over there */
3590 strcpy (p
, macinfn
);
3591 p
+= strlen (macinfn
);
3593 strcpy (p
, macoutfn
);
3594 p
+= strlen (macoutfn
);
3596 strcpy (p
, macerrfn
);
3597 p
+= strlen (macerrfn
);
3599 for (j
= 1; j
< newargc
; j
++)
3601 strcpy (p
, newargv
[j
]);
3602 p
+= strlen (newargv
[j
]);
3606 c2pstr (macappname
);
3608 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3616 lpbr
.launchBlockID
= extendedBlock
;
3617 lpbr
.launchEPBLength
= extendedBlockLen
;
3618 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3619 lpbr
.launchAppSpec
= &spec
;
3620 lpbr
.launchAppParameters
= NULL
;
3622 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3629 send_event
.what
= kHighLevelEvent
;
3630 send_event
.message
= kEmacsSubprocessSend
;
3631 /* Event ID stored in "where" unused */
3634 /* OS may think current subprocess has terminated if previous one
3635 terminated recently. */
3638 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3639 paramlen
+ 1, receiverIDisPSN
);
3641 while (iErr
== sessClosedErr
&& retries
-- > 0);
3649 cursor_region_handle
= NewRgn ();
3651 /* Wait for the subprocess to finish, when it will send us a ERPY
3652 high level event. */
3654 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3655 cursor_region_handle
)
3656 && reply_event
.message
== kEmacsSubprocessReply
)
3659 /* The return code is sent through the refCon */
3660 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3663 DisposeHandle ((Handle
) cursor_region_handle
);
3668 DisposeHandle ((Handle
) cursor_region_handle
);
3672 #endif /* not TARGET_API_MAC_CARBON */
3677 opendir (const char *dirname
)
3679 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3680 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3684 int len
, vol_name_len
;
3686 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3689 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3691 fully_resolved_name
[len
] = '\0';
3693 strcpy (fully_resolved_name
, true_pathname
);
3695 dirp
= (DIR *) malloc (sizeof(DIR));
3699 /* Handle special case when dirname is "/": sets up for readir to
3700 get all mount volumes. */
3701 if (strcmp (fully_resolved_name
, "/") == 0)
3703 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3704 dirp
->current_index
= 1; /* index for first volume */
3708 /* Handle typical cases: not accessing all mounted volumes. */
3709 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3712 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3713 len
= strlen (mac_pathname
);
3714 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3715 strcat (mac_pathname
, ":");
3717 /* Extract volume name */
3718 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3719 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3720 vol_name
[vol_name_len
] = '\0';
3721 strcat (vol_name
, ":");
3723 c2pstr (mac_pathname
);
3724 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3725 /* using full pathname so vRefNum and DirID ignored */
3726 cipb
.hFileInfo
.ioVRefNum
= 0;
3727 cipb
.hFileInfo
.ioDirID
= 0;
3728 cipb
.hFileInfo
.ioFDirIndex
= 0;
3729 /* set to 0 to get information about specific dir or file */
3731 errno
= PBGetCatInfo (&cipb
, false);
3738 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3739 return 0; /* not a directory */
3741 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3742 dirp
->getting_volumes
= 0;
3743 dirp
->current_index
= 1; /* index for first file/directory */
3746 vpb
.ioNamePtr
= vol_name
;
3747 /* using full pathname so vRefNum and DirID ignored */
3749 vpb
.ioVolIndex
= -1;
3750 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3757 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3774 HParamBlockRec hpblock
;
3776 static struct dirent s_dirent
;
3777 static Str255 s_name
;
3781 /* Handle the root directory containing the mounted volumes. Call
3782 PBHGetVInfo specifying an index to obtain the info for a volume.
3783 PBHGetVInfo returns an error when it receives an index beyond the
3784 last volume, at which time we should return a nil dirent struct
3786 if (dp
->getting_volumes
)
3788 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3789 hpblock
.volumeParam
.ioVRefNum
= 0;
3790 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3792 errno
= PBHGetVInfo (&hpblock
, false);
3800 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3802 dp
->current_index
++;
3804 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3805 s_dirent
.d_name
= s_name
;
3811 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3812 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3813 /* location to receive filename returned */
3815 /* return only visible files */
3819 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3820 /* directory ID found by opendir */
3821 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3823 errno
= PBGetCatInfo (&cipb
, false);
3830 /* insist on a visible entry */
3831 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3832 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3834 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3836 dp
->current_index
++;
3849 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3850 /* value unimportant: non-zero for valid file */
3851 s_dirent
.d_name
= s_name
;
3861 char mac_pathname
[MAXPATHLEN
+1];
3862 Str255 directory_name
;
3866 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3869 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3875 #endif /* ! MAC_OSX */
3879 initialize_applescript ()
3884 /* if open fails, as_scripting_component is set to NULL. Its
3885 subsequent use in OSA calls will fail with badComponentInstance
3887 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3888 kAppleScriptSubtype
);
3890 null_desc
.descriptorType
= typeNull
;
3891 null_desc
.dataHandle
= 0;
3892 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3893 kOSANullScript
, &as_script_context
);
3895 as_script_context
= kOSANullScript
;
3896 /* use default context if create fails */
3901 terminate_applescript()
3903 OSADispose (as_scripting_component
, as_script_context
);
3904 CloseComponent (as_scripting_component
);
3907 /* Convert a lisp string to the 4 byte character code. */
3910 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3919 /* check type string */
3921 if (SBYTES (arg
) != 4)
3923 error ("Wrong argument: need string of length 4 for code");
3925 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3930 /* Convert the 4 byte character code into a 4 byte string. */
3933 mac_get_object_from_code(OSType defCode
)
3935 UInt32 code
= EndianU32_NtoB (defCode
);
3937 return make_unibyte_string ((char *)&code
, 4);
3941 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3942 doc
: /* Get the creator code of FILENAME as a four character string. */)
3944 Lisp_Object filename
;
3952 Lisp_Object result
= Qnil
;
3953 CHECK_STRING (filename
);
3955 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3958 filename
= Fexpand_file_name (filename
, Qnil
);
3962 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3964 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3967 if (status
== noErr
)
3970 FSCatalogInfo catalogInfo
;
3972 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3973 &catalogInfo
, NULL
, NULL
, NULL
);
3977 status
= FSpGetFInfo (&fss
, &finder_info
);
3979 if (status
== noErr
)
3982 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
3984 result
= mac_get_object_from_code (finder_info
.fdCreator
);
3989 if (status
!= noErr
) {
3990 error ("Error while getting file information.");
3995 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
3996 doc
: /* Get the type code of FILENAME as a four character string. */)
3998 Lisp_Object filename
;
4006 Lisp_Object result
= Qnil
;
4007 CHECK_STRING (filename
);
4009 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4012 filename
= Fexpand_file_name (filename
, Qnil
);
4016 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4018 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4021 if (status
== noErr
)
4024 FSCatalogInfo catalogInfo
;
4026 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4027 &catalogInfo
, NULL
, NULL
, NULL
);
4031 status
= FSpGetFInfo (&fss
, &finder_info
);
4033 if (status
== noErr
)
4036 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4038 result
= mac_get_object_from_code (finder_info
.fdType
);
4043 if (status
!= noErr
) {
4044 error ("Error while getting file information.");
4049 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4050 doc
: /* Set creator code of file FILENAME to CODE.
4051 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4052 assumed. Return non-nil if successful. */)
4054 Lisp_Object filename
, code
;
4063 CHECK_STRING (filename
);
4065 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4067 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4070 filename
= Fexpand_file_name (filename
, Qnil
);
4074 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4076 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4079 if (status
== noErr
)
4082 FSCatalogInfo catalogInfo
;
4084 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4085 &catalogInfo
, NULL
, NULL
, &parentDir
);
4089 status
= FSpGetFInfo (&fss
, &finder_info
);
4091 if (status
== noErr
)
4094 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4095 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4096 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4098 finder_info
.fdCreator
= cCode
;
4099 status
= FSpSetFInfo (&fss
, &finder_info
);
4104 if (status
!= noErr
) {
4105 error ("Error while setting creator information.");
4110 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4111 doc
: /* Set file code of file FILENAME to CODE.
4112 CODE must be a 4-character string. Return non-nil if successful. */)
4114 Lisp_Object filename
, code
;
4123 CHECK_STRING (filename
);
4125 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4127 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4130 filename
= Fexpand_file_name (filename
, Qnil
);
4134 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4136 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4139 if (status
== noErr
)
4142 FSCatalogInfo catalogInfo
;
4144 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4145 &catalogInfo
, NULL
, NULL
, &parentDir
);
4149 status
= FSpGetFInfo (&fss
, &finder_info
);
4151 if (status
== noErr
)
4154 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4155 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4156 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4158 finder_info
.fdType
= cCode
;
4159 status
= FSpSetFInfo (&fss
, &finder_info
);
4164 if (status
!= noErr
) {
4165 error ("Error while setting creator information.");
4171 /* Compile and execute the AppleScript SCRIPT and return the error
4172 status as function value. A zero is returned if compilation and
4173 execution is successful, in which case *RESULT is set to a Lisp
4174 string containing the resulting script value. Otherwise, the Mac
4175 error code is returned and *RESULT is set to an error Lisp string.
4176 For documentation on the MacOS scripting architecture, see Inside
4177 Macintosh - Interapplication Communications: Scripting
4181 do_applescript (script
, result
)
4182 Lisp_Object script
, *result
;
4184 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4190 if (!as_scripting_component
)
4191 initialize_applescript();
4193 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4198 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4199 typeChar
, kOSAModeNull
, &result_desc
);
4201 if (osaerror
== noErr
)
4202 /* success: retrieve resulting script value */
4203 desc
= &result_desc
;
4204 else if (osaerror
== errOSAScriptError
)
4205 /* error executing AppleScript: retrieve error message */
4206 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4212 #if TARGET_API_MAC_CARBON
4213 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4214 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4215 #else /* not TARGET_API_MAC_CARBON */
4216 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4217 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4218 #endif /* not TARGET_API_MAC_CARBON */
4219 AEDisposeDesc (desc
);
4222 AEDisposeDesc (&script_desc
);
4228 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4229 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4230 If compilation and execution are successful, the resulting script
4231 value is returned as a string. Otherwise the function aborts and
4232 displays the error message returned by the AppleScript scripting
4240 CHECK_STRING (script
);
4243 status
= do_applescript (script
, &result
);
4247 else if (!STRINGP (result
))
4248 error ("AppleScript error %d", status
);
4250 error ("%s", SDATA (result
));
4254 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4255 Smac_file_name_to_posix
, 1, 1, 0,
4256 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4258 Lisp_Object filename
;
4260 char posix_filename
[MAXPATHLEN
+1];
4262 CHECK_STRING (filename
);
4264 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4265 return build_string (posix_filename
);
4271 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4272 Sposix_file_name_to_mac
, 1, 1, 0,
4273 doc
: /* Convert Posix FILENAME to Mac form. */)
4275 Lisp_Object filename
;
4277 char mac_filename
[MAXPATHLEN
+1];
4279 CHECK_STRING (filename
);
4281 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4282 return build_string (mac_filename
);
4288 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4289 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4290 Each type should be a string of length 4 or the symbol
4291 `undecoded-file-name'. */)
4292 (src_type
, src_data
, dst_type
)
4293 Lisp_Object src_type
, src_data
, dst_type
;
4296 Lisp_Object result
= Qnil
;
4297 DescType src_desc_type
, dst_desc_type
;
4300 CHECK_STRING (src_data
);
4301 if (EQ (src_type
, Qundecoded_file_name
))
4302 src_desc_type
= TYPE_FILE_NAME
;
4304 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4306 if (EQ (dst_type
, Qundecoded_file_name
))
4307 dst_desc_type
= TYPE_FILE_NAME
;
4309 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4312 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4313 dst_desc_type
, &dst_desc
);
4316 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4317 AEDisposeDesc (&dst_desc
);
4325 #if TARGET_API_MAC_CARBON
4326 static Lisp_Object Qxml
, Qmime_charset
;
4327 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4329 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4330 doc
: /* Return the application preference value for KEY.
4331 KEY is either a string specifying a preference key, or a list of key
4332 strings. If it is a list, the (i+1)-th element is used as a key for
4333 the CFDictionary value obtained by the i-th element. Return nil if
4334 lookup is failed at some stage.
4336 Optional arg APPLICATION is an application ID string. If omitted or
4337 nil, that stands for the current application.
4339 Optional arg FORMAT specifies the data format of the return value. If
4340 omitted or nil, each Core Foundation object is converted into a
4341 corresponding Lisp object as follows:
4343 Core Foundation Lisp Tag
4344 ------------------------------------------------------------
4345 CFString Multibyte string string
4346 CFNumber Integer or float number
4347 CFBoolean Symbol (t or nil) boolean
4348 CFDate List of three integers date
4349 (cf. `current-time')
4350 CFData Unibyte string data
4351 CFArray Vector array
4352 CFDictionary Alist or hash table dictionary
4353 (depending on HASH-BOUND)
4355 If it is t, a symbol that represents the type of the original Core
4356 Foundation object is prepended. If it is `xml', the value is returned
4357 as an XML representation.
4359 Optional arg HASH-BOUND specifies which kinds of the list objects,
4360 alists or hash tables, are used as the targets of the conversion from
4361 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4362 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4363 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4365 (key
, application
, format
, hash_bound
)
4366 Lisp_Object key
, application
, format
, hash_bound
;
4368 CFStringRef app_id
, key_str
;
4369 CFPropertyListRef app_plist
= NULL
, plist
;
4370 Lisp_Object result
= Qnil
, tmp
;
4373 key
= Fcons (key
, Qnil
);
4377 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4378 CHECK_STRING_CAR (tmp
);
4380 wrong_type_argument (Qlistp
, key
);
4382 if (!NILP (application
))
4383 CHECK_STRING (application
);
4384 CHECK_SYMBOL (format
);
4385 if (!NILP (hash_bound
))
4386 CHECK_NUMBER (hash_bound
);
4390 app_id
= kCFPreferencesCurrentApplication
;
4391 if (!NILP (application
))
4393 app_id
= cfstring_create_with_string (application
);
4397 key_str
= cfstring_create_with_string (XCAR (key
));
4398 if (key_str
== NULL
)
4400 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4401 CFRelease (key_str
);
4402 if (app_plist
== NULL
)
4406 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4408 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4410 key_str
= cfstring_create_with_string (XCAR (key
));
4411 if (key_str
== NULL
)
4413 plist
= CFDictionaryGetValue (plist
, key_str
);
4414 CFRelease (key_str
);
4421 if (EQ (format
, Qxml
))
4423 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4426 result
= cfdata_to_lisp (data
);
4431 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4432 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4437 CFRelease (app_plist
);
4446 static CFStringEncoding
4447 get_cfstring_encoding_from_lisp (obj
)
4450 CFStringRef iana_name
;
4451 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4454 return kCFStringEncodingUnicode
;
4459 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4461 Lisp_Object coding_spec
, plist
;
4463 coding_spec
= Fget (obj
, Qcoding_system
);
4464 plist
= XVECTOR (coding_spec
)->contents
[3];
4465 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4469 obj
= SYMBOL_NAME (obj
);
4473 iana_name
= cfstring_create_with_string (obj
);
4476 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4477 CFRelease (iana_name
);
4484 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4486 cfstring_create_normalized (str
, symbol
)
4491 TextEncodingVariant variant
;
4492 float initial_mag
= 0.0;
4493 CFStringRef result
= NULL
;
4495 if (EQ (symbol
, QNFD
))
4496 form
= kCFStringNormalizationFormD
;
4497 else if (EQ (symbol
, QNFKD
))
4498 form
= kCFStringNormalizationFormKD
;
4499 else if (EQ (symbol
, QNFC
))
4500 form
= kCFStringNormalizationFormC
;
4501 else if (EQ (symbol
, QNFKC
))
4502 form
= kCFStringNormalizationFormKC
;
4503 else if (EQ (symbol
, QHFS_plus_D
))
4505 variant
= kUnicodeHFSPlusDecompVariant
;
4508 else if (EQ (symbol
, QHFS_plus_C
))
4510 variant
= kUnicodeHFSPlusCompVariant
;
4516 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4520 CFStringNormalize (mut_str
, form
);
4524 else if (initial_mag
> 0.0)
4526 UnicodeToTextInfo uni
= NULL
;
4529 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4531 ByteCount out_read
, out_size
, out_len
;
4533 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4535 kTextEncodingDefaultFormat
);
4536 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4538 kTextEncodingDefaultFormat
);
4539 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4541 length
= CFStringGetLength (str
);
4542 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4546 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4547 if (in_text
== NULL
)
4549 buffer
= xmalloc (sizeof (UniChar
) * length
);
4552 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4558 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4559 while (err
== noErr
)
4561 out_buf
= xmalloc (out_size
);
4562 if (out_buf
== NULL
)
4565 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4567 kUnicodeDefaultDirectionMask
,
4568 0, NULL
, NULL
, NULL
,
4569 out_size
, &out_read
, &out_len
,
4571 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4580 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4581 out_len
/ sizeof (UniChar
));
4583 DisposeUnicodeToTextInfo (&uni
);
4599 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4600 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4601 The conversion is performed using the converter provided by the system.
4602 Each encoding is specified by either a coding system symbol, a mime
4603 charset string, or an integer as a CFStringEncoding value. Nil for
4604 encoding means UTF-16 in native byte order, no byte order mark.
4605 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4606 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4607 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4608 On successful conversion, return the result string, else return nil. */)
4609 (string
, source
, target
, normalization_form
)
4610 Lisp_Object string
, source
, target
, normalization_form
;
4612 Lisp_Object result
= Qnil
;
4613 CFStringEncoding src_encoding
, tgt_encoding
;
4614 CFStringRef str
= NULL
;
4616 CHECK_STRING (string
);
4617 if (!INTEGERP (source
) && !STRINGP (source
))
4618 CHECK_SYMBOL (source
);
4619 if (!INTEGERP (target
) && !STRINGP (target
))
4620 CHECK_SYMBOL (target
);
4621 CHECK_SYMBOL (normalization_form
);
4625 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4626 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4628 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4629 use string_as_unibyte which works as well, except for the fact that
4630 it's too permissive (it doesn't check that the multibyte string only
4631 contain single-byte chars). */
4632 string
= Fstring_as_unibyte (string
);
4633 if (src_encoding
!= kCFStringEncodingInvalidId
4634 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4635 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4636 src_encoding
, !NILP (source
));
4637 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4640 CFStringRef saved_str
= str
;
4642 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4643 CFRelease (saved_str
);
4648 CFIndex str_len
, buf_len
;
4650 str_len
= CFStringGetLength (str
);
4651 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4652 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4654 result
= make_uninit_string (buf_len
);
4655 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4656 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4665 #endif /* TARGET_API_MAC_CARBON */
4668 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4669 doc
: /* Clear the font name table. */)
4673 mac_clear_font_name_table ();
4679 mac_get_system_locale ()
4687 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4688 region
= GetScriptManagerVariable (smRegionCode
);
4689 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4691 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4694 return build_string (str
);
4702 extern int inhibit_window_system
;
4703 extern int noninteractive
;
4705 /* Unlike in X11, window events in Carbon do not come from sockets.
4706 So we cannot simply use `select' to monitor two kinds of inputs:
4707 window events and process outputs. We emulate such functionality
4708 by regarding fd 0 as the window event channel and simultaneously
4709 monitoring both kinds of input channels. It is implemented by
4710 dividing into some cases:
4711 1. The window event channel is not involved.
4713 2. Sockets are not involved.
4714 -> Use ReceiveNextEvent.
4715 3. [If SELECT_USE_CFSOCKET is defined]
4716 Only the window event channel and socket read channels are
4717 involved, and timeout is not too short (greater than
4718 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4719 -> Create CFSocket for each socket and add it into the current
4720 event RunLoop so that a `ready-to-read' event can be posted
4721 to the event queue that is also used for window events. Then
4722 ReceiveNextEvent can wait for both kinds of inputs.
4724 -> Periodically poll the window input channel while repeatedly
4725 executing `select' with a short timeout
4726 (SELECT_POLLING_PERIOD_USEC microseconds). */
4728 #define SELECT_POLLING_PERIOD_USEC 20000
4729 #ifdef SELECT_USE_CFSOCKET
4730 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4731 #define EVENT_CLASS_SOCK 'Sock'
4734 socket_callback (s
, type
, address
, data
, info
)
4736 CFSocketCallBackType type
;
4743 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4744 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4745 ReleaseEvent (event
);
4747 #endif /* SELECT_USE_CFSOCKET */
4750 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4755 struct timeval
*timeout
;
4760 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4764 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4765 kEventLeaveInQueue
, NULL
);
4776 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4777 #undef SELECT_INVALIDATE_CFSOCKET
4781 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4786 struct timeval
*timeout
;
4790 EMACS_TIME select_timeout
;
4792 if (inhibit_window_system
|| noninteractive
4793 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4794 return select (n
, rfds
, wfds
, efds
, timeout
);
4798 if (wfds
== NULL
&& efds
== NULL
)
4801 SELECT_TYPE orfds
= *rfds
;
4803 EventTimeout timeout_sec
=
4805 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4806 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4807 : kEventDurationForever
);
4809 for (i
= 1; i
< n
; i
++)
4810 if (FD_ISSET (i
, rfds
))
4816 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4817 kEventLeaveInQueue
, NULL
);
4829 mac_prepare_for_quickdraw (NULL
);
4831 /* Avoid initial overhead of RunLoop setup for the case that
4832 some input is already available. */
4833 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4834 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4835 if (r
!= 0 || timeout_sec
== 0.0)
4840 #ifdef SELECT_USE_CFSOCKET
4841 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4842 goto poll_periodically
;
4845 CFRunLoopRef runloop
=
4846 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4847 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4848 #ifdef SELECT_INVALIDATE_CFSOCKET
4849 CFSocketRef
*shead
, *s
;
4851 CFRunLoopSourceRef
*shead
, *s
;
4856 #ifdef SELECT_INVALIDATE_CFSOCKET
4857 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4859 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4862 for (i
= 1; i
< n
; i
++)
4863 if (FD_ISSET (i
, rfds
))
4865 CFSocketRef socket
=
4866 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4867 socket_callback
, NULL
);
4868 CFRunLoopSourceRef source
=
4869 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4871 #ifdef SELECT_INVALIDATE_CFSOCKET
4872 CFSocketSetSocketFlags (socket
, 0);
4874 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4875 #ifdef SELECT_INVALIDATE_CFSOCKET
4885 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4890 #ifdef SELECT_INVALIDATE_CFSOCKET
4891 CFSocketInvalidate (*s
);
4893 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4908 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4909 GetEventTypeCount (specs
),
4911 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4912 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4919 #endif /* SELECT_USE_CFSOCKET */
4924 EMACS_TIME end_time
, now
, remaining_time
;
4925 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4933 remaining_time
= *timeout
;
4934 EMACS_GET_TIME (now
);
4935 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4940 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4941 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4942 select_timeout
= remaining_time
;
4943 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4955 EMACS_GET_TIME (now
);
4956 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4959 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4970 /* Set up environment variables so that Emacs can correctly find its
4971 support files when packaged as an application bundle. Directories
4972 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4973 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4974 by `make install' by default can instead be placed in
4975 .../Emacs.app/Contents/Resources/ and
4976 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4977 is changed only if it is not already set. Presumably if the user
4978 sets an environment variable, he will want to use files in his path
4979 instead of ones in the application bundle. */
4981 init_mac_osx_environment ()
4985 CFStringRef cf_app_bundle_pathname
;
4986 int app_bundle_pathname_len
;
4987 char *app_bundle_pathname
;
4991 /* Initialize locale related variables. */
4992 mac_system_script_code
=
4993 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4994 Vmac_system_locale
= mac_get_system_locale ();
4996 /* Fetch the pathname of the application bundle as a C string into
4997 app_bundle_pathname. */
4999 bundle
= CFBundleGetMainBundle ();
5000 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5002 /* We could not find the bundle identifier. For now, prevent
5003 the fatal error by bringing it up in the terminal. */
5004 inhibit_window_system
= 1;
5008 bundleURL
= CFBundleCopyBundleURL (bundle
);
5012 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5013 kCFURLPOSIXPathStyle
);
5014 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5015 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5017 if (!CFStringGetCString (cf_app_bundle_pathname
,
5018 app_bundle_pathname
,
5019 app_bundle_pathname_len
+ 1,
5020 kCFStringEncodingISOLatin1
))
5022 CFRelease (cf_app_bundle_pathname
);
5026 CFRelease (cf_app_bundle_pathname
);
5028 /* P should have sufficient room for the pathname of the bundle plus
5029 the subpath in it leading to the respective directories. Q
5030 should have three times that much room because EMACSLOADPATH can
5031 have the value "<path to lisp dir>:<path to leim dir>:<path to
5033 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5034 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5035 if (!getenv ("EMACSLOADPATH"))
5039 strcpy (p
, app_bundle_pathname
);
5040 strcat (p
, "/Contents/Resources/lisp");
5041 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5044 strcpy (p
, app_bundle_pathname
);
5045 strcat (p
, "/Contents/Resources/leim");
5046 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5053 strcpy (p
, app_bundle_pathname
);
5054 strcat (p
, "/Contents/Resources/site-lisp");
5055 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5063 setenv ("EMACSLOADPATH", q
, 1);
5066 if (!getenv ("EMACSPATH"))
5070 strcpy (p
, app_bundle_pathname
);
5071 strcat (p
, "/Contents/MacOS/libexec");
5072 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5075 strcpy (p
, app_bundle_pathname
);
5076 strcat (p
, "/Contents/MacOS/bin");
5077 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5085 setenv ("EMACSPATH", q
, 1);
5088 if (!getenv ("EMACSDATA"))
5090 strcpy (p
, app_bundle_pathname
);
5091 strcat (p
, "/Contents/Resources/etc");
5092 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5093 setenv ("EMACSDATA", p
, 1);
5096 if (!getenv ("EMACSDOC"))
5098 strcpy (p
, app_bundle_pathname
);
5099 strcat (p
, "/Contents/Resources/etc");
5100 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5101 setenv ("EMACSDOC", p
, 1);
5104 if (!getenv ("INFOPATH"))
5106 strcpy (p
, app_bundle_pathname
);
5107 strcat (p
, "/Contents/Resources/info");
5108 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5109 setenv ("INFOPATH", p
, 1);
5112 #endif /* MAC_OSX */
5118 Qundecoded_file_name
= intern ("undecoded-file-name");
5119 staticpro (&Qundecoded_file_name
);
5121 #if TARGET_API_MAC_CARBON
5122 Qstring
= intern ("string"); staticpro (&Qstring
);
5123 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5124 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5125 Qdate
= intern ("date"); staticpro (&Qdate
);
5126 Qdata
= intern ("data"); staticpro (&Qdata
);
5127 Qarray
= intern ("array"); staticpro (&Qarray
);
5128 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5130 Qxml
= intern ("xml");
5133 Qmime_charset
= intern ("mime-charset");
5134 staticpro (&Qmime_charset
);
5136 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5137 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5138 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5139 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5140 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5141 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5144 defsubr (&Smac_coerce_ae_data
);
5145 #if TARGET_API_MAC_CARBON
5146 defsubr (&Smac_get_preference
);
5147 defsubr (&Smac_code_convert_string
);
5149 defsubr (&Smac_clear_font_name_table
);
5151 defsubr (&Smac_set_file_creator
);
5152 defsubr (&Smac_set_file_type
);
5153 defsubr (&Smac_get_file_creator
);
5154 defsubr (&Smac_get_file_type
);
5155 defsubr (&Sdo_applescript
);
5156 defsubr (&Smac_file_name_to_posix
);
5157 defsubr (&Sposix_file_name_to_mac
);
5159 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5160 doc
: /* The system script code. */);
5161 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5163 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5164 doc
: /* The system locale identifier string.
5165 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5166 information is not included. */);
5167 Vmac_system_locale
= mac_get_system_locale ();
5170 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5171 (do not change this comment) */