1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
33 #include "sysselect.h"
34 #include "blockinput.h"
40 #if !TARGET_API_MAC_CARBON
43 #include <TextUtils.h>
45 #include <Resources.h>
50 #include <AppleScript.h>
53 #include <Processes.h>
55 #include <MacLocales.h>
57 #endif /* not TARGET_API_MAC_CARBON */
61 #include <sys/types.h>
65 #include <sys/param.h>
71 /* The system script code. */
72 static int mac_system_script_code
;
74 /* The system locale identifier string. */
75 static Lisp_Object Vmac_system_locale
;
77 /* An instance of the AppleScript component. */
78 static ComponentInstance as_scripting_component
;
79 /* The single script context used for all script executions. */
80 static OSAID as_script_context
;
82 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
83 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
85 /* When converting from Mac to Unix pathnames, /'s in folder names are
86 converted to :'s. This function, used in copying folder names,
87 performs a strncat and converts all character a to b in the copy of
88 the string s2 appended to the end of s1. */
91 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
99 for (i
= 0; i
< l2
; i
++)
108 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
109 that does not begin with a ':' and contains at least one ':'. A Mac
110 full pathname causes a '/' to be prepended to the Posix pathname.
111 The algorithm for the rest of the pathname is as follows:
112 For each segment between two ':',
113 if it is non-null, copy as is and then add a '/' at the end,
114 otherwise, insert a "../" into the Posix pathname.
115 Returns 1 if successful; 0 if fails. */
118 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
120 const char *p
, *q
, *pe
;
127 p
= strchr (mfn
, ':');
128 if (p
!= 0 && p
!= mfn
) /* full pathname */
135 pe
= mfn
+ strlen (mfn
);
142 { /* two consecutive ':' */
143 if (strlen (ufn
) + 3 >= ufnbuflen
)
149 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
151 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
158 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
160 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
161 /* no separator for last one */
170 extern char *get_temp_dir_name ();
173 /* Convert a Posix pathname to Mac form. Approximately reverse of the
174 above in algorithm. */
177 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
179 const char *p
, *q
, *pe
;
180 char expanded_pathname
[MAXPATHLEN
+1];
189 /* Check for and handle volume names. Last comparison: strangely
190 somewhere "/.emacs" is passed. A temporary fix for now. */
191 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
193 if (strlen (p
) + 1 > mfnbuflen
)
200 /* expand to emacs dir found by init_emacs_passwd_dir */
201 if (strncmp (p
, "~emacs/", 7) == 0)
203 struct passwd
*pw
= getpwnam ("emacs");
205 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
207 strcpy (expanded_pathname
, pw
->pw_dir
);
208 strcat (expanded_pathname
, p
);
209 p
= expanded_pathname
;
210 /* now p points to the pathname with emacs dir prefix */
212 else if (strncmp (p
, "/tmp/", 5) == 0)
214 char *t
= get_temp_dir_name ();
216 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
218 strcpy (expanded_pathname
, t
);
219 strcat (expanded_pathname
, p
);
220 p
= expanded_pathname
;
221 /* now p points to the pathname with emacs dir prefix */
223 else if (*p
!= '/') /* relative pathname */
235 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
237 if (strlen (mfn
) + 1 >= mfnbuflen
)
243 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
245 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
252 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
254 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
263 /***********************************************************************
264 Conversions on Apple event objects
265 ***********************************************************************/
267 static Lisp_Object Qundecoded_file_name
;
270 mac_aelist_to_lisp (desc_list
)
271 AEDescList
*desc_list
;
275 Lisp_Object result
, elem
;
281 err
= AECountItems (desc_list
, &count
);
287 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
294 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
298 elem
= mac_aelist_to_lisp (&desc
);
299 AEDisposeDesc (&desc
);
303 if (desc_type
== typeNull
)
307 elem
= make_uninit_string (size
);
308 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
309 &desc_type
, SDATA (elem
), size
, &size
);
313 desc_type
= EndianU32_NtoB (desc_type
);
314 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
320 else if (desc_list
->descriptorType
!= typeAEList
)
322 keyword
= EndianU32_NtoB (keyword
);
323 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
326 result
= Fcons (elem
, result
);
330 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
331 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
335 mac_aedesc_to_lisp (desc
)
339 DescType desc_type
= desc
->descriptorType
;
351 return mac_aelist_to_lisp (desc
);
353 /* The following one is much simpler, but creates and disposes
354 of Apple event descriptors many times. */
361 err
= AECountItems (desc
, &count
);
367 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
370 elem
= mac_aedesc_to_lisp (&desc1
);
371 AEDisposeDesc (&desc1
);
372 if (desc_type
!= typeAEList
)
374 keyword
= EndianU32_NtoB (keyword
);
375 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
377 result
= Fcons (elem
, result
);
385 #if TARGET_API_MAC_CARBON
386 result
= make_uninit_string (AEGetDescDataSize (desc
));
387 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
389 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
390 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
398 desc_type
= EndianU32_NtoB (desc_type
);
399 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
403 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
404 to_type
, handler_refcon
, result
)
406 const void *data_ptr
;
414 if (type_code
== TYPE_FILE_NAME
)
415 /* 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
),
474 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
478 err
= errAECoercionFail
;
481 else if (to_type
== TYPE_FILE_NAME
)
482 /* Coercion to undecoded file name. */
497 CFStringRef str
= NULL
;
498 CFDataRef data
= NULL
;
500 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
504 size
= AEGetDescDataSize (&desc
);
505 buf
= xmalloc (size
);
508 err
= AEGetDescData (&desc
, buf
, size
);
510 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
511 kCFStringEncodingUTF8
, NULL
);
514 AEDisposeDesc (&desc
);
518 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
524 CFStringCreateExternalRepresentation (NULL
, str
,
525 kCFStringEncodingUTF8
,
531 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
532 CFDataGetLength (data
), result
);
539 char file_name
[MAXPATHLEN
];
541 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
545 #if TARGET_API_MAC_CARBON
546 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
548 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
551 err
= fsspec_to_posix_pathname (&fs
, file_name
,
552 sizeof (file_name
) - 1);
554 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
555 strlen (file_name
), result
);
556 AEDisposeDesc (&desc
);
563 err
= errAECoercionFail
;
570 return errAECoercionFail
;
575 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
576 const AEDesc
*from_desc
;
582 DescType from_type
= from_desc
->descriptorType
;
584 if (from_type
== TYPE_FILE_NAME
)
586 if (to_type
!= TYPE_FILE_NAME
&& to_type
!= typeWildCard
587 && to_type
!= typeAlias
&& to_type
!= typeFSS
588 && to_type
!= typeFSRef
590 && to_type
!= typeFileURL
593 return errAECoercionFail
;
595 else if (to_type
== TYPE_FILE_NAME
)
597 if (from_type
!= typeAlias
&& from_type
!= typeFSS
598 && from_type
!= typeFSRef
600 && from_type
!= typeFileURL
603 return errAECoercionFail
;
608 if (from_type
== to_type
|| to_type
== typeWildCard
)
609 err
= AEDuplicateDesc (from_desc
, result
);
615 #if TARGET_API_MAC_CARBON
616 data_size
= AEGetDescDataSize (from_desc
);
618 data_size
= GetHandleSize (from_desc
->dataHandle
);
620 data_ptr
= xmalloc (data_size
);
623 #if TARGET_API_MAC_CARBON
624 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
626 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
629 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
631 handler_refcon
, result
);
639 return errAECoercionFail
;
644 init_coercion_handler ()
648 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
649 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
651 if (coerce_file_name_ptrUPP
== NULL
)
653 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
654 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
657 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
658 (AECoercionHandlerUPP
)
659 coerce_file_name_ptrUPP
, 0, false, false);
661 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
662 (AECoercionHandlerUPP
)
663 coerce_file_name_ptrUPP
, 0, false, false);
665 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
666 coerce_file_name_descUPP
, 0, true, false);
668 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
669 coerce_file_name_descUPP
, 0, true, false);
673 #if TARGET_API_MAC_CARBON
675 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
678 EventParamName
*names
;
679 EventParamType
*types
;
683 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
684 AEAddressDesc address_desc
;
690 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
691 sizeof (ProcessSerialNumber
), &address_desc
);
694 err
= AECreateAppleEvent (0, 0, /* Dummy class and ID. */
695 &address_desc
, /* NULL is not allowed
696 on Mac OS Classic. */
697 kAutoGenerateReturnID
,
698 kAnyTransactionID
, result
);
699 AEDisposeDesc (&address_desc
);
704 for (i
= 0; i
< num_params
; i
++)
708 case typeCFStringRef
:
709 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
710 sizeof (CFStringRef
), NULL
, &string
);
713 data
= CFStringCreateExternalRepresentation (NULL
, string
,
714 kCFStringEncodingUTF8
,
718 /* typeUTF8Text is not available on Mac OS X 10.1. */
719 AEPutParamPtr (result
, names
[i
], 'utf8',
720 CFDataGetBytePtr (data
), CFDataGetLength (data
));
726 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
730 buf
= xmalloc (size
);
733 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
736 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
746 /***********************************************************************
747 Conversion between Lisp and Core Foundation objects
748 ***********************************************************************/
750 #if TARGET_API_MAC_CARBON
751 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
752 static Lisp_Object Qarray
, Qdictionary
;
754 struct cfdict_context
757 int with_tag
, hash_bound
;
760 /* C string to CFString. */
763 cfstring_create_with_utf8_cstring (c_str
)
768 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
770 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
771 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
777 /* Lisp string to CFString. */
780 cfstring_create_with_string (s
)
783 CFStringRef string
= NULL
;
785 if (STRING_MULTIBYTE (s
))
787 char *p
, *end
= SDATA (s
) + SBYTES (s
);
789 for (p
= SDATA (s
); p
< end
; p
++)
792 s
= ENCODE_UTF_8 (s
);
795 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
796 kCFStringEncodingUTF8
, false);
800 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
801 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
802 kCFStringEncodingMacRoman
, false);
808 /* From CFData to a lisp string. Always returns a unibyte string. */
811 cfdata_to_lisp (data
)
814 CFIndex len
= CFDataGetLength (data
);
815 Lisp_Object result
= make_uninit_string (len
);
817 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
823 /* From CFString to a lisp string. Returns a unibyte string
824 containing a UTF-8 byte sequence. */
827 cfstring_to_lisp_nodecode (string
)
830 Lisp_Object result
= Qnil
;
831 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
834 result
= make_unibyte_string (s
, strlen (s
));
838 CFStringCreateExternalRepresentation (NULL
, string
,
839 kCFStringEncodingUTF8
, '?');
843 result
= cfdata_to_lisp (data
);
852 /* From CFString to a lisp string. Never returns a unibyte string
853 (even if it only contains ASCII characters).
854 This may cause GC during code conversion. */
857 cfstring_to_lisp (string
)
860 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
864 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
865 /* This may be superfluous. Just to make sure that the result
866 is a multibyte string. */
867 result
= string_to_multibyte (result
);
874 /* CFNumber to a lisp integer or a lisp float. */
877 cfnumber_to_lisp (number
)
880 Lisp_Object result
= Qnil
;
881 #if BITS_PER_EMACS_INT > 32
883 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
886 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
890 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
891 && !FIXNUM_OVERFLOW_P (int_val
))
892 result
= make_number (int_val
);
894 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
895 result
= make_float (float_val
);
900 /* CFDate to a list of three integers as in a return value of
904 cfdate_to_lisp (date
)
907 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
908 static CFAbsoluteTime epoch
= 0.0, sec
;
912 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
914 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
915 high
= sec
/ 65536.0;
916 low
= sec
- high
* 65536.0;
918 return list3 (make_number (high
), make_number (low
), make_number (0));
922 /* CFBoolean to a lisp symbol, `t' or `nil'. */
925 cfboolean_to_lisp (boolean
)
926 CFBooleanRef boolean
;
928 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
932 /* Any Core Foundation object to a (lengthy) lisp string. */
935 cfobject_desc_to_lisp (object
)
938 Lisp_Object result
= Qnil
;
939 CFStringRef desc
= CFCopyDescription (object
);
943 result
= cfstring_to_lisp (desc
);
951 /* Callback functions for cfproperty_list_to_lisp. */
954 cfdictionary_add_to_list (key
, value
, context
)
959 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
962 Fcons (Fcons (cfstring_to_lisp (key
),
963 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
969 cfdictionary_puthash (key
, value
, context
)
974 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
975 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
976 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
979 hash_lookup (h
, lisp_key
, &hash_code
);
980 hash_put (h
, lisp_key
,
981 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
986 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
987 non-zero, a symbol that represents the type of the original Core
988 Foundation object is prepended. HASH_BOUND specifies which kinds
989 of the lisp objects, alists or hash tables, are used as the targets
990 of the conversion from CFDictionary. If HASH_BOUND is negative,
991 always generate alists. If HASH_BOUND >= 0, generate an alist if
992 the number of keys in the dictionary is smaller than HASH_BOUND,
993 and a hash table otherwise. */
996 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
997 CFPropertyListRef plist
;
998 int with_tag
, hash_bound
;
1000 CFTypeID type_id
= CFGetTypeID (plist
);
1001 Lisp_Object tag
= Qnil
, result
= Qnil
;
1002 struct gcpro gcpro1
, gcpro2
;
1004 GCPRO2 (tag
, result
);
1006 if (type_id
== CFStringGetTypeID ())
1009 result
= cfstring_to_lisp (plist
);
1011 else if (type_id
== CFNumberGetTypeID ())
1014 result
= cfnumber_to_lisp (plist
);
1016 else if (type_id
== CFBooleanGetTypeID ())
1019 result
= cfboolean_to_lisp (plist
);
1021 else if (type_id
== CFDateGetTypeID ())
1024 result
= cfdate_to_lisp (plist
);
1026 else if (type_id
== CFDataGetTypeID ())
1029 result
= cfdata_to_lisp (plist
);
1031 else if (type_id
== CFArrayGetTypeID ())
1033 CFIndex index
, count
= CFArrayGetCount (plist
);
1036 result
= Fmake_vector (make_number (count
), Qnil
);
1037 for (index
= 0; index
< count
; index
++)
1038 XVECTOR (result
)->contents
[index
] =
1039 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1040 with_tag
, hash_bound
);
1042 else if (type_id
== CFDictionaryGetTypeID ())
1044 struct cfdict_context context
;
1045 CFIndex count
= CFDictionaryGetCount (plist
);
1048 context
.result
= &result
;
1049 context
.with_tag
= with_tag
;
1050 context
.hash_bound
= hash_bound
;
1051 if (hash_bound
< 0 || count
< hash_bound
)
1054 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1059 result
= make_hash_table (Qequal
,
1060 make_number (count
),
1061 make_float (DEFAULT_REHASH_SIZE
),
1062 make_float (DEFAULT_REHASH_THRESHOLD
),
1064 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1074 result
= Fcons (tag
, result
);
1081 /***********************************************************************
1082 Emulation of the X Resource Manager
1083 ***********************************************************************/
1085 /* Parser functions for resource lines. Each function takes an
1086 address of a variable whose value points to the head of a string.
1087 The value will be advanced so that it points to the next character
1088 of the parsed part when the function returns.
1090 A resource name such as "Emacs*font" is parsed into a non-empty
1091 list called `quarks'. Each element is either a Lisp string that
1092 represents a concrete component, a Lisp symbol LOOSE_BINDING
1093 (actually Qlambda) that represents any number (>=0) of intervening
1094 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1095 that represents as any single component. */
1099 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1100 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1103 skip_white_space (p
)
1106 /* WhiteSpace = {<space> | <horizontal tab>} */
1107 while (*P
== ' ' || *P
== '\t')
1115 /* Comment = "!" {<any character except null or newline>} */
1128 /* Don't interpret filename. Just skip until the newline. */
1130 parse_include_file (p
)
1133 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1150 /* Binding = "." | "*" */
1151 if (*P
== '.' || *P
== '*')
1153 char binding
= *P
++;
1155 while (*P
== '.' || *P
== '*')
1168 /* Component = "?" | ComponentName
1169 ComponentName = NameChar {NameChar}
1170 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1174 return SINGLE_COMPONENT
;
1176 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1180 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1183 return make_unibyte_string (start
, P
- start
);
1190 parse_resource_name (p
)
1193 Lisp_Object result
= Qnil
, component
;
1196 /* ResourceName = [Binding] {Component Binding} ComponentName */
1197 if (parse_binding (p
) == '*')
1198 result
= Fcons (LOOSE_BINDING
, result
);
1200 component
= parse_component (p
);
1201 if (NILP (component
))
1204 result
= Fcons (component
, result
);
1205 while ((binding
= parse_binding (p
)) != '\0')
1208 result
= Fcons (LOOSE_BINDING
, result
);
1209 component
= parse_component (p
);
1210 if (NILP (component
))
1213 result
= Fcons (component
, result
);
1216 /* The final component should not be '?'. */
1217 if (EQ (component
, SINGLE_COMPONENT
))
1220 return Fnreverse (result
);
1228 Lisp_Object seq
= Qnil
, result
;
1229 int buf_len
, total_len
= 0, len
, continue_p
;
1231 q
= strchr (P
, '\n');
1232 buf_len
= q
? q
- P
: strlen (P
);
1233 buf
= xmalloc (buf_len
);
1246 else if (*P
== '\\')
1251 else if (*P
== '\n')
1262 else if ('0' <= P
[0] && P
[0] <= '7'
1263 && '0' <= P
[1] && P
[1] <= '7'
1264 && '0' <= P
[2] && P
[2] <= '7')
1266 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
1276 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1281 q
= strchr (P
, '\n');
1282 len
= q
? q
- P
: strlen (P
);
1287 buf
= xmalloc (buf_len
);
1295 if (SBYTES (XCAR (seq
)) == total_len
)
1296 return make_string (SDATA (XCAR (seq
)), total_len
);
1299 buf
= xmalloc (total_len
);
1300 q
= buf
+ total_len
;
1301 for (; CONSP (seq
); seq
= XCDR (seq
))
1303 len
= SBYTES (XCAR (seq
));
1305 memcpy (q
, SDATA (XCAR (seq
)), len
);
1307 result
= make_string (buf
, total_len
);
1314 parse_resource_line (p
)
1317 Lisp_Object quarks
, value
;
1319 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1320 if (parse_comment (p
) || parse_include_file (p
))
1323 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1324 skip_white_space (p
);
1325 quarks
= parse_resource_name (p
);
1328 skip_white_space (p
);
1332 skip_white_space (p
);
1333 value
= parse_value (p
);
1334 return Fcons (quarks
, value
);
1337 /* Skip the remaining data as a dummy value. */
1344 /* Equivalents of X Resource Manager functions.
1346 An X Resource Database acts as a collection of resource names and
1347 associated values. It is implemented as a trie on quarks. Namely,
1348 each edge is labeled by either a string, LOOSE_BINDING, or
1349 SINGLE_COMPONENT. Each node has a node id, which is a unique
1350 nonnegative integer, and the root node id is 0. A database is
1351 implemented as a hash table that maps a pair (SRC-NODE-ID .
1352 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1353 in the table as a value for HASHKEY_MAX_NID. A value associated to
1354 a node is recorded as a value for the node id.
1356 A database also has a cache for past queries as a value for
1357 HASHKEY_QUERY_CACHE. It is another hash table that maps
1358 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1360 #define HASHKEY_MAX_NID (make_number (0))
1361 #define HASHKEY_QUERY_CACHE (make_number (-1))
1364 xrm_create_database ()
1366 XrmDatabase database
;
1368 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1369 make_float (DEFAULT_REHASH_SIZE
),
1370 make_float (DEFAULT_REHASH_THRESHOLD
),
1372 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1373 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1379 xrm_q_put_resource (database
, quarks
, value
)
1380 XrmDatabase database
;
1381 Lisp_Object quarks
, value
;
1383 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1386 Lisp_Object node_id
, key
;
1388 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1390 XSETINT (node_id
, 0);
1391 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1393 key
= Fcons (node_id
, XCAR (quarks
));
1394 i
= hash_lookup (h
, key
, &hash_code
);
1398 XSETINT (node_id
, max_nid
);
1399 hash_put (h
, key
, node_id
, hash_code
);
1402 node_id
= HASH_VALUE (h
, i
);
1404 Fputhash (node_id
, value
, database
);
1406 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1407 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1410 /* Merge multiple resource entries specified by DATA into a resource
1411 database DATABASE. DATA points to the head of a null-terminated
1412 string consisting of multiple resource lines. It's like a
1413 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1416 xrm_merge_string_database (database
, data
)
1417 XrmDatabase database
;
1420 Lisp_Object quarks_value
;
1424 quarks_value
= parse_resource_line (&data
);
1425 if (!NILP (quarks_value
))
1426 xrm_q_put_resource (database
,
1427 XCAR (quarks_value
), XCDR (quarks_value
));
1432 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1433 XrmDatabase database
;
1434 Lisp_Object node_id
, quark_name
, quark_class
;
1436 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1437 Lisp_Object key
, labels
[3], value
;
1440 if (!CONSP (quark_name
))
1441 return Fgethash (node_id
, database
, Qnil
);
1443 /* First, try tight bindings */
1444 labels
[0] = XCAR (quark_name
);
1445 labels
[1] = XCAR (quark_class
);
1446 labels
[2] = SINGLE_COMPONENT
;
1448 key
= Fcons (node_id
, Qnil
);
1449 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1451 XSETCDR (key
, labels
[k
]);
1452 i
= hash_lookup (h
, key
, NULL
);
1455 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1456 XCDR (quark_name
), XCDR (quark_class
));
1462 /* Then, try loose bindings */
1463 XSETCDR (key
, LOOSE_BINDING
);
1464 i
= hash_lookup (h
, key
, NULL
);
1467 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1468 quark_name
, quark_class
);
1472 return xrm_q_get_resource_1 (database
, node_id
,
1473 XCDR (quark_name
), XCDR (quark_class
));
1480 xrm_q_get_resource (database
, quark_name
, quark_class
)
1481 XrmDatabase database
;
1482 Lisp_Object quark_name
, quark_class
;
1484 return xrm_q_get_resource_1 (database
, make_number (0),
1485 quark_name
, quark_class
);
1488 /* Retrieve a resource value for the specified NAME and CLASS from the
1489 resource database DATABASE. It corresponds to XrmGetResource. */
1492 xrm_get_resource (database
, name
, class)
1493 XrmDatabase database
;
1496 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1498 struct Lisp_Hash_Table
*h
;
1502 nc
= strlen (class);
1503 key
= make_uninit_string (nn
+ nc
+ 1);
1504 strcpy (SDATA (key
), name
);
1505 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1507 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1508 if (NILP (query_cache
))
1510 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1511 make_float (DEFAULT_REHASH_SIZE
),
1512 make_float (DEFAULT_REHASH_THRESHOLD
),
1514 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1516 h
= XHASH_TABLE (query_cache
);
1517 i
= hash_lookup (h
, key
, &hash_code
);
1519 return HASH_VALUE (h
, i
);
1521 quark_name
= parse_resource_name (&name
);
1524 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1525 if (!STRINGP (XCAR (tmp
)))
1528 quark_class
= parse_resource_name (&class);
1531 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1532 if (!STRINGP (XCAR (tmp
)))
1539 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1540 hash_put (h
, key
, tmp
, hash_code
);
1545 #if TARGET_API_MAC_CARBON
1547 xrm_cfproperty_list_to_value (plist
)
1548 CFPropertyListRef plist
;
1550 CFTypeID type_id
= CFGetTypeID (plist
);
1552 if (type_id
== CFStringGetTypeID ())
1553 return cfstring_to_lisp (plist
);
1554 else if (type_id
== CFNumberGetTypeID ())
1557 Lisp_Object result
= Qnil
;
1559 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1562 result
= cfstring_to_lisp (string
);
1567 else if (type_id
== CFBooleanGetTypeID ())
1568 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1569 else if (type_id
== CFDataGetTypeID ())
1570 return cfdata_to_lisp (plist
);
1576 /* Create a new resource database from the preferences for the
1577 application APPLICATION. APPLICATION is either a string that
1578 specifies an application ID, or NULL that represents the current
1582 xrm_get_preference_database (application
)
1585 #if TARGET_API_MAC_CARBON
1586 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1587 CFMutableSetRef key_set
= NULL
;
1588 CFArrayRef key_array
;
1589 CFIndex index
, count
;
1591 XrmDatabase database
;
1592 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1593 CFPropertyListRef plist
;
1595 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1597 user_doms
[0] = kCFPreferencesCurrentUser
;
1598 user_doms
[1] = kCFPreferencesAnyUser
;
1599 host_doms
[0] = kCFPreferencesCurrentHost
;
1600 host_doms
[1] = kCFPreferencesAnyHost
;
1602 database
= xrm_create_database ();
1604 GCPRO3 (database
, quarks
, value
);
1608 app_id
= kCFPreferencesCurrentApplication
;
1611 app_id
= cfstring_create_with_utf8_cstring (application
);
1616 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1617 if (key_set
== NULL
)
1619 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1620 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1622 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1626 count
= CFArrayGetCount (key_array
);
1627 for (index
= 0; index
< count
; index
++)
1628 CFSetAddValue (key_set
,
1629 CFArrayGetValueAtIndex (key_array
, index
));
1630 CFRelease (key_array
);
1634 count
= CFSetGetCount (key_set
);
1635 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1638 CFSetGetValues (key_set
, (const void **)keys
);
1639 for (index
= 0; index
< count
; index
++)
1641 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1642 quarks
= parse_resource_name (&res_name
);
1643 if (!(NILP (quarks
) || *res_name
))
1645 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1646 value
= xrm_cfproperty_list_to_value (plist
);
1649 xrm_q_put_resource (database
, quarks
, value
);
1656 CFRelease (key_set
);
1665 return xrm_create_database ();
1672 /* The following functions with "sys_" prefix are stubs to Unix
1673 functions that have already been implemented by CW or MPW. The
1674 calls to them in Emacs source course are #define'd to call the sys_
1675 versions by the header files s-mac.h. In these stubs pathnames are
1676 converted between their Unix and Mac forms. */
1679 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1680 + 17 leap days. These are for adjusting time values returned by
1681 MacOS Toolbox functions. */
1683 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1686 #if __MSL__ < 0x6000
1687 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1688 a leap year! This is for adjusting time_t values returned by MSL
1690 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1691 #else /* __MSL__ >= 0x6000 */
1692 /* CW changes Pro 6 to follow Unix! */
1693 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1694 #endif /* __MSL__ >= 0x6000 */
1696 /* MPW library functions follow Unix (confused?). */
1697 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1698 #else /* not __MRC__ */
1700 #endif /* not __MRC__ */
1703 /* Define our own stat function for both MrC and CW. The reason for
1704 doing this: "stat" is both the name of a struct and function name:
1705 can't use the same trick like that for sys_open, sys_close, etc. to
1706 redirect Emacs's calls to our own version that converts Unix style
1707 filenames to Mac style filename because all sorts of compilation
1708 errors will be generated if stat is #define'd to be sys_stat. */
1711 stat_noalias (const char *path
, struct stat
*buf
)
1713 char mac_pathname
[MAXPATHLEN
+1];
1716 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1719 c2pstr (mac_pathname
);
1720 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1721 cipb
.hFileInfo
.ioVRefNum
= 0;
1722 cipb
.hFileInfo
.ioDirID
= 0;
1723 cipb
.hFileInfo
.ioFDirIndex
= 0;
1724 /* set to 0 to get information about specific dir or file */
1726 errno
= PBGetCatInfo (&cipb
, false);
1727 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1732 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1734 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1736 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1737 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1738 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1739 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1740 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1741 /* size of dir = number of files and dirs */
1744 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1745 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1749 buf
->st_mode
= S_IFREG
| S_IREAD
;
1750 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1751 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1752 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1753 buf
->st_mode
|= S_IEXEC
;
1754 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1755 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1756 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1759 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1760 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1763 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1765 /* identify alias files as symlinks */
1766 buf
->st_mode
&= ~S_IFREG
;
1767 buf
->st_mode
|= S_IFLNK
;
1771 buf
->st_uid
= getuid ();
1772 buf
->st_gid
= getgid ();
1780 lstat (const char *path
, struct stat
*buf
)
1783 char true_pathname
[MAXPATHLEN
+1];
1785 /* Try looking for the file without resolving aliases first. */
1786 if ((result
= stat_noalias (path
, buf
)) >= 0)
1789 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1792 return stat_noalias (true_pathname
, buf
);
1797 stat (const char *path
, struct stat
*sb
)
1800 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1803 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1804 ! (sb
->st_mode
& S_IFLNK
))
1807 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1810 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1813 fully_resolved_name
[len
] = '\0';
1814 /* in fact our readlink terminates strings */
1815 return lstat (fully_resolved_name
, sb
);
1818 return lstat (true_pathname
, sb
);
1823 /* CW defines fstat in stat.mac.c while MPW does not provide this
1824 function. Without the information of how to get from a file
1825 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1826 to implement this function. Fortunately, there is only one place
1827 where this function is called in our configuration: in fileio.c,
1828 where only the st_dev and st_ino fields are used to determine
1829 whether two fildes point to different i-nodes to prevent copying
1830 a file onto itself equal. What we have here probably needs
1834 fstat (int fildes
, struct stat
*buf
)
1837 buf
->st_ino
= fildes
;
1838 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1839 return 0; /* success */
1841 #endif /* __MRC__ */
1845 mkdir (const char *dirname
, int mode
)
1847 #pragma unused(mode)
1850 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1852 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1855 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1858 c2pstr (mac_pathname
);
1859 hfpb
.ioNamePtr
= mac_pathname
;
1860 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1861 hfpb
.ioDirID
= 0; /* parent is the root */
1863 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1864 /* just return the Mac OSErr code for now */
1865 return errno
== noErr
? 0 : -1;
1870 sys_rmdir (const char *dirname
)
1873 char mac_pathname
[MAXPATHLEN
+1];
1875 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1878 c2pstr (mac_pathname
);
1879 hfpb
.ioNamePtr
= mac_pathname
;
1880 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1881 hfpb
.ioDirID
= 0; /* parent is the root */
1883 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1884 return errno
== noErr
? 0 : -1;
1889 /* No implementation yet. */
1891 execvp (const char *path
, ...)
1895 #endif /* __MRC__ */
1899 utime (const char *path
, const struct utimbuf
*times
)
1901 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1903 char mac_pathname
[MAXPATHLEN
+1];
1906 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1909 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1911 fully_resolved_name
[len
] = '\0';
1913 strcpy (fully_resolved_name
, true_pathname
);
1915 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1918 c2pstr (mac_pathname
);
1919 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1920 cipb
.hFileInfo
.ioVRefNum
= 0;
1921 cipb
.hFileInfo
.ioDirID
= 0;
1922 cipb
.hFileInfo
.ioFDirIndex
= 0;
1923 /* set to 0 to get information about specific dir or file */
1925 errno
= PBGetCatInfo (&cipb
, false);
1929 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1932 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1934 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1939 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1941 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1944 errno
= PBSetCatInfo (&cipb
, false);
1945 return errno
== noErr
? 0 : -1;
1959 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1961 access (const char *path
, int mode
)
1963 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1965 char mac_pathname
[MAXPATHLEN
+1];
1968 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1971 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1973 fully_resolved_name
[len
] = '\0';
1975 strcpy (fully_resolved_name
, true_pathname
);
1977 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1980 c2pstr (mac_pathname
);
1981 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1982 cipb
.hFileInfo
.ioVRefNum
= 0;
1983 cipb
.hFileInfo
.ioDirID
= 0;
1984 cipb
.hFileInfo
.ioFDirIndex
= 0;
1985 /* set to 0 to get information about specific dir or file */
1987 errno
= PBGetCatInfo (&cipb
, false);
1991 if (mode
== F_OK
) /* got this far, file exists */
1995 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1999 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2006 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2007 /* don't allow if lock bit is on */
2013 #define DEV_NULL_FD 0x10000
2017 sys_open (const char *path
, int oflag
)
2019 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2021 char mac_pathname
[MAXPATHLEN
+1];
2023 if (strcmp (path
, "/dev/null") == 0)
2024 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2026 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2029 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2031 fully_resolved_name
[len
] = '\0';
2033 strcpy (fully_resolved_name
, true_pathname
);
2035 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2040 int res
= open (mac_pathname
, oflag
);
2041 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2042 if (oflag
& O_CREAT
)
2043 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2045 #else /* not __MRC__ */
2046 return open (mac_pathname
, oflag
);
2047 #endif /* not __MRC__ */
2054 sys_creat (const char *path
, mode_t mode
)
2056 char true_pathname
[MAXPATHLEN
+1];
2058 char mac_pathname
[MAXPATHLEN
+1];
2060 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2063 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2068 int result
= creat (mac_pathname
);
2069 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2071 #else /* not __MRC__ */
2072 return creat (mac_pathname
, mode
);
2073 #endif /* not __MRC__ */
2080 sys_unlink (const char *path
)
2082 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2084 char mac_pathname
[MAXPATHLEN
+1];
2086 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2089 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2091 fully_resolved_name
[len
] = '\0';
2093 strcpy (fully_resolved_name
, true_pathname
);
2095 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2098 return unlink (mac_pathname
);
2104 sys_read (int fildes
, char *buf
, int count
)
2106 if (fildes
== 0) /* this should not be used for console input */
2109 #if __MSL__ >= 0x6000
2110 return _read (fildes
, buf
, count
);
2112 return read (fildes
, buf
, count
);
2119 sys_write (int fildes
, const char *buf
, int count
)
2121 if (fildes
== DEV_NULL_FD
)
2124 #if __MSL__ >= 0x6000
2125 return _write (fildes
, buf
, count
);
2127 return write (fildes
, buf
, count
);
2134 sys_rename (const char * old_name
, const char * new_name
)
2136 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2137 char fully_resolved_old_name
[MAXPATHLEN
+1];
2139 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2141 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2144 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2146 fully_resolved_old_name
[len
] = '\0';
2148 strcpy (fully_resolved_old_name
, true_old_pathname
);
2150 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2153 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2156 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2161 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2164 /* If a file with new_name already exists, rename deletes the old
2165 file in Unix. CW version fails in these situation. So we add a
2166 call to unlink here. */
2167 (void) unlink (mac_new_name
);
2169 return rename (mac_old_name
, mac_new_name
);
2174 extern FILE *fopen (const char *name
, const char *mode
);
2176 sys_fopen (const char *name
, const char *mode
)
2178 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2180 char mac_pathname
[MAXPATHLEN
+1];
2182 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2185 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2187 fully_resolved_name
[len
] = '\0';
2189 strcpy (fully_resolved_name
, true_pathname
);
2191 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2196 if (mode
[0] == 'w' || mode
[0] == 'a')
2197 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2198 #endif /* not __MRC__ */
2199 return fopen (mac_pathname
, mode
);
2204 #include "keyboard.h"
2205 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2208 select (n
, rfds
, wfds
, efds
, timeout
)
2213 struct timeval
*timeout
;
2216 #if TARGET_API_MAC_CARBON
2217 EventTimeout timeout_sec
=
2219 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2220 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2221 : kEventDurationForever
);
2224 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2226 #else /* not TARGET_API_MAC_CARBON */
2228 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2229 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2231 /* Can only handle wait for keyboard input. */
2232 if (n
> 1 || wfds
|| efds
)
2235 /* Also return true if an event other than a keyDown has occurred.
2236 This causes kbd_buffer_get_event in keyboard.c to call
2237 read_avail_input which in turn calls XTread_socket to poll for
2238 these events. Otherwise these never get processed except but a
2239 very slow poll timer. */
2240 if (mac_wait_next_event (&e
, sleep_time
, false))
2243 err
= -9875; /* eventLoopTimedOutErr */
2244 #endif /* not TARGET_API_MAC_CARBON */
2246 if (FD_ISSET (0, rfds
))
2257 if (input_polling_used ())
2259 /* It could be confusing if a real alarm arrives while
2260 processing the fake one. Turn it off and let the
2261 handler reset it. */
2262 extern void poll_for_input_1
P_ ((void));
2263 int old_poll_suppress_count
= poll_suppress_count
;
2264 poll_suppress_count
= 1;
2265 poll_for_input_1 ();
2266 poll_suppress_count
= old_poll_suppress_count
;
2276 /* Simulation of SIGALRM. The stub for function signal stores the
2277 signal handler function in alarm_signal_func if a SIGALRM is
2281 #include "syssignal.h"
2283 static TMTask mac_atimer_task
;
2285 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2287 static int signal_mask
= 0;
2290 __sigfun alarm_signal_func
= (__sigfun
) 0;
2292 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2293 #else /* not __MRC__ and not __MWERKS__ */
2295 #endif /* not __MRC__ and not __MWERKS__ */
2299 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2301 sys_signal (int signal_num
, __sigfun signal_func
)
2303 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2305 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2306 #else /* not __MRC__ and not __MWERKS__ */
2308 #endif /* not __MRC__ and not __MWERKS__ */
2310 if (signal_num
!= SIGALRM
)
2311 return signal (signal_num
, signal_func
);
2315 __sigfun old_signal_func
;
2317 __signal_func_ptr old_signal_func
;
2321 old_signal_func
= alarm_signal_func
;
2322 alarm_signal_func
= signal_func
;
2323 return old_signal_func
;
2329 mac_atimer_handler (qlink
)
2332 if (alarm_signal_func
)
2333 (alarm_signal_func
) (SIGALRM
);
2338 set_mac_atimer (count
)
2341 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2343 if (mac_atimer_handlerUPP
== NULL
)
2344 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2345 mac_atimer_task
.tmCount
= 0;
2346 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2347 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2348 InsTime (mac_atimer_qlink
);
2350 PrimeTime (mac_atimer_qlink
, count
);
2355 remove_mac_atimer (remaining_count
)
2356 long *remaining_count
;
2358 if (mac_atimer_qlink
)
2360 RmvTime (mac_atimer_qlink
);
2361 if (remaining_count
)
2362 *remaining_count
= mac_atimer_task
.tmCount
;
2363 mac_atimer_qlink
= NULL
;
2375 int old_mask
= signal_mask
;
2377 signal_mask
|= mask
;
2379 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2380 remove_mac_atimer (NULL
);
2387 sigsetmask (int mask
)
2389 int old_mask
= signal_mask
;
2393 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2394 if (signal_mask
& sigmask (SIGALRM
))
2395 remove_mac_atimer (NULL
);
2397 set_mac_atimer (mac_atimer_task
.tmCount
);
2406 long remaining_count
;
2408 if (remove_mac_atimer (&remaining_count
) == 0)
2410 set_mac_atimer (seconds
* 1000);
2412 return remaining_count
/ 1000;
2416 mac_atimer_task
.tmCount
= seconds
* 1000;
2424 setitimer (which
, value
, ovalue
)
2426 const struct itimerval
*value
;
2427 struct itimerval
*ovalue
;
2429 long remaining_count
;
2430 long count
= (EMACS_SECS (value
->it_value
) * 1000
2431 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2433 if (remove_mac_atimer (&remaining_count
) == 0)
2437 bzero (ovalue
, sizeof (*ovalue
));
2438 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2439 (remaining_count
% 1000) * 1000);
2441 set_mac_atimer (count
);
2444 mac_atimer_task
.tmCount
= count
;
2450 /* gettimeofday should return the amount of time (in a timeval
2451 structure) since midnight today. The toolbox function Microseconds
2452 returns the number of microseconds (in a UnsignedWide value) since
2453 the machine was booted. Also making this complicated is WideAdd,
2454 WideSubtract, etc. take wide values. */
2461 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2462 UnsignedWide uw_microseconds
;
2463 wide w_microseconds
;
2464 time_t sys_time (time_t *);
2466 /* If this function is called for the first time, record the number
2467 of seconds since midnight and the number of microseconds since
2468 boot at the time of this first call. */
2473 systime
= sys_time (NULL
);
2474 /* Store microseconds since midnight in wall_clock_at_epoch. */
2475 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2476 Microseconds (&uw_microseconds
);
2477 /* Store microseconds since boot in clicks_at_epoch. */
2478 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2479 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2482 /* Get time since boot */
2483 Microseconds (&uw_microseconds
);
2485 /* Convert to time since midnight*/
2486 w_microseconds
.hi
= uw_microseconds
.hi
;
2487 w_microseconds
.lo
= uw_microseconds
.lo
;
2488 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2489 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2490 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2498 sleep (unsigned int seconds
)
2500 unsigned long time_up
;
2503 time_up
= TickCount () + seconds
* 60;
2504 while (TickCount () < time_up
)
2506 /* Accept no event; just wait. by T.I. */
2507 WaitNextEvent (0, &e
, 30, NULL
);
2512 #endif /* __MRC__ */
2515 /* The time functions adjust time values according to the difference
2516 between the Unix and CW epoches. */
2519 extern struct tm
*gmtime (const time_t *);
2521 sys_gmtime (const time_t *timer
)
2523 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2525 return gmtime (&unix_time
);
2530 extern struct tm
*localtime (const time_t *);
2532 sys_localtime (const time_t *timer
)
2534 #if __MSL__ >= 0x6000
2535 time_t unix_time
= *timer
;
2537 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2540 return localtime (&unix_time
);
2545 extern char *ctime (const time_t *);
2547 sys_ctime (const time_t *timer
)
2549 #if __MSL__ >= 0x6000
2550 time_t unix_time
= *timer
;
2552 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2555 return ctime (&unix_time
);
2560 extern time_t time (time_t *);
2562 sys_time (time_t *timer
)
2564 #if __MSL__ >= 0x6000
2565 time_t mac_time
= time (NULL
);
2567 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2577 /* no subprocesses, empty wait */
2587 croak (char *badfunc
)
2589 printf ("%s not yet implemented\r\n", badfunc
);
2595 mktemp (char *template)
2600 len
= strlen (template);
2602 while (k
>= 0 && template[k
] == 'X')
2605 k
++; /* make k index of first 'X' */
2609 /* Zero filled, number of digits equal to the number of X's. */
2610 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2619 /* Emulate getpwuid, getpwnam and others. */
2621 #define PASSWD_FIELD_SIZE 256
2623 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2624 static char my_passwd_dir
[MAXPATHLEN
+1];
2626 static struct passwd my_passwd
=
2632 static struct group my_group
=
2634 /* There are no groups on the mac, so we just return "root" as the
2640 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2642 char emacs_passwd_dir
[MAXPATHLEN
+1];
2648 init_emacs_passwd_dir ()
2652 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2654 /* Need pathname of first ancestor that begins with "emacs"
2655 since Mac emacs application is somewhere in the emacs-*
2657 int len
= strlen (emacs_passwd_dir
);
2659 /* j points to the "/" following the directory name being
2662 while (i
>= 0 && !found
)
2664 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2666 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2667 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2669 emacs_passwd_dir
[j
+1] = '\0';
2680 /* Setting to "/" probably won't work but set it to something
2682 strcpy (emacs_passwd_dir
, "/");
2683 strcpy (my_passwd_dir
, "/");
2688 static struct passwd emacs_passwd
=
2694 static int my_passwd_inited
= 0;
2702 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2703 directory where Emacs was started. */
2705 owner_name
= (char **) GetResource ('STR ',-16096);
2709 BlockMove ((unsigned char *) *owner_name
,
2710 (unsigned char *) my_passwd_name
,
2712 HUnlock (owner_name
);
2713 p2cstr ((unsigned char *) my_passwd_name
);
2716 my_passwd_name
[0] = 0;
2721 getpwuid (uid_t uid
)
2723 if (!my_passwd_inited
)
2726 my_passwd_inited
= 1;
2734 getgrgid (gid_t gid
)
2741 getpwnam (const char *name
)
2743 if (strcmp (name
, "emacs") == 0)
2744 return &emacs_passwd
;
2746 if (!my_passwd_inited
)
2749 my_passwd_inited
= 1;
2756 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2757 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2778 error ("Can't spawn subshell");
2783 request_sigio (void)
2789 unrequest_sigio (void)
2804 pipe (int _fildes
[2])
2811 /* Hard and symbolic links. */
2814 symlink (const char *name1
, const char *name2
)
2822 link (const char *name1
, const char *name2
)
2828 #endif /* ! MAC_OSX */
2830 /* Determine the path name of the file specified by VREFNUM, DIRID,
2831 and NAME and place that in the buffer PATH of length
2834 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2835 long dir_id
, ConstStr255Param name
)
2841 if (strlen (name
) > man_path_len
)
2844 memcpy (dir_name
, name
, name
[0]+1);
2845 memcpy (path
, name
, name
[0]+1);
2848 cipb
.dirInfo
.ioDrParID
= dir_id
;
2849 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2853 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2854 cipb
.dirInfo
.ioFDirIndex
= -1;
2855 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2856 /* go up to parent each time */
2858 err
= PBGetCatInfo (&cipb
, false);
2863 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2866 strcat (dir_name
, ":");
2867 strcat (dir_name
, path
);
2868 /* attach to front since we're going up directory tree */
2869 strcpy (path
, dir_name
);
2871 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2872 /* stop when we see the volume's root directory */
2874 return 1; /* success */
2879 posix_pathname_to_fsspec (ufn
, fs
)
2883 Str255 mac_pathname
;
2885 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2889 c2pstr (mac_pathname
);
2890 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2895 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2900 char mac_pathname
[MAXPATHLEN
];
2902 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2903 fs
->vRefNum
, fs
->parID
, fs
->name
)
2904 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2913 readlink (const char *path
, char *buf
, int bufsiz
)
2915 char mac_sym_link_name
[MAXPATHLEN
+1];
2918 Boolean target_is_folder
, was_aliased
;
2919 Str255 directory_name
, mac_pathname
;
2922 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2925 c2pstr (mac_sym_link_name
);
2926 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2933 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2934 if (err
!= noErr
|| !was_aliased
)
2940 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2947 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2953 return strlen (buf
);
2957 /* Convert a path to one with aliases fully expanded. */
2960 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2962 char *q
, temp
[MAXPATHLEN
+1];
2966 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2973 q
= strchr (p
+ 1, '/');
2975 q
= strchr (p
, '/');
2976 len
= 0; /* loop may not be entered, e.g., for "/" */
2981 strncat (temp
, p
, q
- p
);
2982 len
= readlink (temp
, buf
, bufsiz
);
2985 if (strlen (temp
) + 1 > bufsiz
)
2995 if (len
+ strlen (p
) + 1 >= bufsiz
)
2999 return len
+ strlen (p
);
3004 umask (mode_t numask
)
3006 static mode_t mask
= 022;
3007 mode_t oldmask
= mask
;
3014 chmod (const char *path
, mode_t mode
)
3016 /* say it always succeed for now */
3022 fchmod (int fd
, mode_t mode
)
3024 /* say it always succeed for now */
3030 fchown (int fd
, uid_t owner
, gid_t group
)
3032 /* say it always succeed for now */
3041 return fcntl (oldd
, F_DUPFD
, 0);
3043 /* current implementation of fcntl in fcntl.mac.c simply returns old
3045 return fcntl (oldd
, F_DUPFD
);
3052 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3053 newd if it already exists. Then, attempt to dup oldd. If not
3054 successful, call dup2 recursively until we are, then close the
3055 unsuccessful ones. */
3058 dup2 (int oldd
, int newd
)
3069 ret
= dup2 (oldd
, newd
);
3075 /* let it fail for now */
3092 ioctl (int d
, int request
, void *argp
)
3102 if (fildes
>=0 && fildes
<= 2)
3135 #endif /* __MRC__ */
3139 #if __MSL__ < 0x6000
3147 #endif /* __MWERKS__ */
3149 #endif /* ! MAC_OSX */
3152 /* Return the path to the directory in which Emacs can create
3153 temporary files. The MacOS "temporary items" directory cannot be
3154 used because it removes the file written by a process when it
3155 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3156 again not exactly). And of course Emacs needs to read back the
3157 files written by its subprocesses. So here we write the files to a
3158 directory "Emacs" in the Preferences Folder. This directory is
3159 created if it does not exist. */
3162 get_temp_dir_name ()
3164 static char *temp_dir_name
= NULL
;
3168 Str255 dir_name
, full_path
;
3170 char unix_dir_name
[MAXPATHLEN
+1];
3173 /* Cache directory name with pointer temp_dir_name.
3174 Look for it only the first time. */
3177 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3178 &vol_ref_num
, &dir_id
);
3182 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3185 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3186 strcat (full_path
, "Emacs:");
3190 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3193 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3196 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3199 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3200 strcpy (temp_dir_name
, unix_dir_name
);
3203 return temp_dir_name
;
3208 /* Allocate and construct an array of pointers to strings from a list
3209 of strings stored in a 'STR#' resource. The returned pointer array
3210 is stored in the style of argv and environ: if the 'STR#' resource
3211 contains numString strings, a pointer array with numString+1
3212 elements is returned in which the last entry contains a null
3213 pointer. The pointer to the pointer array is passed by pointer in
3214 parameter t. The resource ID of the 'STR#' resource is passed in
3215 parameter StringListID.
3219 get_string_list (char ***t
, short string_list_id
)
3225 h
= GetResource ('STR#', string_list_id
);
3230 num_strings
= * (short *) p
;
3232 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3233 for (i
= 0; i
< num_strings
; i
++)
3235 short length
= *p
++;
3236 (*t
)[i
] = (char *) malloc (length
+ 1);
3237 strncpy ((*t
)[i
], p
, length
);
3238 (*t
)[i
][length
] = '\0';
3241 (*t
)[num_strings
] = 0;
3246 /* Return no string in case GetResource fails. Bug fixed by
3247 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3248 option (no sym -on implies -opt local). */
3249 *t
= (char **) malloc (sizeof (char *));
3256 get_path_to_system_folder ()
3261 Str255 dir_name
, full_path
;
3263 static char system_folder_unix_name
[MAXPATHLEN
+1];
3266 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3267 &vol_ref_num
, &dir_id
);
3271 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3274 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3278 return system_folder_unix_name
;
3284 #define ENVIRON_STRING_LIST_ID 128
3286 /* Get environment variable definitions from STR# resource. */
3293 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3299 /* Make HOME directory the one Emacs starts up in if not specified
3301 if (getenv ("HOME") == NULL
)
3303 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3306 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3309 strcpy (environ
[i
], "HOME=");
3310 strcat (environ
[i
], my_passwd_dir
);
3317 /* Make HOME directory the one Emacs starts up in if not specified
3319 if (getenv ("MAIL") == NULL
)
3321 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3324 char * path_to_system_folder
= get_path_to_system_folder ();
3325 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3328 strcpy (environ
[i
], "MAIL=");
3329 strcat (environ
[i
], path_to_system_folder
);
3330 strcat (environ
[i
], "Eudora Folder/In");
3338 /* Return the value of the environment variable NAME. */
3341 getenv (const char *name
)
3343 int length
= strlen(name
);
3346 for (e
= environ
; *e
!= 0; e
++)
3347 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3348 return &(*e
)[length
+ 1];
3350 if (strcmp (name
, "TMPDIR") == 0)
3351 return get_temp_dir_name ();
3358 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3359 char *sys_siglist
[] =
3361 "Zero is not a signal!!!",
3363 "Interactive user interrupt", /* 2 */ "?",
3364 "Floating point exception", /* 4 */ "?", "?", "?",
3365 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3366 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3367 "?", "?", "?", "?", "?", "?", "?", "?",
3371 char *sys_siglist
[] =
3373 "Zero is not a signal!!!",
3375 "Floating point exception",
3376 "Illegal instruction",
3377 "Interactive user interrupt",
3378 "Segment violation",
3381 #else /* not __MRC__ and not __MWERKS__ */
3383 #endif /* not __MRC__ and not __MWERKS__ */
3386 #include <utsname.h>
3389 uname (struct utsname
*name
)
3392 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3395 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3396 p2cstr (name
->nodename
);
3404 /* Event class of HLE sent to subprocess. */
3405 const OSType kEmacsSubprocessSend
= 'ESND';
3407 /* Event class of HLE sent back from subprocess. */
3408 const OSType kEmacsSubprocessReply
= 'ERPY';
3412 mystrchr (char *s
, char c
)
3414 while (*s
&& *s
!= c
)
3442 mystrcpy (char *to
, char *from
)
3454 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3455 terminated). The process should run with the default directory
3456 "workdir", read input from "infn", and write output and error to
3457 "outfn" and "errfn", resp. The Process Manager call
3458 LaunchApplication is used to start the subprocess. We use high
3459 level events as the mechanism to pass arguments to the subprocess
3460 and to make Emacs wait for the subprocess to terminate and pass
3461 back a result code. The bulk of the code here packs the arguments
3462 into one message to be passed together with the high level event.
3463 Emacs also sometimes starts a subprocess using a shell to perform
3464 wildcard filename expansion. Since we don't really have a shell on
3465 the Mac, this case is detected and the starting of the shell is
3466 by-passed. We really need to add code here to do filename
3467 expansion to support such functionality.
3469 We can't use this strategy in Carbon because the High Level Event
3470 APIs are not available. */
3473 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3474 unsigned char **argv
;
3475 const char *workdir
;
3476 const char *infn
, *outfn
, *errfn
;
3478 #if TARGET_API_MAC_CARBON
3480 #else /* not TARGET_API_MAC_CARBON */
3481 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3482 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3483 int paramlen
, argc
, newargc
, j
, retries
;
3484 char **newargv
, *param
, *p
;
3487 LaunchParamBlockRec lpbr
;
3488 EventRecord send_event
, reply_event
;
3489 RgnHandle cursor_region_handle
;
3491 unsigned long ref_con
, len
;
3493 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3495 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3497 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3499 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3502 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3503 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3512 /* If a subprocess is invoked with a shell, we receive 3 arguments
3513 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3514 bins>/<command> <command args>" */
3515 j
= strlen (argv
[0]);
3516 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3517 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3519 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3521 /* The arguments for the command in argv[2] are separated by
3522 spaces. Count them and put the count in newargc. */
3523 command
= (char *) alloca (strlen (argv
[2])+2);
3524 strcpy (command
, argv
[2]);
3525 if (command
[strlen (command
) - 1] != ' ')
3526 strcat (command
, " ");
3530 t
= mystrchr (t
, ' ');
3534 t
= mystrchr (t
+1, ' ');
3537 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3540 for (j
= 0; j
< newargc
; j
++)
3542 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3543 mystrcpy (newargv
[j
], t
);
3546 paramlen
+= strlen (newargv
[j
]) + 1;
3549 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3551 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3556 { /* sometimes Emacs call "sh" without a path for the command */
3558 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3559 strcpy (t
, "~emacs/");
3560 strcat (t
, newargv
[0]);
3563 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3564 make_number (X_OK
));
3568 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3572 strcpy (macappname
, tempmacpathname
);
3576 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3579 newargv
= (char **) alloca (sizeof (char *) * argc
);
3581 for (j
= 1; j
< argc
; j
++)
3583 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3585 char *t
= strchr (argv
[j
], ' ');
3588 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3589 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3590 tempcmdname
[t
-argv
[j
]] = '\0';
3591 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3594 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3596 strcpy (newargv
[j
], tempmaccmdname
);
3597 strcat (newargv
[j
], t
);
3601 char tempmaccmdname
[MAXPATHLEN
+1];
3602 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3605 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3606 strcpy (newargv
[j
], tempmaccmdname
);
3610 newargv
[j
] = argv
[j
];
3611 paramlen
+= strlen (newargv
[j
]) + 1;
3615 /* After expanding all the arguments, we now know the length of the
3616 parameter block to be sent to the subprocess as a message
3617 attached to the HLE. */
3618 param
= (char *) malloc (paramlen
+ 1);
3624 /* first byte of message contains number of arguments for command */
3625 strcpy (p
, macworkdir
);
3626 p
+= strlen (macworkdir
);
3628 /* null terminate strings sent so it's possible to use strcpy over there */
3629 strcpy (p
, macinfn
);
3630 p
+= strlen (macinfn
);
3632 strcpy (p
, macoutfn
);
3633 p
+= strlen (macoutfn
);
3635 strcpy (p
, macerrfn
);
3636 p
+= strlen (macerrfn
);
3638 for (j
= 1; j
< newargc
; j
++)
3640 strcpy (p
, newargv
[j
]);
3641 p
+= strlen (newargv
[j
]);
3645 c2pstr (macappname
);
3647 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3655 lpbr
.launchBlockID
= extendedBlock
;
3656 lpbr
.launchEPBLength
= extendedBlockLen
;
3657 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3658 lpbr
.launchAppSpec
= &spec
;
3659 lpbr
.launchAppParameters
= NULL
;
3661 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3668 send_event
.what
= kHighLevelEvent
;
3669 send_event
.message
= kEmacsSubprocessSend
;
3670 /* Event ID stored in "where" unused */
3673 /* OS may think current subprocess has terminated if previous one
3674 terminated recently. */
3677 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3678 paramlen
+ 1, receiverIDisPSN
);
3680 while (iErr
== sessClosedErr
&& retries
-- > 0);
3688 cursor_region_handle
= NewRgn ();
3690 /* Wait for the subprocess to finish, when it will send us a ERPY
3691 high level event. */
3693 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3694 cursor_region_handle
)
3695 && reply_event
.message
== kEmacsSubprocessReply
)
3698 /* The return code is sent through the refCon */
3699 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3702 DisposeHandle ((Handle
) cursor_region_handle
);
3707 DisposeHandle ((Handle
) cursor_region_handle
);
3711 #endif /* not TARGET_API_MAC_CARBON */
3716 opendir (const char *dirname
)
3718 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3719 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3723 int len
, vol_name_len
;
3725 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3728 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3730 fully_resolved_name
[len
] = '\0';
3732 strcpy (fully_resolved_name
, true_pathname
);
3734 dirp
= (DIR *) malloc (sizeof(DIR));
3738 /* Handle special case when dirname is "/": sets up for readir to
3739 get all mount volumes. */
3740 if (strcmp (fully_resolved_name
, "/") == 0)
3742 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3743 dirp
->current_index
= 1; /* index for first volume */
3747 /* Handle typical cases: not accessing all mounted volumes. */
3748 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3751 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3752 len
= strlen (mac_pathname
);
3753 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3754 strcat (mac_pathname
, ":");
3756 /* Extract volume name */
3757 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3758 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3759 vol_name
[vol_name_len
] = '\0';
3760 strcat (vol_name
, ":");
3762 c2pstr (mac_pathname
);
3763 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3764 /* using full pathname so vRefNum and DirID ignored */
3765 cipb
.hFileInfo
.ioVRefNum
= 0;
3766 cipb
.hFileInfo
.ioDirID
= 0;
3767 cipb
.hFileInfo
.ioFDirIndex
= 0;
3768 /* set to 0 to get information about specific dir or file */
3770 errno
= PBGetCatInfo (&cipb
, false);
3777 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3778 return 0; /* not a directory */
3780 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3781 dirp
->getting_volumes
= 0;
3782 dirp
->current_index
= 1; /* index for first file/directory */
3785 vpb
.ioNamePtr
= vol_name
;
3786 /* using full pathname so vRefNum and DirID ignored */
3788 vpb
.ioVolIndex
= -1;
3789 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3796 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3813 HParamBlockRec hpblock
;
3815 static struct dirent s_dirent
;
3816 static Str255 s_name
;
3820 /* Handle the root directory containing the mounted volumes. Call
3821 PBHGetVInfo specifying an index to obtain the info for a volume.
3822 PBHGetVInfo returns an error when it receives an index beyond the
3823 last volume, at which time we should return a nil dirent struct
3825 if (dp
->getting_volumes
)
3827 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3828 hpblock
.volumeParam
.ioVRefNum
= 0;
3829 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3831 errno
= PBHGetVInfo (&hpblock
, false);
3839 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3841 dp
->current_index
++;
3843 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3844 s_dirent
.d_name
= s_name
;
3850 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3851 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3852 /* location to receive filename returned */
3854 /* return only visible files */
3858 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3859 /* directory ID found by opendir */
3860 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3862 errno
= PBGetCatInfo (&cipb
, false);
3869 /* insist on a visible entry */
3870 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3871 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3873 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3875 dp
->current_index
++;
3888 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3889 /* value unimportant: non-zero for valid file */
3890 s_dirent
.d_name
= s_name
;
3900 char mac_pathname
[MAXPATHLEN
+1];
3901 Str255 directory_name
;
3905 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3908 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3914 #endif /* ! MAC_OSX */
3918 initialize_applescript ()
3923 /* if open fails, as_scripting_component is set to NULL. Its
3924 subsequent use in OSA calls will fail with badComponentInstance
3926 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3927 kAppleScriptSubtype
);
3929 null_desc
.descriptorType
= typeNull
;
3930 null_desc
.dataHandle
= 0;
3931 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3932 kOSANullScript
, &as_script_context
);
3934 as_script_context
= kOSANullScript
;
3935 /* use default context if create fails */
3940 terminate_applescript()
3942 OSADispose (as_scripting_component
, as_script_context
);
3943 CloseComponent (as_scripting_component
);
3946 /* Convert a lisp string to the 4 byte character code. */
3949 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3958 /* check type string */
3960 if (SBYTES (arg
) != 4)
3962 error ("Wrong argument: need string of length 4 for code");
3964 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3969 /* Convert the 4 byte character code into a 4 byte string. */
3972 mac_get_object_from_code(OSType defCode
)
3974 UInt32 code
= EndianU32_NtoB (defCode
);
3976 return make_unibyte_string ((char *)&code
, 4);
3980 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3981 doc
: /* Get the creator code of FILENAME as a four character string. */)
3983 Lisp_Object filename
;
3992 Lisp_Object result
= Qnil
;
3993 CHECK_STRING (filename
);
3995 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3998 filename
= Fexpand_file_name (filename
, Qnil
);
4002 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4004 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4007 if (status
== noErr
)
4010 FSCatalogInfo catalogInfo
;
4012 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4013 &catalogInfo
, NULL
, NULL
, NULL
);
4017 status
= FSpGetFInfo (&fss
, &finder_info
);
4019 if (status
== noErr
)
4022 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4024 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4029 if (status
!= noErr
) {
4030 error ("Error while getting file information.");
4035 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4036 doc
: /* Get the type code of FILENAME as a four character string. */)
4038 Lisp_Object filename
;
4047 Lisp_Object result
= Qnil
;
4048 CHECK_STRING (filename
);
4050 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4053 filename
= Fexpand_file_name (filename
, Qnil
);
4057 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4059 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4062 if (status
== noErr
)
4065 FSCatalogInfo catalogInfo
;
4067 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4068 &catalogInfo
, NULL
, NULL
, NULL
);
4072 status
= FSpGetFInfo (&fss
, &finder_info
);
4074 if (status
== noErr
)
4077 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4079 result
= mac_get_object_from_code (finder_info
.fdType
);
4084 if (status
!= noErr
) {
4085 error ("Error while getting file information.");
4090 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4091 doc
: /* Set creator code of file FILENAME to CODE.
4092 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4093 assumed. Return non-nil if successful. */)
4095 Lisp_Object filename
, code
;
4104 CHECK_STRING (filename
);
4106 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4108 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4111 filename
= Fexpand_file_name (filename
, Qnil
);
4115 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4117 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4120 if (status
== noErr
)
4123 FSCatalogInfo catalogInfo
;
4125 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4126 &catalogInfo
, NULL
, NULL
, &parentDir
);
4130 status
= FSpGetFInfo (&fss
, &finder_info
);
4132 if (status
== noErr
)
4135 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4136 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4137 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4139 finder_info
.fdCreator
= cCode
;
4140 status
= FSpSetFInfo (&fss
, &finder_info
);
4145 if (status
!= noErr
) {
4146 error ("Error while setting creator information.");
4151 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4152 doc
: /* Set file code of file FILENAME to CODE.
4153 CODE must be a 4-character string. Return non-nil if successful. */)
4155 Lisp_Object filename
, code
;
4164 CHECK_STRING (filename
);
4166 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4168 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4171 filename
= Fexpand_file_name (filename
, Qnil
);
4175 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4177 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4180 if (status
== noErr
)
4183 FSCatalogInfo catalogInfo
;
4185 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4186 &catalogInfo
, NULL
, NULL
, &parentDir
);
4190 status
= FSpGetFInfo (&fss
, &finder_info
);
4192 if (status
== noErr
)
4195 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4196 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4197 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4199 finder_info
.fdType
= cCode
;
4200 status
= FSpSetFInfo (&fss
, &finder_info
);
4205 if (status
!= noErr
) {
4206 error ("Error while setting creator information.");
4212 /* Compile and execute the AppleScript SCRIPT and return the error
4213 status as function value. A zero is returned if compilation and
4214 execution is successful, in which case *RESULT is set to a Lisp
4215 string containing the resulting script value. Otherwise, the Mac
4216 error code is returned and *RESULT is set to an error Lisp string.
4217 For documentation on the MacOS scripting architecture, see Inside
4218 Macintosh - Interapplication Communications: Scripting
4222 do_applescript (script
, result
)
4223 Lisp_Object script
, *result
;
4225 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4231 if (!as_scripting_component
)
4232 initialize_applescript();
4234 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4239 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4240 typeChar
, kOSAModeNull
, &result_desc
);
4242 if (osaerror
== noErr
)
4243 /* success: retrieve resulting script value */
4244 desc
= &result_desc
;
4245 else if (osaerror
== errOSAScriptError
)
4246 /* error executing AppleScript: retrieve error message */
4247 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4253 #if TARGET_API_MAC_CARBON
4254 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4255 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4256 #else /* not TARGET_API_MAC_CARBON */
4257 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4258 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4259 #endif /* not TARGET_API_MAC_CARBON */
4260 AEDisposeDesc (desc
);
4263 AEDisposeDesc (&script_desc
);
4269 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4270 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4271 If compilation and execution are successful, the resulting script
4272 value is returned as a string. Otherwise the function aborts and
4273 displays the error message returned by the AppleScript scripting
4281 CHECK_STRING (script
);
4284 status
= do_applescript (script
, &result
);
4288 else if (!STRINGP (result
))
4289 error ("AppleScript error %d", status
);
4291 error ("%s", SDATA (result
));
4295 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4296 Smac_file_name_to_posix
, 1, 1, 0,
4297 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4299 Lisp_Object filename
;
4301 char posix_filename
[MAXPATHLEN
+1];
4303 CHECK_STRING (filename
);
4305 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4306 return build_string (posix_filename
);
4312 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4313 Sposix_file_name_to_mac
, 1, 1, 0,
4314 doc
: /* Convert Posix FILENAME to Mac form. */)
4316 Lisp_Object filename
;
4318 char mac_filename
[MAXPATHLEN
+1];
4320 CHECK_STRING (filename
);
4322 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4323 return build_string (mac_filename
);
4329 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4330 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4331 Each type should be a string of length 4 or the symbol
4332 `undecoded-file-name'. */)
4333 (src_type
, src_data
, dst_type
)
4334 Lisp_Object src_type
, src_data
, dst_type
;
4337 Lisp_Object result
= Qnil
;
4338 DescType src_desc_type
, dst_desc_type
;
4346 CHECK_STRING (src_data
);
4347 if (EQ (src_type
, Qundecoded_file_name
))
4348 src_desc_type
= TYPE_FILE_NAME
;
4350 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4352 if (EQ (dst_type
, Qundecoded_file_name
))
4353 dst_desc_type
= TYPE_FILE_NAME
;
4355 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4358 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4359 dst_desc_type
, &dst_desc
);
4362 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4363 AEDisposeDesc (&dst_desc
);
4371 #if TARGET_API_MAC_CARBON
4372 static Lisp_Object Qxml
, Qmime_charset
;
4373 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4375 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4376 doc
: /* Return the application preference value for KEY.
4377 KEY is either a string specifying a preference key, or a list of key
4378 strings. If it is a list, the (i+1)-th element is used as a key for
4379 the CFDictionary value obtained by the i-th element. Return nil if
4380 lookup is failed at some stage.
4382 Optional arg APPLICATION is an application ID string. If omitted or
4383 nil, that stands for the current application.
4385 Optional arg FORMAT specifies the data format of the return value. If
4386 omitted or nil, each Core Foundation object is converted into a
4387 corresponding Lisp object as follows:
4389 Core Foundation Lisp Tag
4390 ------------------------------------------------------------
4391 CFString Multibyte string string
4392 CFNumber Integer or float number
4393 CFBoolean Symbol (t or nil) boolean
4394 CFDate List of three integers date
4395 (cf. `current-time')
4396 CFData Unibyte string data
4397 CFArray Vector array
4398 CFDictionary Alist or hash table dictionary
4399 (depending on HASH-BOUND)
4401 If it is t, a symbol that represents the type of the original Core
4402 Foundation object is prepended. If it is `xml', the value is returned
4403 as an XML representation.
4405 Optional arg HASH-BOUND specifies which kinds of the list objects,
4406 alists or hash tables, are used as the targets of the conversion from
4407 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4408 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4409 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4411 (key
, application
, format
, hash_bound
)
4412 Lisp_Object key
, application
, format
, hash_bound
;
4414 CFStringRef app_id
, key_str
;
4415 CFPropertyListRef app_plist
= NULL
, plist
;
4416 Lisp_Object result
= Qnil
, tmp
;
4419 key
= Fcons (key
, Qnil
);
4423 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4424 CHECK_STRING_CAR (tmp
);
4426 wrong_type_argument (Qlistp
, key
);
4428 if (!NILP (application
))
4429 CHECK_STRING (application
);
4430 CHECK_SYMBOL (format
);
4431 if (!NILP (hash_bound
))
4432 CHECK_NUMBER (hash_bound
);
4436 app_id
= kCFPreferencesCurrentApplication
;
4437 if (!NILP (application
))
4439 app_id
= cfstring_create_with_string (application
);
4443 key_str
= cfstring_create_with_string (XCAR (key
));
4444 if (key_str
== NULL
)
4446 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4447 CFRelease (key_str
);
4448 if (app_plist
== NULL
)
4452 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4454 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4456 key_str
= cfstring_create_with_string (XCAR (key
));
4457 if (key_str
== NULL
)
4459 plist
= CFDictionaryGetValue (plist
, key_str
);
4460 CFRelease (key_str
);
4466 if (EQ (format
, Qxml
))
4468 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4471 result
= cfdata_to_lisp (data
);
4476 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4477 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4481 CFRelease (app_plist
);
4490 static CFStringEncoding
4491 get_cfstring_encoding_from_lisp (obj
)
4494 CFStringRef iana_name
;
4495 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4498 return kCFStringEncodingUnicode
;
4503 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4505 Lisp_Object coding_spec
, plist
;
4507 coding_spec
= Fget (obj
, Qcoding_system
);
4508 plist
= XVECTOR (coding_spec
)->contents
[3];
4509 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4513 obj
= SYMBOL_NAME (obj
);
4517 iana_name
= cfstring_create_with_string (obj
);
4520 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4521 CFRelease (iana_name
);
4528 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4530 cfstring_create_normalized (str
, symbol
)
4535 TextEncodingVariant variant
;
4536 float initial_mag
= 0.0;
4537 CFStringRef result
= NULL
;
4539 if (EQ (symbol
, QNFD
))
4540 form
= kCFStringNormalizationFormD
;
4541 else if (EQ (symbol
, QNFKD
))
4542 form
= kCFStringNormalizationFormKD
;
4543 else if (EQ (symbol
, QNFC
))
4544 form
= kCFStringNormalizationFormC
;
4545 else if (EQ (symbol
, QNFKC
))
4546 form
= kCFStringNormalizationFormKC
;
4547 else if (EQ (symbol
, QHFS_plus_D
))
4549 variant
= kUnicodeHFSPlusDecompVariant
;
4552 else if (EQ (symbol
, QHFS_plus_C
))
4554 variant
= kUnicodeHFSPlusCompVariant
;
4560 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4564 CFStringNormalize (mut_str
, form
);
4568 else if (initial_mag
> 0.0)
4570 UnicodeToTextInfo uni
= NULL
;
4573 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4575 ByteCount out_read
, out_size
, out_len
;
4577 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4579 kTextEncodingDefaultFormat
);
4580 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4582 kTextEncodingDefaultFormat
);
4583 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4585 length
= CFStringGetLength (str
);
4586 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4590 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4591 if (in_text
== NULL
)
4593 buffer
= xmalloc (sizeof (UniChar
) * length
);
4596 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4602 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4603 while (err
== noErr
)
4605 out_buf
= xmalloc (out_size
);
4606 if (out_buf
== NULL
)
4609 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4611 kUnicodeDefaultDirectionMask
,
4612 0, NULL
, NULL
, NULL
,
4613 out_size
, &out_read
, &out_len
,
4615 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4624 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4625 out_len
/ sizeof (UniChar
));
4627 DisposeUnicodeToTextInfo (&uni
);
4643 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4644 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4645 The conversion is performed using the converter provided by the system.
4646 Each encoding is specified by either a coding system symbol, a mime
4647 charset string, or an integer as a CFStringEncoding value. Nil for
4648 encoding means UTF-16 in native byte order, no byte order mark.
4649 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4650 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4651 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4652 On successful conversion, return the result string, else return nil. */)
4653 (string
, source
, target
, normalization_form
)
4654 Lisp_Object string
, source
, target
, normalization_form
;
4656 Lisp_Object result
= Qnil
;
4657 CFStringEncoding src_encoding
, tgt_encoding
;
4658 CFStringRef str
= NULL
;
4660 CHECK_STRING (string
);
4661 if (!INTEGERP (source
) && !STRINGP (source
))
4662 CHECK_SYMBOL (source
);
4663 if (!INTEGERP (target
) && !STRINGP (target
))
4664 CHECK_SYMBOL (target
);
4665 CHECK_SYMBOL (normalization_form
);
4669 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4670 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4672 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4673 use string_as_unibyte which works as well, except for the fact that
4674 it's too permissive (it doesn't check that the multibyte string only
4675 contain single-byte chars). */
4676 string
= Fstring_as_unibyte (string
);
4677 if (src_encoding
!= kCFStringEncodingInvalidId
4678 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4679 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4680 src_encoding
, !NILP (source
));
4681 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4684 CFStringRef saved_str
= str
;
4686 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4687 CFRelease (saved_str
);
4692 CFIndex str_len
, buf_len
;
4694 str_len
= CFStringGetLength (str
);
4695 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4696 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4698 result
= make_uninit_string (buf_len
);
4699 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4700 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4709 #endif /* TARGET_API_MAC_CARBON */
4712 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4713 doc
: /* Clear the font name table. */)
4717 mac_clear_font_name_table ();
4723 mac_get_system_locale ()
4731 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4732 region
= GetScriptManagerVariable (smRegionCode
);
4733 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4735 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4738 return build_string (str
);
4747 extern int inhibit_window_system
;
4748 extern int noninteractive
;
4750 /* Unlike in X11, window events in Carbon do not come from sockets.
4751 So we cannot simply use `select' to monitor two kinds of inputs:
4752 window events and process outputs. We emulate such functionality
4753 by regarding fd 0 as the window event channel and simultaneously
4754 monitoring both kinds of input channels. It is implemented by
4755 dividing into some cases:
4756 1. The window event channel is not involved.
4758 2. Sockets are not involved.
4759 -> Use ReceiveNextEvent.
4760 3. [If SELECT_USE_CFSOCKET is defined]
4761 Only the window event channel and socket read channels are
4762 involved, and timeout is not too short (greater than
4763 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4764 -> Create CFSocket for each socket and add it into the current
4765 event RunLoop so that a `ready-to-read' event can be posted
4766 to the event queue that is also used for window events. Then
4767 ReceiveNextEvent can wait for both kinds of inputs.
4769 -> Periodically poll the window input channel while repeatedly
4770 executing `select' with a short timeout
4771 (SELECT_POLLING_PERIOD_USEC microseconds). */
4773 #define SELECT_POLLING_PERIOD_USEC 20000
4774 #ifdef SELECT_USE_CFSOCKET
4775 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4776 #define EVENT_CLASS_SOCK 'Sock'
4779 socket_callback (s
, type
, address
, data
, info
)
4781 CFSocketCallBackType type
;
4788 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4789 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4790 ReleaseEvent (event
);
4792 #endif /* SELECT_USE_CFSOCKET */
4795 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4800 struct timeval
*timeout
;
4805 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4809 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4810 kEventLeaveInQueue
, NULL
);
4821 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4822 #undef SELECT_INVALIDATE_CFSOCKET
4826 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4831 struct timeval
*timeout
;
4835 EMACS_TIME select_timeout
;
4837 if (inhibit_window_system
|| noninteractive
4838 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4839 return select (n
, rfds
, wfds
, efds
, timeout
);
4843 if (wfds
== NULL
&& efds
== NULL
)
4846 SELECT_TYPE orfds
= *rfds
;
4848 EventTimeout timeout_sec
=
4850 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4851 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4852 : kEventDurationForever
);
4854 for (i
= 1; i
< n
; i
++)
4855 if (FD_ISSET (i
, rfds
))
4861 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4862 kEventLeaveInQueue
, NULL
);
4873 /* Avoid initial overhead of RunLoop setup for the case that
4874 some input is already available. */
4875 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4876 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4877 if (r
!= 0 || timeout_sec
== 0.0)
4882 #ifdef SELECT_USE_CFSOCKET
4883 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4884 goto poll_periodically
;
4887 CFRunLoopRef runloop
=
4888 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4889 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4890 #ifdef SELECT_INVALIDATE_CFSOCKET
4891 CFSocketRef
*shead
, *s
;
4893 CFRunLoopSourceRef
*shead
, *s
;
4898 #ifdef SELECT_INVALIDATE_CFSOCKET
4899 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4901 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4904 for (i
= 1; i
< n
; i
++)
4905 if (FD_ISSET (i
, rfds
))
4907 CFSocketRef socket
=
4908 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4909 socket_callback
, NULL
);
4910 CFRunLoopSourceRef source
=
4911 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4913 #ifdef SELECT_INVALIDATE_CFSOCKET
4914 CFSocketSetSocketFlags (socket
, 0);
4916 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4917 #ifdef SELECT_INVALIDATE_CFSOCKET
4927 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4932 #ifdef SELECT_INVALIDATE_CFSOCKET
4933 CFSocketInvalidate (*s
);
4935 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4950 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4951 GetEventTypeCount (specs
),
4953 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4954 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4961 #endif /* SELECT_USE_CFSOCKET */
4966 EMACS_TIME end_time
, now
, remaining_time
;
4967 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4975 remaining_time
= *timeout
;
4976 EMACS_GET_TIME (now
);
4977 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4982 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4983 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4984 select_timeout
= remaining_time
;
4985 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4997 EMACS_GET_TIME (now
);
4998 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5001 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5012 /* Set up environment variables so that Emacs can correctly find its
5013 support files when packaged as an application bundle. Directories
5014 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5015 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5016 by `make install' by default can instead be placed in
5017 .../Emacs.app/Contents/Resources/ and
5018 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5019 is changed only if it is not already set. Presumably if the user
5020 sets an environment variable, he will want to use files in his path
5021 instead of ones in the application bundle. */
5023 init_mac_osx_environment ()
5027 CFStringRef cf_app_bundle_pathname
;
5028 int app_bundle_pathname_len
;
5029 char *app_bundle_pathname
;
5033 /* Initialize locale related variables. */
5034 mac_system_script_code
=
5035 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5036 Vmac_system_locale
= mac_get_system_locale ();
5038 /* Fetch the pathname of the application bundle as a C string into
5039 app_bundle_pathname. */
5041 bundle
= CFBundleGetMainBundle ();
5042 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5044 /* We could not find the bundle identifier. For now, prevent
5045 the fatal error by bringing it up in the terminal. */
5046 inhibit_window_system
= 1;
5050 bundleURL
= CFBundleCopyBundleURL (bundle
);
5054 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5055 kCFURLPOSIXPathStyle
);
5056 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5057 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5059 if (!CFStringGetCString (cf_app_bundle_pathname
,
5060 app_bundle_pathname
,
5061 app_bundle_pathname_len
+ 1,
5062 kCFStringEncodingISOLatin1
))
5064 CFRelease (cf_app_bundle_pathname
);
5068 CFRelease (cf_app_bundle_pathname
);
5070 /* P should have sufficient room for the pathname of the bundle plus
5071 the subpath in it leading to the respective directories. Q
5072 should have three times that much room because EMACSLOADPATH can
5073 have the value "<path to lisp dir>:<path to leim dir>:<path to
5075 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5076 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5077 if (!getenv ("EMACSLOADPATH"))
5081 strcpy (p
, app_bundle_pathname
);
5082 strcat (p
, "/Contents/Resources/lisp");
5083 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5086 strcpy (p
, app_bundle_pathname
);
5087 strcat (p
, "/Contents/Resources/leim");
5088 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5095 strcpy (p
, app_bundle_pathname
);
5096 strcat (p
, "/Contents/Resources/site-lisp");
5097 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5105 setenv ("EMACSLOADPATH", q
, 1);
5108 if (!getenv ("EMACSPATH"))
5112 strcpy (p
, app_bundle_pathname
);
5113 strcat (p
, "/Contents/MacOS/libexec");
5114 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5117 strcpy (p
, app_bundle_pathname
);
5118 strcat (p
, "/Contents/MacOS/bin");
5119 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5127 setenv ("EMACSPATH", q
, 1);
5130 if (!getenv ("EMACSDATA"))
5132 strcpy (p
, app_bundle_pathname
);
5133 strcat (p
, "/Contents/Resources/etc");
5134 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5135 setenv ("EMACSDATA", p
, 1);
5138 if (!getenv ("EMACSDOC"))
5140 strcpy (p
, app_bundle_pathname
);
5141 strcat (p
, "/Contents/Resources/etc");
5142 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5143 setenv ("EMACSDOC", p
, 1);
5146 if (!getenv ("INFOPATH"))
5148 strcpy (p
, app_bundle_pathname
);
5149 strcat (p
, "/Contents/Resources/info");
5150 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5151 setenv ("INFOPATH", p
, 1);
5154 #endif /* MAC_OSX */
5160 Qundecoded_file_name
= intern ("undecoded-file-name");
5161 staticpro (&Qundecoded_file_name
);
5163 #if TARGET_API_MAC_CARBON
5164 Qstring
= intern ("string"); staticpro (&Qstring
);
5165 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5166 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5167 Qdate
= intern ("date"); staticpro (&Qdate
);
5168 Qdata
= intern ("data"); staticpro (&Qdata
);
5169 Qarray
= intern ("array"); staticpro (&Qarray
);
5170 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5172 Qxml
= intern ("xml");
5175 Qmime_charset
= intern ("mime-charset");
5176 staticpro (&Qmime_charset
);
5178 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5179 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5180 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5181 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5182 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5183 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5186 defsubr (&Smac_coerce_ae_data
);
5187 #if TARGET_API_MAC_CARBON
5188 defsubr (&Smac_get_preference
);
5189 defsubr (&Smac_code_convert_string
);
5191 defsubr (&Smac_clear_font_name_table
);
5193 defsubr (&Smac_set_file_creator
);
5194 defsubr (&Smac_set_file_type
);
5195 defsubr (&Smac_get_file_creator
);
5196 defsubr (&Smac_get_file_type
);
5197 defsubr (&Sdo_applescript
);
5198 defsubr (&Smac_file_name_to_posix
);
5199 defsubr (&Sposix_file_name_to_mac
);
5201 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5202 doc
: /* The system script code. */);
5203 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5205 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5206 doc
: /* The system locale identifier string.
5207 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5208 information is not included. */);
5209 Vmac_system_locale
= mac_get_system_locale ();
5212 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5213 (do not change this comment) */