1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
35 #include "sysselect.h"
36 #include "blockinput.h"
42 #if !TARGET_API_MAC_CARBON
45 #include <TextUtils.h>
47 #include <Resources.h>
52 #include <AppleScript.h>
55 #include <Processes.h>
57 #include <MacLocales.h>
59 #endif /* not TARGET_API_MAC_CARBON */
63 #include <sys/types.h>
67 #include <sys/param.h>
73 /* The system script code. */
74 static int mac_system_script_code
;
76 /* The system locale identifier string. */
77 static Lisp_Object Vmac_system_locale
;
79 /* An instance of the AppleScript component. */
80 static ComponentInstance as_scripting_component
;
81 /* The single script context used for all script executions. */
82 static OSAID as_script_context
;
85 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
86 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
89 /* When converting from Mac to Unix pathnames, /'s in folder names are
90 converted to :'s. This function, used in copying folder names,
91 performs a strncat and converts all character a to b in the copy of
92 the string s2 appended to the end of s1. */
95 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
103 for (i
= 0; i
< l2
; i
++)
112 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
113 that does not begin with a ':' and contains at least one ':'. A Mac
114 full pathname causes a '/' to be prepended to the Posix pathname.
115 The algorithm for the rest of the pathname is as follows:
116 For each segment between two ':',
117 if it is non-null, copy as is and then add a '/' at the end,
118 otherwise, insert a "../" into the Posix pathname.
119 Returns 1 if successful; 0 if fails. */
122 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
124 const char *p
, *q
, *pe
;
131 p
= strchr (mfn
, ':');
132 if (p
!= 0 && p
!= mfn
) /* full pathname */
139 pe
= mfn
+ strlen (mfn
);
146 { /* two consecutive ':' */
147 if (strlen (ufn
) + 3 >= ufnbuflen
)
153 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
155 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
162 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
164 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
165 /* no separator for last one */
174 extern char *get_temp_dir_name ();
177 /* Convert a Posix pathname to Mac form. Approximately reverse of the
178 above in algorithm. */
181 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
183 const char *p
, *q
, *pe
;
184 char expanded_pathname
[MAXPATHLEN
+1];
193 /* Check for and handle volume names. Last comparison: strangely
194 somewhere "/.emacs" is passed. A temporary fix for now. */
195 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
197 if (strlen (p
) + 1 > mfnbuflen
)
204 /* expand to emacs dir found by init_emacs_passwd_dir */
205 if (strncmp (p
, "~emacs/", 7) == 0)
207 struct passwd
*pw
= getpwnam ("emacs");
209 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
211 strcpy (expanded_pathname
, pw
->pw_dir
);
212 strcat (expanded_pathname
, p
);
213 p
= expanded_pathname
;
214 /* now p points to the pathname with emacs dir prefix */
216 else if (strncmp (p
, "/tmp/", 5) == 0)
218 char *t
= get_temp_dir_name ();
220 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
222 strcpy (expanded_pathname
, t
);
223 strcat (expanded_pathname
, p
);
224 p
= expanded_pathname
;
225 /* now p points to the pathname with emacs dir prefix */
227 else if (*p
!= '/') /* relative pathname */
239 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
241 if (strlen (mfn
) + 1 >= mfnbuflen
)
247 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
249 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
256 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
258 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
267 /***********************************************************************
268 Conversions on Apple event objects
269 ***********************************************************************/
271 static Lisp_Object Qundecoded_file_name
;
274 mac_aelist_to_lisp (desc_list
)
275 AEDescList
*desc_list
;
279 Lisp_Object result
, elem
;
285 err
= AECountItems (desc_list
, &count
);
291 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
298 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
302 elem
= mac_aelist_to_lisp (&desc
);
303 AEDisposeDesc (&desc
);
307 if (desc_type
== typeNull
)
311 elem
= make_uninit_string (size
);
312 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
313 &desc_type
, SDATA (elem
), size
, &size
);
317 desc_type
= EndianU32_NtoB (desc_type
);
318 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
324 else if (desc_list
->descriptorType
!= typeAEList
)
326 keyword
= EndianU32_NtoB (keyword
);
327 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
330 result
= Fcons (elem
, result
);
334 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
335 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
339 mac_aedesc_to_lisp (desc
)
343 DescType desc_type
= desc
->descriptorType
;
355 return mac_aelist_to_lisp (desc
);
357 /* The following one is much simpler, but creates and disposes
358 of Apple event descriptors many times. */
365 err
= AECountItems (desc
, &count
);
371 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
374 elem
= mac_aedesc_to_lisp (&desc1
);
375 AEDisposeDesc (&desc1
);
376 if (desc_type
!= typeAEList
)
378 keyword
= EndianU32_NtoB (keyword
);
379 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
381 result
= Fcons (elem
, result
);
389 #if TARGET_API_MAC_CARBON
390 result
= make_uninit_string (AEGetDescDataSize (desc
));
391 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
393 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
394 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
402 desc_type
= EndianU32_NtoB (desc_type
);
403 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
407 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
408 to_type
, handler_refcon
, result
)
410 const void *data_ptr
;
418 if (type_code
== typeNull
)
419 err
= errAECoercionFail
;
420 else if (type_code
== to_type
|| to_type
== typeWildCard
)
421 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
422 else if (type_code
== TYPE_FILE_NAME
)
423 /* Coercion from undecoded file name. */
428 CFDataRef data
= NULL
;
430 str
= CFStringCreateWithBytes (NULL
, data_ptr
, data_size
,
431 kCFStringEncodingUTF8
, false);
434 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
435 kCFURLPOSIXPathStyle
, false);
440 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
445 err
= AECoercePtr (typeFileURL
, CFDataGetBytePtr (data
),
446 CFDataGetLength (data
), to_type
, result
);
455 buf
= xmalloc (data_size
+ 1);
456 memcpy (buf
, data_ptr
, data_size
);
457 buf
[data_size
] = '\0';
458 err
= posix_pathname_to_fsspec (buf
, &fs
);
461 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
464 else if (to_type
== TYPE_FILE_NAME
)
465 /* Coercion to undecoded file name. */
469 CFStringRef str
= NULL
;
470 CFDataRef data
= NULL
;
472 if (type_code
== typeFileURL
)
473 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
474 kCFStringEncodingUTF8
, NULL
);
481 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
485 size
= AEGetDescDataSize (&desc
);
486 buf
= xmalloc (size
);
487 err
= AEGetDescData (&desc
, buf
, size
);
489 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
490 kCFStringEncodingUTF8
, NULL
);
492 AEDisposeDesc (&desc
);
497 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
502 data
= CFStringCreateExternalRepresentation (NULL
, str
,
503 kCFStringEncodingUTF8
,
509 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
510 CFDataGetLength (data
), result
);
514 char file_name
[MAXPATHLEN
];
516 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
517 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
518 sizeof (file_name
) - 1);
524 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
527 #if TARGET_API_MAC_CARBON
528 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
530 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
533 err
= fsspec_to_posix_pathname (&fs
, file_name
,
534 sizeof (file_name
) - 1);
535 AEDisposeDesc (&desc
);
539 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
540 strlen (file_name
), result
);
547 return errAECoercionFail
;
552 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
553 const AEDesc
*from_desc
;
559 DescType from_type
= from_desc
->descriptorType
;
561 if (from_type
== typeNull
)
562 err
= errAECoercionFail
;
563 else if (from_type
== to_type
|| to_type
== typeWildCard
)
564 err
= AEDuplicateDesc (from_desc
, result
);
570 #if TARGET_API_MAC_CARBON
571 data_size
= AEGetDescDataSize (from_desc
);
573 data_size
= GetHandleSize (from_desc
->dataHandle
);
575 data_ptr
= xmalloc (data_size
);
576 #if TARGET_API_MAC_CARBON
577 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
579 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
582 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
584 handler_refcon
, result
);
589 return errAECoercionFail
;
594 init_coercion_handler ()
598 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
599 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
601 if (coerce_file_name_ptrUPP
== NULL
)
603 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
604 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
607 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
608 (AECoercionHandlerUPP
)
609 coerce_file_name_ptrUPP
, 0, false, false);
611 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
612 (AECoercionHandlerUPP
)
613 coerce_file_name_ptrUPP
, 0, false, false);
615 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
616 coerce_file_name_descUPP
, 0, true, false);
618 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
619 coerce_file_name_descUPP
, 0, true, false);
623 #if TARGET_API_MAC_CARBON
625 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
628 EventParamName
*names
;
629 EventParamType
*types
;
633 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
634 AEAddressDesc address_desc
;
640 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
641 sizeof (ProcessSerialNumber
), &address_desc
);
644 err
= AECreateAppleEvent (0, 0, /* Dummy class and ID. */
645 &address_desc
, /* NULL is not allowed
646 on Mac OS Classic. */
647 kAutoGenerateReturnID
,
648 kAnyTransactionID
, result
);
649 AEDisposeDesc (&address_desc
);
654 for (i
= 0; i
< num_params
; i
++)
658 case typeCFStringRef
:
659 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
660 sizeof (CFStringRef
), NULL
, &string
);
663 data
= CFStringCreateExternalRepresentation (NULL
, string
,
664 kCFStringEncodingUTF8
,
668 /* typeUTF8Text is not available on Mac OS X 10.1. */
669 AEPutParamPtr (result
, names
[i
], 'utf8',
670 CFDataGetBytePtr (data
), CFDataGetLength (data
));
676 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
680 buf
= xmalloc (size
);
681 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
684 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
694 /***********************************************************************
695 Conversion between Lisp and Core Foundation objects
696 ***********************************************************************/
698 #if TARGET_API_MAC_CARBON
699 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
700 static Lisp_Object Qarray
, Qdictionary
;
702 struct cfdict_context
705 int with_tag
, hash_bound
;
708 /* C string to CFString. */
711 cfstring_create_with_utf8_cstring (c_str
)
716 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
718 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
719 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
725 /* Lisp string to CFString. */
728 cfstring_create_with_string (s
)
731 CFStringRef string
= NULL
;
733 if (STRING_MULTIBYTE (s
))
735 char *p
, *end
= SDATA (s
) + SBYTES (s
);
737 for (p
= SDATA (s
); p
< end
; p
++)
740 s
= ENCODE_UTF_8 (s
);
743 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
744 kCFStringEncodingUTF8
, false);
748 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
749 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
750 kCFStringEncodingMacRoman
, false);
756 /* From CFData to a lisp string. Always returns a unibyte string. */
759 cfdata_to_lisp (data
)
762 CFIndex len
= CFDataGetLength (data
);
763 Lisp_Object result
= make_uninit_string (len
);
765 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
771 /* From CFString to a lisp string. Returns a unibyte string
772 containing a UTF-8 byte sequence. */
775 cfstring_to_lisp_nodecode (string
)
778 Lisp_Object result
= Qnil
;
779 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
782 result
= make_unibyte_string (s
, strlen (s
));
786 CFStringCreateExternalRepresentation (NULL
, string
,
787 kCFStringEncodingUTF8
, '?');
791 result
= cfdata_to_lisp (data
);
800 /* From CFString to a lisp string. Never returns a unibyte string
801 (even if it only contains ASCII characters).
802 This may cause GC during code conversion. */
805 cfstring_to_lisp (string
)
808 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
812 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
813 /* This may be superfluous. Just to make sure that the result
814 is a multibyte string. */
815 result
= string_to_multibyte (result
);
822 /* CFNumber to a lisp integer or a lisp float. */
825 cfnumber_to_lisp (number
)
828 Lisp_Object result
= Qnil
;
829 #if BITS_PER_EMACS_INT > 32
831 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
834 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
838 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
839 && !FIXNUM_OVERFLOW_P (int_val
))
840 result
= make_number (int_val
);
842 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
843 result
= make_float (float_val
);
848 /* CFDate to a list of three integers as in a return value of
852 cfdate_to_lisp (date
)
855 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
856 static CFAbsoluteTime epoch
= 0.0, sec
;
860 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
862 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
863 high
= sec
/ 65536.0;
864 low
= sec
- high
* 65536.0;
866 return list3 (make_number (high
), make_number (low
), make_number (0));
870 /* CFBoolean to a lisp symbol, `t' or `nil'. */
873 cfboolean_to_lisp (boolean
)
874 CFBooleanRef boolean
;
876 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
880 /* Any Core Foundation object to a (lengthy) lisp string. */
883 cfobject_desc_to_lisp (object
)
886 Lisp_Object result
= Qnil
;
887 CFStringRef desc
= CFCopyDescription (object
);
891 result
= cfstring_to_lisp (desc
);
899 /* Callback functions for cfproperty_list_to_lisp. */
902 cfdictionary_add_to_list (key
, value
, context
)
907 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
910 Fcons (Fcons (cfstring_to_lisp (key
),
911 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
917 cfdictionary_puthash (key
, value
, context
)
922 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
923 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
924 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
927 hash_lookup (h
, lisp_key
, &hash_code
);
928 hash_put (h
, lisp_key
,
929 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
934 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
935 non-zero, a symbol that represents the type of the original Core
936 Foundation object is prepended. HASH_BOUND specifies which kinds
937 of the lisp objects, alists or hash tables, are used as the targets
938 of the conversion from CFDictionary. If HASH_BOUND is negative,
939 always generate alists. If HASH_BOUND >= 0, generate an alist if
940 the number of keys in the dictionary is smaller than HASH_BOUND,
941 and a hash table otherwise. */
944 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
945 CFPropertyListRef plist
;
946 int with_tag
, hash_bound
;
948 CFTypeID type_id
= CFGetTypeID (plist
);
949 Lisp_Object tag
= Qnil
, result
= Qnil
;
950 struct gcpro gcpro1
, gcpro2
;
952 GCPRO2 (tag
, result
);
954 if (type_id
== CFStringGetTypeID ())
957 result
= cfstring_to_lisp (plist
);
959 else if (type_id
== CFNumberGetTypeID ())
962 result
= cfnumber_to_lisp (plist
);
964 else if (type_id
== CFBooleanGetTypeID ())
967 result
= cfboolean_to_lisp (plist
);
969 else if (type_id
== CFDateGetTypeID ())
972 result
= cfdate_to_lisp (plist
);
974 else if (type_id
== CFDataGetTypeID ())
977 result
= cfdata_to_lisp (plist
);
979 else if (type_id
== CFArrayGetTypeID ())
981 CFIndex index
, count
= CFArrayGetCount (plist
);
984 result
= Fmake_vector (make_number (count
), Qnil
);
985 for (index
= 0; index
< count
; index
++)
986 XVECTOR (result
)->contents
[index
] =
987 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
988 with_tag
, hash_bound
);
990 else if (type_id
== CFDictionaryGetTypeID ())
992 struct cfdict_context context
;
993 CFIndex count
= CFDictionaryGetCount (plist
);
996 context
.result
= &result
;
997 context
.with_tag
= with_tag
;
998 context
.hash_bound
= hash_bound
;
999 if (hash_bound
< 0 || count
< hash_bound
)
1002 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1007 result
= make_hash_table (Qequal
,
1008 make_number (count
),
1009 make_float (DEFAULT_REHASH_SIZE
),
1010 make_float (DEFAULT_REHASH_THRESHOLD
),
1012 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1022 result
= Fcons (tag
, result
);
1029 /***********************************************************************
1030 Emulation of the X Resource Manager
1031 ***********************************************************************/
1033 /* Parser functions for resource lines. Each function takes an
1034 address of a variable whose value points to the head of a string.
1035 The value will be advanced so that it points to the next character
1036 of the parsed part when the function returns.
1038 A resource name such as "Emacs*font" is parsed into a non-empty
1039 list called `quarks'. Each element is either a Lisp string that
1040 represents a concrete component, a Lisp symbol LOOSE_BINDING
1041 (actually Qlambda) that represents any number (>=0) of intervening
1042 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1043 that represents as any single component. */
1047 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1048 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1051 skip_white_space (p
)
1054 /* WhiteSpace = {<space> | <horizontal tab>} */
1055 while (*P
== ' ' || *P
== '\t')
1063 /* Comment = "!" {<any character except null or newline>} */
1076 /* Don't interpret filename. Just skip until the newline. */
1078 parse_include_file (p
)
1081 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1098 /* Binding = "." | "*" */
1099 if (*P
== '.' || *P
== '*')
1101 char binding
= *P
++;
1103 while (*P
== '.' || *P
== '*')
1116 /* Component = "?" | ComponentName
1117 ComponentName = NameChar {NameChar}
1118 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1122 return SINGLE_COMPONENT
;
1124 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1128 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1131 return make_unibyte_string (start
, P
- start
);
1138 parse_resource_name (p
)
1141 Lisp_Object result
= Qnil
, component
;
1144 /* ResourceName = [Binding] {Component Binding} ComponentName */
1145 if (parse_binding (p
) == '*')
1146 result
= Fcons (LOOSE_BINDING
, result
);
1148 component
= parse_component (p
);
1149 if (NILP (component
))
1152 result
= Fcons (component
, result
);
1153 while ((binding
= parse_binding (p
)) != '\0')
1156 result
= Fcons (LOOSE_BINDING
, result
);
1157 component
= parse_component (p
);
1158 if (NILP (component
))
1161 result
= Fcons (component
, result
);
1164 /* The final component should not be '?'. */
1165 if (EQ (component
, SINGLE_COMPONENT
))
1168 return Fnreverse (result
);
1176 Lisp_Object seq
= Qnil
, result
;
1177 int buf_len
, total_len
= 0, len
, continue_p
;
1179 q
= strchr (P
, '\n');
1180 buf_len
= q
? q
- P
: strlen (P
);
1181 buf
= xmalloc (buf_len
);
1194 else if (*P
== '\\')
1199 else if (*P
== '\n')
1210 else if ('0' <= P
[0] && P
[0] <= '7'
1211 && '0' <= P
[1] && P
[1] <= '7'
1212 && '0' <= P
[2] && P
[2] <= '7')
1214 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1224 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1229 q
= strchr (P
, '\n');
1230 len
= q
? q
- P
: strlen (P
);
1235 buf
= xmalloc (buf_len
);
1243 if (SBYTES (XCAR (seq
)) == total_len
)
1244 return make_string (SDATA (XCAR (seq
)), total_len
);
1247 buf
= xmalloc (total_len
);
1248 q
= buf
+ total_len
;
1249 for (; CONSP (seq
); seq
= XCDR (seq
))
1251 len
= SBYTES (XCAR (seq
));
1253 memcpy (q
, SDATA (XCAR (seq
)), len
);
1255 result
= make_string (buf
, total_len
);
1262 parse_resource_line (p
)
1265 Lisp_Object quarks
, value
;
1267 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1268 if (parse_comment (p
) || parse_include_file (p
))
1271 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1272 skip_white_space (p
);
1273 quarks
= parse_resource_name (p
);
1276 skip_white_space (p
);
1280 skip_white_space (p
);
1281 value
= parse_value (p
);
1282 return Fcons (quarks
, value
);
1285 /* Skip the remaining data as a dummy value. */
1292 /* Equivalents of X Resource Manager functions.
1294 An X Resource Database acts as a collection of resource names and
1295 associated values. It is implemented as a trie on quarks. Namely,
1296 each edge is labeled by either a string, LOOSE_BINDING, or
1297 SINGLE_COMPONENT. Each node has a node id, which is a unique
1298 nonnegative integer, and the root node id is 0. A database is
1299 implemented as a hash table that maps a pair (SRC-NODE-ID .
1300 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1301 in the table as a value for HASHKEY_MAX_NID. A value associated to
1302 a node is recorded as a value for the node id.
1304 A database also has a cache for past queries as a value for
1305 HASHKEY_QUERY_CACHE. It is another hash table that maps
1306 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1308 #define HASHKEY_MAX_NID (make_number (0))
1309 #define HASHKEY_QUERY_CACHE (make_number (-1))
1312 xrm_create_database ()
1314 XrmDatabase database
;
1316 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1317 make_float (DEFAULT_REHASH_SIZE
),
1318 make_float (DEFAULT_REHASH_THRESHOLD
),
1320 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1321 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1327 xrm_q_put_resource (database
, quarks
, value
)
1328 XrmDatabase database
;
1329 Lisp_Object quarks
, value
;
1331 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1334 Lisp_Object node_id
, key
;
1336 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1338 XSETINT (node_id
, 0);
1339 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1341 key
= Fcons (node_id
, XCAR (quarks
));
1342 i
= hash_lookup (h
, key
, &hash_code
);
1346 XSETINT (node_id
, max_nid
);
1347 hash_put (h
, key
, node_id
, hash_code
);
1350 node_id
= HASH_VALUE (h
, i
);
1352 Fputhash (node_id
, value
, database
);
1354 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1355 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1358 /* Merge multiple resource entries specified by DATA into a resource
1359 database DATABASE. DATA points to the head of a null-terminated
1360 string consisting of multiple resource lines. It's like a
1361 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1364 xrm_merge_string_database (database
, data
)
1365 XrmDatabase database
;
1368 Lisp_Object quarks_value
;
1372 quarks_value
= parse_resource_line (&data
);
1373 if (!NILP (quarks_value
))
1374 xrm_q_put_resource (database
,
1375 XCAR (quarks_value
), XCDR (quarks_value
));
1380 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1381 XrmDatabase database
;
1382 Lisp_Object node_id
, quark_name
, quark_class
;
1384 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1385 Lisp_Object key
, labels
[3], value
;
1388 if (!CONSP (quark_name
))
1389 return Fgethash (node_id
, database
, Qnil
);
1391 /* First, try tight bindings */
1392 labels
[0] = XCAR (quark_name
);
1393 labels
[1] = XCAR (quark_class
);
1394 labels
[2] = SINGLE_COMPONENT
;
1396 key
= Fcons (node_id
, Qnil
);
1397 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1399 XSETCDR (key
, labels
[k
]);
1400 i
= hash_lookup (h
, key
, NULL
);
1403 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1404 XCDR (quark_name
), XCDR (quark_class
));
1410 /* Then, try loose bindings */
1411 XSETCDR (key
, LOOSE_BINDING
);
1412 i
= hash_lookup (h
, key
, NULL
);
1415 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1416 quark_name
, quark_class
);
1420 return xrm_q_get_resource_1 (database
, node_id
,
1421 XCDR (quark_name
), XCDR (quark_class
));
1428 xrm_q_get_resource (database
, quark_name
, quark_class
)
1429 XrmDatabase database
;
1430 Lisp_Object quark_name
, quark_class
;
1432 return xrm_q_get_resource_1 (database
, make_number (0),
1433 quark_name
, quark_class
);
1436 /* Retrieve a resource value for the specified NAME and CLASS from the
1437 resource database DATABASE. It corresponds to XrmGetResource. */
1440 xrm_get_resource (database
, name
, class)
1441 XrmDatabase database
;
1444 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1446 struct Lisp_Hash_Table
*h
;
1450 nc
= strlen (class);
1451 key
= make_uninit_string (nn
+ nc
+ 1);
1452 strcpy (SDATA (key
), name
);
1453 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1455 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1456 if (NILP (query_cache
))
1458 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1459 make_float (DEFAULT_REHASH_SIZE
),
1460 make_float (DEFAULT_REHASH_THRESHOLD
),
1462 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1464 h
= XHASH_TABLE (query_cache
);
1465 i
= hash_lookup (h
, key
, &hash_code
);
1467 return HASH_VALUE (h
, i
);
1469 quark_name
= parse_resource_name (&name
);
1472 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1473 if (!STRINGP (XCAR (tmp
)))
1476 quark_class
= parse_resource_name (&class);
1479 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1480 if (!STRINGP (XCAR (tmp
)))
1487 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1488 hash_put (h
, key
, tmp
, hash_code
);
1493 #if TARGET_API_MAC_CARBON
1495 xrm_cfproperty_list_to_value (plist
)
1496 CFPropertyListRef plist
;
1498 CFTypeID type_id
= CFGetTypeID (plist
);
1500 if (type_id
== CFStringGetTypeID ())
1501 return cfstring_to_lisp (plist
);
1502 else if (type_id
== CFNumberGetTypeID ())
1505 Lisp_Object result
= Qnil
;
1507 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1510 result
= cfstring_to_lisp (string
);
1515 else if (type_id
== CFBooleanGetTypeID ())
1516 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1517 else if (type_id
== CFDataGetTypeID ())
1518 return cfdata_to_lisp (plist
);
1524 /* Create a new resource database from the preferences for the
1525 application APPLICATION. APPLICATION is either a string that
1526 specifies an application ID, or NULL that represents the current
1530 xrm_get_preference_database (application
)
1533 #if TARGET_API_MAC_CARBON
1534 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1535 CFMutableSetRef key_set
= NULL
;
1536 CFArrayRef key_array
;
1537 CFIndex index
, count
;
1539 XrmDatabase database
;
1540 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1541 CFPropertyListRef plist
;
1543 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1545 user_doms
[0] = kCFPreferencesCurrentUser
;
1546 user_doms
[1] = kCFPreferencesAnyUser
;
1547 host_doms
[0] = kCFPreferencesCurrentHost
;
1548 host_doms
[1] = kCFPreferencesAnyHost
;
1550 database
= xrm_create_database ();
1552 GCPRO3 (database
, quarks
, value
);
1556 app_id
= kCFPreferencesCurrentApplication
;
1559 app_id
= cfstring_create_with_utf8_cstring (application
);
1564 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1565 if (key_set
== NULL
)
1567 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1568 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1570 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1574 count
= CFArrayGetCount (key_array
);
1575 for (index
= 0; index
< count
; index
++)
1576 CFSetAddValue (key_set
,
1577 CFArrayGetValueAtIndex (key_array
, index
));
1578 CFRelease (key_array
);
1582 count
= CFSetGetCount (key_set
);
1583 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1584 CFSetGetValues (key_set
, (const void **)keys
);
1585 for (index
= 0; index
< count
; index
++)
1587 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1588 quarks
= parse_resource_name (&res_name
);
1589 if (!(NILP (quarks
) || *res_name
))
1591 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1592 value
= xrm_cfproperty_list_to_value (plist
);
1595 xrm_q_put_resource (database
, quarks
, value
);
1602 CFRelease (key_set
);
1611 return xrm_create_database ();
1618 /* The following functions with "sys_" prefix are stubs to Unix
1619 functions that have already been implemented by CW or MPW. The
1620 calls to them in Emacs source course are #define'd to call the sys_
1621 versions by the header files s-mac.h. In these stubs pathnames are
1622 converted between their Unix and Mac forms. */
1625 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1626 + 17 leap days. These are for adjusting time values returned by
1627 MacOS Toolbox functions. */
1629 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1632 #if __MSL__ < 0x6000
1633 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1634 a leap year! This is for adjusting time_t values returned by MSL
1636 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1637 #else /* __MSL__ >= 0x6000 */
1638 /* CW changes Pro 6 to follow Unix! */
1639 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1640 #endif /* __MSL__ >= 0x6000 */
1642 /* MPW library functions follow Unix (confused?). */
1643 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1644 #else /* not __MRC__ */
1646 #endif /* not __MRC__ */
1649 /* Define our own stat function for both MrC and CW. The reason for
1650 doing this: "stat" is both the name of a struct and function name:
1651 can't use the same trick like that for sys_open, sys_close, etc. to
1652 redirect Emacs's calls to our own version that converts Unix style
1653 filenames to Mac style filename because all sorts of compilation
1654 errors will be generated if stat is #define'd to be sys_stat. */
1657 stat_noalias (const char *path
, struct stat
*buf
)
1659 char mac_pathname
[MAXPATHLEN
+1];
1662 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1665 c2pstr (mac_pathname
);
1666 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1667 cipb
.hFileInfo
.ioVRefNum
= 0;
1668 cipb
.hFileInfo
.ioDirID
= 0;
1669 cipb
.hFileInfo
.ioFDirIndex
= 0;
1670 /* set to 0 to get information about specific dir or file */
1672 errno
= PBGetCatInfo (&cipb
, false);
1673 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1678 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1680 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1682 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1683 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1684 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1685 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1686 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1687 /* size of dir = number of files and dirs */
1690 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1691 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1695 buf
->st_mode
= S_IFREG
| S_IREAD
;
1696 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1697 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1698 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1699 buf
->st_mode
|= S_IEXEC
;
1700 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1701 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1702 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1705 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1706 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1709 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1711 /* identify alias files as symlinks */
1712 buf
->st_mode
&= ~S_IFREG
;
1713 buf
->st_mode
|= S_IFLNK
;
1717 buf
->st_uid
= getuid ();
1718 buf
->st_gid
= getgid ();
1726 lstat (const char *path
, struct stat
*buf
)
1729 char true_pathname
[MAXPATHLEN
+1];
1731 /* Try looking for the file without resolving aliases first. */
1732 if ((result
= stat_noalias (path
, buf
)) >= 0)
1735 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1738 return stat_noalias (true_pathname
, buf
);
1743 stat (const char *path
, struct stat
*sb
)
1746 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1749 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1750 ! (sb
->st_mode
& S_IFLNK
))
1753 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1756 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1759 fully_resolved_name
[len
] = '\0';
1760 /* in fact our readlink terminates strings */
1761 return lstat (fully_resolved_name
, sb
);
1764 return lstat (true_pathname
, sb
);
1769 /* CW defines fstat in stat.mac.c while MPW does not provide this
1770 function. Without the information of how to get from a file
1771 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1772 to implement this function. Fortunately, there is only one place
1773 where this function is called in our configuration: in fileio.c,
1774 where only the st_dev and st_ino fields are used to determine
1775 whether two fildes point to different i-nodes to prevent copying
1776 a file onto itself equal. What we have here probably needs
1780 fstat (int fildes
, struct stat
*buf
)
1783 buf
->st_ino
= fildes
;
1784 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1785 return 0; /* success */
1787 #endif /* __MRC__ */
1791 mkdir (const char *dirname
, int mode
)
1793 #pragma unused(mode)
1796 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1798 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1801 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1804 c2pstr (mac_pathname
);
1805 hfpb
.ioNamePtr
= mac_pathname
;
1806 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1807 hfpb
.ioDirID
= 0; /* parent is the root */
1809 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1810 /* just return the Mac OSErr code for now */
1811 return errno
== noErr
? 0 : -1;
1816 sys_rmdir (const char *dirname
)
1819 char mac_pathname
[MAXPATHLEN
+1];
1821 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1824 c2pstr (mac_pathname
);
1825 hfpb
.ioNamePtr
= mac_pathname
;
1826 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1827 hfpb
.ioDirID
= 0; /* parent is the root */
1829 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1830 return errno
== noErr
? 0 : -1;
1835 /* No implementation yet. */
1837 execvp (const char *path
, ...)
1841 #endif /* __MRC__ */
1845 utime (const char *path
, const struct utimbuf
*times
)
1847 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1849 char mac_pathname
[MAXPATHLEN
+1];
1852 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1855 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1857 fully_resolved_name
[len
] = '\0';
1859 strcpy (fully_resolved_name
, true_pathname
);
1861 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1864 c2pstr (mac_pathname
);
1865 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1866 cipb
.hFileInfo
.ioVRefNum
= 0;
1867 cipb
.hFileInfo
.ioDirID
= 0;
1868 cipb
.hFileInfo
.ioFDirIndex
= 0;
1869 /* set to 0 to get information about specific dir or file */
1871 errno
= PBGetCatInfo (&cipb
, false);
1875 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1878 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1880 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1885 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1887 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1890 errno
= PBSetCatInfo (&cipb
, false);
1891 return errno
== noErr
? 0 : -1;
1905 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1907 access (const char *path
, int mode
)
1909 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1911 char mac_pathname
[MAXPATHLEN
+1];
1914 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1917 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1919 fully_resolved_name
[len
] = '\0';
1921 strcpy (fully_resolved_name
, true_pathname
);
1923 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1926 c2pstr (mac_pathname
);
1927 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1928 cipb
.hFileInfo
.ioVRefNum
= 0;
1929 cipb
.hFileInfo
.ioDirID
= 0;
1930 cipb
.hFileInfo
.ioFDirIndex
= 0;
1931 /* set to 0 to get information about specific dir or file */
1933 errno
= PBGetCatInfo (&cipb
, false);
1937 if (mode
== F_OK
) /* got this far, file exists */
1941 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1945 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1952 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1953 /* don't allow if lock bit is on */
1959 #define DEV_NULL_FD 0x10000
1963 sys_open (const char *path
, int oflag
)
1965 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1967 char mac_pathname
[MAXPATHLEN
+1];
1969 if (strcmp (path
, "/dev/null") == 0)
1970 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1972 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1975 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1977 fully_resolved_name
[len
] = '\0';
1979 strcpy (fully_resolved_name
, true_pathname
);
1981 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1986 int res
= open (mac_pathname
, oflag
);
1987 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1988 if (oflag
& O_CREAT
)
1989 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1991 #else /* not __MRC__ */
1992 return open (mac_pathname
, oflag
);
1993 #endif /* not __MRC__ */
2000 sys_creat (const char *path
, mode_t mode
)
2002 char true_pathname
[MAXPATHLEN
+1];
2004 char mac_pathname
[MAXPATHLEN
+1];
2006 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2009 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2014 int result
= creat (mac_pathname
);
2015 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2017 #else /* not __MRC__ */
2018 return creat (mac_pathname
, mode
);
2019 #endif /* not __MRC__ */
2026 sys_unlink (const char *path
)
2028 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2030 char mac_pathname
[MAXPATHLEN
+1];
2032 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2035 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2037 fully_resolved_name
[len
] = '\0';
2039 strcpy (fully_resolved_name
, true_pathname
);
2041 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2044 return unlink (mac_pathname
);
2050 sys_read (int fildes
, char *buf
, int count
)
2052 if (fildes
== 0) /* this should not be used for console input */
2055 #if __MSL__ >= 0x6000
2056 return _read (fildes
, buf
, count
);
2058 return read (fildes
, buf
, count
);
2065 sys_write (int fildes
, const char *buf
, int count
)
2067 if (fildes
== DEV_NULL_FD
)
2070 #if __MSL__ >= 0x6000
2071 return _write (fildes
, buf
, count
);
2073 return write (fildes
, buf
, count
);
2080 sys_rename (const char * old_name
, const char * new_name
)
2082 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2083 char fully_resolved_old_name
[MAXPATHLEN
+1];
2085 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2087 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2090 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2092 fully_resolved_old_name
[len
] = '\0';
2094 strcpy (fully_resolved_old_name
, true_old_pathname
);
2096 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2099 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2102 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2107 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2110 /* If a file with new_name already exists, rename deletes the old
2111 file in Unix. CW version fails in these situation. So we add a
2112 call to unlink here. */
2113 (void) unlink (mac_new_name
);
2115 return rename (mac_old_name
, mac_new_name
);
2120 extern FILE *fopen (const char *name
, const char *mode
);
2122 sys_fopen (const char *name
, const char *mode
)
2124 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2126 char mac_pathname
[MAXPATHLEN
+1];
2128 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2131 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2133 fully_resolved_name
[len
] = '\0';
2135 strcpy (fully_resolved_name
, true_pathname
);
2137 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2142 if (mode
[0] == 'w' || mode
[0] == 'a')
2143 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2144 #endif /* not __MRC__ */
2145 return fopen (mac_pathname
, mode
);
2150 #include "keyboard.h"
2151 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2154 select (n
, rfds
, wfds
, efds
, timeout
)
2159 struct timeval
*timeout
;
2162 #if TARGET_API_MAC_CARBON
2163 EventTimeout timeout_sec
=
2165 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2166 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2167 : kEventDurationForever
);
2170 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2172 #else /* not TARGET_API_MAC_CARBON */
2174 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2175 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2177 /* Can only handle wait for keyboard input. */
2178 if (n
> 1 || wfds
|| efds
)
2181 /* Also return true if an event other than a keyDown has occurred.
2182 This causes kbd_buffer_get_event in keyboard.c to call
2183 read_avail_input which in turn calls XTread_socket to poll for
2184 these events. Otherwise these never get processed except but a
2185 very slow poll timer. */
2186 if (mac_wait_next_event (&e
, sleep_time
, false))
2189 err
= -9875; /* eventLoopTimedOutErr */
2190 #endif /* not TARGET_API_MAC_CARBON */
2192 if (FD_ISSET (0, rfds
))
2203 if (input_polling_used ())
2205 /* It could be confusing if a real alarm arrives while
2206 processing the fake one. Turn it off and let the
2207 handler reset it. */
2208 extern void poll_for_input_1
P_ ((void));
2209 int old_poll_suppress_count
= poll_suppress_count
;
2210 poll_suppress_count
= 1;
2211 poll_for_input_1 ();
2212 poll_suppress_count
= old_poll_suppress_count
;
2222 /* Simulation of SIGALRM. The stub for function signal stores the
2223 signal handler function in alarm_signal_func if a SIGALRM is
2227 #include "syssignal.h"
2229 static TMTask mac_atimer_task
;
2231 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2233 static int signal_mask
= 0;
2236 __sigfun alarm_signal_func
= (__sigfun
) 0;
2238 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2239 #else /* not __MRC__ and not __MWERKS__ */
2241 #endif /* not __MRC__ and not __MWERKS__ */
2245 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2247 sys_signal (int signal_num
, __sigfun signal_func
)
2249 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2251 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2252 #else /* not __MRC__ and not __MWERKS__ */
2254 #endif /* not __MRC__ and not __MWERKS__ */
2256 if (signal_num
!= SIGALRM
)
2257 return signal (signal_num
, signal_func
);
2261 __sigfun old_signal_func
;
2263 __signal_func_ptr old_signal_func
;
2267 old_signal_func
= alarm_signal_func
;
2268 alarm_signal_func
= signal_func
;
2269 return old_signal_func
;
2275 mac_atimer_handler (qlink
)
2278 if (alarm_signal_func
)
2279 (alarm_signal_func
) (SIGALRM
);
2284 set_mac_atimer (count
)
2287 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2289 if (mac_atimer_handlerUPP
== NULL
)
2290 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2291 mac_atimer_task
.tmCount
= 0;
2292 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2293 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2294 InsTime (mac_atimer_qlink
);
2296 PrimeTime (mac_atimer_qlink
, count
);
2301 remove_mac_atimer (remaining_count
)
2302 long *remaining_count
;
2304 if (mac_atimer_qlink
)
2306 RmvTime (mac_atimer_qlink
);
2307 if (remaining_count
)
2308 *remaining_count
= mac_atimer_task
.tmCount
;
2309 mac_atimer_qlink
= NULL
;
2321 int old_mask
= signal_mask
;
2323 signal_mask
|= mask
;
2325 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2326 remove_mac_atimer (NULL
);
2333 sigsetmask (int mask
)
2335 int old_mask
= signal_mask
;
2339 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2340 if (signal_mask
& sigmask (SIGALRM
))
2341 remove_mac_atimer (NULL
);
2343 set_mac_atimer (mac_atimer_task
.tmCount
);
2352 long remaining_count
;
2354 if (remove_mac_atimer (&remaining_count
) == 0)
2356 set_mac_atimer (seconds
* 1000);
2358 return remaining_count
/ 1000;
2362 mac_atimer_task
.tmCount
= seconds
* 1000;
2370 setitimer (which
, value
, ovalue
)
2372 const struct itimerval
*value
;
2373 struct itimerval
*ovalue
;
2375 long remaining_count
;
2376 long count
= (EMACS_SECS (value
->it_value
) * 1000
2377 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2379 if (remove_mac_atimer (&remaining_count
) == 0)
2383 bzero (ovalue
, sizeof (*ovalue
));
2384 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2385 (remaining_count
% 1000) * 1000);
2387 set_mac_atimer (count
);
2390 mac_atimer_task
.tmCount
= count
;
2396 /* gettimeofday should return the amount of time (in a timeval
2397 structure) since midnight today. The toolbox function Microseconds
2398 returns the number of microseconds (in a UnsignedWide value) since
2399 the machine was booted. Also making this complicated is WideAdd,
2400 WideSubtract, etc. take wide values. */
2407 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2408 UnsignedWide uw_microseconds
;
2409 wide w_microseconds
;
2410 time_t sys_time (time_t *);
2412 /* If this function is called for the first time, record the number
2413 of seconds since midnight and the number of microseconds since
2414 boot at the time of this first call. */
2419 systime
= sys_time (NULL
);
2420 /* Store microseconds since midnight in wall_clock_at_epoch. */
2421 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2422 Microseconds (&uw_microseconds
);
2423 /* Store microseconds since boot in clicks_at_epoch. */
2424 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2425 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2428 /* Get time since boot */
2429 Microseconds (&uw_microseconds
);
2431 /* Convert to time since midnight*/
2432 w_microseconds
.hi
= uw_microseconds
.hi
;
2433 w_microseconds
.lo
= uw_microseconds
.lo
;
2434 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2435 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2436 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2444 sleep (unsigned int seconds
)
2446 unsigned long time_up
;
2449 time_up
= TickCount () + seconds
* 60;
2450 while (TickCount () < time_up
)
2452 /* Accept no event; just wait. by T.I. */
2453 WaitNextEvent (0, &e
, 30, NULL
);
2458 #endif /* __MRC__ */
2461 /* The time functions adjust time values according to the difference
2462 between the Unix and CW epoches. */
2465 extern struct tm
*gmtime (const time_t *);
2467 sys_gmtime (const time_t *timer
)
2469 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2471 return gmtime (&unix_time
);
2476 extern struct tm
*localtime (const time_t *);
2478 sys_localtime (const time_t *timer
)
2480 #if __MSL__ >= 0x6000
2481 time_t unix_time
= *timer
;
2483 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2486 return localtime (&unix_time
);
2491 extern char *ctime (const time_t *);
2493 sys_ctime (const time_t *timer
)
2495 #if __MSL__ >= 0x6000
2496 time_t unix_time
= *timer
;
2498 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2501 return ctime (&unix_time
);
2506 extern time_t time (time_t *);
2508 sys_time (time_t *timer
)
2510 #if __MSL__ >= 0x6000
2511 time_t mac_time
= time (NULL
);
2513 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2523 /* no subprocesses, empty wait */
2533 croak (char *badfunc
)
2535 printf ("%s not yet implemented\r\n", badfunc
);
2541 mktemp (char *template)
2546 len
= strlen (template);
2548 while (k
>= 0 && template[k
] == 'X')
2551 k
++; /* make k index of first 'X' */
2555 /* Zero filled, number of digits equal to the number of X's. */
2556 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2565 /* Emulate getpwuid, getpwnam and others. */
2567 #define PASSWD_FIELD_SIZE 256
2569 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2570 static char my_passwd_dir
[MAXPATHLEN
+1];
2572 static struct passwd my_passwd
=
2578 static struct group my_group
=
2580 /* There are no groups on the mac, so we just return "root" as the
2586 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2588 char emacs_passwd_dir
[MAXPATHLEN
+1];
2594 init_emacs_passwd_dir ()
2598 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2600 /* Need pathname of first ancestor that begins with "emacs"
2601 since Mac emacs application is somewhere in the emacs-*
2603 int len
= strlen (emacs_passwd_dir
);
2605 /* j points to the "/" following the directory name being
2608 while (i
>= 0 && !found
)
2610 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2612 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2613 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2615 emacs_passwd_dir
[j
+1] = '\0';
2626 /* Setting to "/" probably won't work but set it to something
2628 strcpy (emacs_passwd_dir
, "/");
2629 strcpy (my_passwd_dir
, "/");
2634 static struct passwd emacs_passwd
=
2640 static int my_passwd_inited
= 0;
2648 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2649 directory where Emacs was started. */
2651 owner_name
= (char **) GetResource ('STR ',-16096);
2655 BlockMove ((unsigned char *) *owner_name
,
2656 (unsigned char *) my_passwd_name
,
2658 HUnlock (owner_name
);
2659 p2cstr ((unsigned char *) my_passwd_name
);
2662 my_passwd_name
[0] = 0;
2667 getpwuid (uid_t uid
)
2669 if (!my_passwd_inited
)
2672 my_passwd_inited
= 1;
2680 getgrgid (gid_t gid
)
2687 getpwnam (const char *name
)
2689 if (strcmp (name
, "emacs") == 0)
2690 return &emacs_passwd
;
2692 if (!my_passwd_inited
)
2695 my_passwd_inited
= 1;
2702 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2703 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2724 error ("Can't spawn subshell");
2729 request_sigio (void)
2735 unrequest_sigio (void)
2750 pipe (int _fildes
[2])
2757 /* Hard and symbolic links. */
2760 symlink (const char *name1
, const char *name2
)
2768 link (const char *name1
, const char *name2
)
2774 #endif /* ! MAC_OSX */
2776 /* Determine the path name of the file specified by VREFNUM, DIRID,
2777 and NAME and place that in the buffer PATH of length
2780 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2781 long dir_id
, ConstStr255Param name
)
2787 if (strlen (name
) > man_path_len
)
2790 memcpy (dir_name
, name
, name
[0]+1);
2791 memcpy (path
, name
, name
[0]+1);
2794 cipb
.dirInfo
.ioDrParID
= dir_id
;
2795 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2799 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2800 cipb
.dirInfo
.ioFDirIndex
= -1;
2801 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2802 /* go up to parent each time */
2804 err
= PBGetCatInfo (&cipb
, false);
2809 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2812 strcat (dir_name
, ":");
2813 strcat (dir_name
, path
);
2814 /* attach to front since we're going up directory tree */
2815 strcpy (path
, dir_name
);
2817 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2818 /* stop when we see the volume's root directory */
2820 return 1; /* success */
2827 posix_pathname_to_fsspec (ufn
, fs
)
2831 Str255 mac_pathname
;
2833 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2837 c2pstr (mac_pathname
);
2838 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2843 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2848 char mac_pathname
[MAXPATHLEN
];
2850 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2851 fs
->vRefNum
, fs
->parID
, fs
->name
)
2852 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2859 readlink (const char *path
, char *buf
, int bufsiz
)
2861 char mac_sym_link_name
[MAXPATHLEN
+1];
2864 Boolean target_is_folder
, was_aliased
;
2865 Str255 directory_name
, mac_pathname
;
2868 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2871 c2pstr (mac_sym_link_name
);
2872 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2879 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2880 if (err
!= noErr
|| !was_aliased
)
2886 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2893 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2899 return strlen (buf
);
2903 /* Convert a path to one with aliases fully expanded. */
2906 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2908 char *q
, temp
[MAXPATHLEN
+1];
2912 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2919 q
= strchr (p
+ 1, '/');
2921 q
= strchr (p
, '/');
2922 len
= 0; /* loop may not be entered, e.g., for "/" */
2927 strncat (temp
, p
, q
- p
);
2928 len
= readlink (temp
, buf
, bufsiz
);
2931 if (strlen (temp
) + 1 > bufsiz
)
2941 if (len
+ strlen (p
) + 1 >= bufsiz
)
2945 return len
+ strlen (p
);
2950 umask (mode_t numask
)
2952 static mode_t mask
= 022;
2953 mode_t oldmask
= mask
;
2960 chmod (const char *path
, mode_t mode
)
2962 /* say it always succeed for now */
2968 fchmod (int fd
, mode_t mode
)
2970 /* say it always succeed for now */
2976 fchown (int fd
, uid_t owner
, gid_t group
)
2978 /* say it always succeed for now */
2987 return fcntl (oldd
, F_DUPFD
, 0);
2989 /* current implementation of fcntl in fcntl.mac.c simply returns old
2991 return fcntl (oldd
, F_DUPFD
);
2998 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2999 newd if it already exists. Then, attempt to dup oldd. If not
3000 successful, call dup2 recursively until we are, then close the
3001 unsuccessful ones. */
3004 dup2 (int oldd
, int newd
)
3015 ret
= dup2 (oldd
, newd
);
3021 /* let it fail for now */
3038 ioctl (int d
, int request
, void *argp
)
3048 if (fildes
>=0 && fildes
<= 2)
3081 #endif /* __MRC__ */
3085 #if __MSL__ < 0x6000
3093 #endif /* __MWERKS__ */
3095 #endif /* ! MAC_OSX */
3098 /* Return the path to the directory in which Emacs can create
3099 temporary files. The MacOS "temporary items" directory cannot be
3100 used because it removes the file written by a process when it
3101 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3102 again not exactly). And of course Emacs needs to read back the
3103 files written by its subprocesses. So here we write the files to a
3104 directory "Emacs" in the Preferences Folder. This directory is
3105 created if it does not exist. */
3108 get_temp_dir_name ()
3110 static char *temp_dir_name
= NULL
;
3115 char unix_dir_name
[MAXPATHLEN
+1];
3118 /* Cache directory name with pointer temp_dir_name.
3119 Look for it only the first time. */
3122 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3123 &vol_ref_num
, &dir_id
);
3127 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3130 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3131 strcat (full_path
, "Emacs:");
3135 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3138 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3141 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3144 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3145 strcpy (temp_dir_name
, unix_dir_name
);
3148 return temp_dir_name
;
3153 /* Allocate and construct an array of pointers to strings from a list
3154 of strings stored in a 'STR#' resource. The returned pointer array
3155 is stored in the style of argv and environ: if the 'STR#' resource
3156 contains numString strings, a pointer array with numString+1
3157 elements is returned in which the last entry contains a null
3158 pointer. The pointer to the pointer array is passed by pointer in
3159 parameter t. The resource ID of the 'STR#' resource is passed in
3160 parameter StringListID.
3164 get_string_list (char ***t
, short string_list_id
)
3170 h
= GetResource ('STR#', string_list_id
);
3175 num_strings
= * (short *) p
;
3177 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3178 for (i
= 0; i
< num_strings
; i
++)
3180 short length
= *p
++;
3181 (*t
)[i
] = (char *) malloc (length
+ 1);
3182 strncpy ((*t
)[i
], p
, length
);
3183 (*t
)[i
][length
] = '\0';
3186 (*t
)[num_strings
] = 0;
3191 /* Return no string in case GetResource fails. Bug fixed by
3192 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3193 option (no sym -on implies -opt local). */
3194 *t
= (char **) malloc (sizeof (char *));
3201 get_path_to_system_folder ()
3207 static char system_folder_unix_name
[MAXPATHLEN
+1];
3210 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3211 &vol_ref_num
, &dir_id
);
3215 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3218 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3222 return system_folder_unix_name
;
3228 #define ENVIRON_STRING_LIST_ID 128
3230 /* Get environment variable definitions from STR# resource. */
3237 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3243 /* Make HOME directory the one Emacs starts up in if not specified
3245 if (getenv ("HOME") == NULL
)
3247 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3250 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3253 strcpy (environ
[i
], "HOME=");
3254 strcat (environ
[i
], my_passwd_dir
);
3261 /* Make HOME directory the one Emacs starts up in if not specified
3263 if (getenv ("MAIL") == NULL
)
3265 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3268 char * path_to_system_folder
= get_path_to_system_folder ();
3269 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3272 strcpy (environ
[i
], "MAIL=");
3273 strcat (environ
[i
], path_to_system_folder
);
3274 strcat (environ
[i
], "Eudora Folder/In");
3282 /* Return the value of the environment variable NAME. */
3285 getenv (const char *name
)
3287 int length
= strlen(name
);
3290 for (e
= environ
; *e
!= 0; e
++)
3291 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3292 return &(*e
)[length
+ 1];
3294 if (strcmp (name
, "TMPDIR") == 0)
3295 return get_temp_dir_name ();
3302 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3303 char *sys_siglist
[] =
3305 "Zero is not a signal!!!",
3307 "Interactive user interrupt", /* 2 */ "?",
3308 "Floating point exception", /* 4 */ "?", "?", "?",
3309 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3310 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3311 "?", "?", "?", "?", "?", "?", "?", "?",
3315 char *sys_siglist
[] =
3317 "Zero is not a signal!!!",
3319 "Floating point exception",
3320 "Illegal instruction",
3321 "Interactive user interrupt",
3322 "Segment violation",
3325 #else /* not __MRC__ and not __MWERKS__ */
3327 #endif /* not __MRC__ and not __MWERKS__ */
3330 #include <utsname.h>
3333 uname (struct utsname
*name
)
3336 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3339 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3340 p2cstr (name
->nodename
);
3348 /* Event class of HLE sent to subprocess. */
3349 const OSType kEmacsSubprocessSend
= 'ESND';
3351 /* Event class of HLE sent back from subprocess. */
3352 const OSType kEmacsSubprocessReply
= 'ERPY';
3356 mystrchr (char *s
, char c
)
3358 while (*s
&& *s
!= c
)
3386 mystrcpy (char *to
, char *from
)
3398 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3399 terminated). The process should run with the default directory
3400 "workdir", read input from "infn", and write output and error to
3401 "outfn" and "errfn", resp. The Process Manager call
3402 LaunchApplication is used to start the subprocess. We use high
3403 level events as the mechanism to pass arguments to the subprocess
3404 and to make Emacs wait for the subprocess to terminate and pass
3405 back a result code. The bulk of the code here packs the arguments
3406 into one message to be passed together with the high level event.
3407 Emacs also sometimes starts a subprocess using a shell to perform
3408 wildcard filename expansion. Since we don't really have a shell on
3409 the Mac, this case is detected and the starting of the shell is
3410 by-passed. We really need to add code here to do filename
3411 expansion to support such functionality.
3413 We can't use this strategy in Carbon because the High Level Event
3414 APIs are not available. */
3417 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3418 unsigned char **argv
;
3419 const char *workdir
;
3420 const char *infn
, *outfn
, *errfn
;
3422 #if TARGET_API_MAC_CARBON
3424 #else /* not TARGET_API_MAC_CARBON */
3425 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3426 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3427 int paramlen
, argc
, newargc
, j
, retries
;
3428 char **newargv
, *param
, *p
;
3431 LaunchParamBlockRec lpbr
;
3432 EventRecord send_event
, reply_event
;
3433 RgnHandle cursor_region_handle
;
3435 unsigned long ref_con
, len
;
3437 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3439 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3441 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3443 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3446 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3447 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3456 /* If a subprocess is invoked with a shell, we receive 3 arguments
3457 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3458 bins>/<command> <command args>" */
3459 j
= strlen (argv
[0]);
3460 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3461 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3463 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3465 /* The arguments for the command in argv[2] are separated by
3466 spaces. Count them and put the count in newargc. */
3467 command
= (char *) alloca (strlen (argv
[2])+2);
3468 strcpy (command
, argv
[2]);
3469 if (command
[strlen (command
) - 1] != ' ')
3470 strcat (command
, " ");
3474 t
= mystrchr (t
, ' ');
3478 t
= mystrchr (t
+1, ' ');
3481 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3484 for (j
= 0; j
< newargc
; j
++)
3486 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3487 mystrcpy (newargv
[j
], t
);
3490 paramlen
+= strlen (newargv
[j
]) + 1;
3493 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3495 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3500 { /* sometimes Emacs call "sh" without a path for the command */
3502 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3503 strcpy (t
, "~emacs/");
3504 strcat (t
, newargv
[0]);
3507 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3508 make_number (X_OK
));
3512 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3516 strcpy (macappname
, tempmacpathname
);
3520 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3523 newargv
= (char **) alloca (sizeof (char *) * argc
);
3525 for (j
= 1; j
< argc
; j
++)
3527 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3529 char *t
= strchr (argv
[j
], ' ');
3532 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3533 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3534 tempcmdname
[t
-argv
[j
]] = '\0';
3535 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3538 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3540 strcpy (newargv
[j
], tempmaccmdname
);
3541 strcat (newargv
[j
], t
);
3545 char tempmaccmdname
[MAXPATHLEN
+1];
3546 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3549 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3550 strcpy (newargv
[j
], tempmaccmdname
);
3554 newargv
[j
] = argv
[j
];
3555 paramlen
+= strlen (newargv
[j
]) + 1;
3559 /* After expanding all the arguments, we now know the length of the
3560 parameter block to be sent to the subprocess as a message
3561 attached to the HLE. */
3562 param
= (char *) malloc (paramlen
+ 1);
3568 /* first byte of message contains number of arguments for command */
3569 strcpy (p
, macworkdir
);
3570 p
+= strlen (macworkdir
);
3572 /* null terminate strings sent so it's possible to use strcpy over there */
3573 strcpy (p
, macinfn
);
3574 p
+= strlen (macinfn
);
3576 strcpy (p
, macoutfn
);
3577 p
+= strlen (macoutfn
);
3579 strcpy (p
, macerrfn
);
3580 p
+= strlen (macerrfn
);
3582 for (j
= 1; j
< newargc
; j
++)
3584 strcpy (p
, newargv
[j
]);
3585 p
+= strlen (newargv
[j
]);
3589 c2pstr (macappname
);
3591 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3599 lpbr
.launchBlockID
= extendedBlock
;
3600 lpbr
.launchEPBLength
= extendedBlockLen
;
3601 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3602 lpbr
.launchAppSpec
= &spec
;
3603 lpbr
.launchAppParameters
= NULL
;
3605 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3612 send_event
.what
= kHighLevelEvent
;
3613 send_event
.message
= kEmacsSubprocessSend
;
3614 /* Event ID stored in "where" unused */
3617 /* OS may think current subprocess has terminated if previous one
3618 terminated recently. */
3621 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3622 paramlen
+ 1, receiverIDisPSN
);
3624 while (iErr
== sessClosedErr
&& retries
-- > 0);
3632 cursor_region_handle
= NewRgn ();
3634 /* Wait for the subprocess to finish, when it will send us a ERPY
3635 high level event. */
3637 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3638 cursor_region_handle
)
3639 && reply_event
.message
== kEmacsSubprocessReply
)
3642 /* The return code is sent through the refCon */
3643 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3646 DisposeHandle ((Handle
) cursor_region_handle
);
3651 DisposeHandle ((Handle
) cursor_region_handle
);
3655 #endif /* not TARGET_API_MAC_CARBON */
3660 opendir (const char *dirname
)
3662 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3663 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3667 int len
, vol_name_len
;
3669 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3672 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3674 fully_resolved_name
[len
] = '\0';
3676 strcpy (fully_resolved_name
, true_pathname
);
3678 dirp
= (DIR *) malloc (sizeof(DIR));
3682 /* Handle special case when dirname is "/": sets up for readir to
3683 get all mount volumes. */
3684 if (strcmp (fully_resolved_name
, "/") == 0)
3686 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3687 dirp
->current_index
= 1; /* index for first volume */
3691 /* Handle typical cases: not accessing all mounted volumes. */
3692 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3695 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3696 len
= strlen (mac_pathname
);
3697 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3698 strcat (mac_pathname
, ":");
3700 /* Extract volume name */
3701 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3702 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3703 vol_name
[vol_name_len
] = '\0';
3704 strcat (vol_name
, ":");
3706 c2pstr (mac_pathname
);
3707 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3708 /* using full pathname so vRefNum and DirID ignored */
3709 cipb
.hFileInfo
.ioVRefNum
= 0;
3710 cipb
.hFileInfo
.ioDirID
= 0;
3711 cipb
.hFileInfo
.ioFDirIndex
= 0;
3712 /* set to 0 to get information about specific dir or file */
3714 errno
= PBGetCatInfo (&cipb
, false);
3721 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3722 return 0; /* not a directory */
3724 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3725 dirp
->getting_volumes
= 0;
3726 dirp
->current_index
= 1; /* index for first file/directory */
3729 vpb
.ioNamePtr
= vol_name
;
3730 /* using full pathname so vRefNum and DirID ignored */
3732 vpb
.ioVolIndex
= -1;
3733 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3740 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3757 HParamBlockRec hpblock
;
3759 static struct dirent s_dirent
;
3760 static Str255 s_name
;
3764 /* Handle the root directory containing the mounted volumes. Call
3765 PBHGetVInfo specifying an index to obtain the info for a volume.
3766 PBHGetVInfo returns an error when it receives an index beyond the
3767 last volume, at which time we should return a nil dirent struct
3769 if (dp
->getting_volumes
)
3771 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3772 hpblock
.volumeParam
.ioVRefNum
= 0;
3773 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3775 errno
= PBHGetVInfo (&hpblock
, false);
3783 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3785 dp
->current_index
++;
3787 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3788 s_dirent
.d_name
= s_name
;
3794 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3795 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3796 /* location to receive filename returned */
3798 /* return only visible files */
3802 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3803 /* directory ID found by opendir */
3804 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3806 errno
= PBGetCatInfo (&cipb
, false);
3813 /* insist on a visible entry */
3814 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3815 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3817 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3819 dp
->current_index
++;
3832 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3833 /* value unimportant: non-zero for valid file */
3834 s_dirent
.d_name
= s_name
;
3844 char mac_pathname
[MAXPATHLEN
+1];
3845 Str255 directory_name
;
3849 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3852 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3858 #endif /* ! MAC_OSX */
3862 initialize_applescript ()
3867 /* if open fails, as_scripting_component is set to NULL. Its
3868 subsequent use in OSA calls will fail with badComponentInstance
3870 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3871 kAppleScriptSubtype
);
3873 null_desc
.descriptorType
= typeNull
;
3874 null_desc
.dataHandle
= 0;
3875 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3876 kOSANullScript
, &as_script_context
);
3878 as_script_context
= kOSANullScript
;
3879 /* use default context if create fails */
3884 terminate_applescript()
3886 OSADispose (as_scripting_component
, as_script_context
);
3887 CloseComponent (as_scripting_component
);
3890 /* Convert a lisp string to the 4 byte character code. */
3893 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3902 /* check type string */
3904 if (SBYTES (arg
) != 4)
3906 error ("Wrong argument: need string of length 4 for code");
3908 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3913 /* Convert the 4 byte character code into a 4 byte string. */
3916 mac_get_object_from_code(OSType defCode
)
3918 UInt32 code
= EndianU32_NtoB (defCode
);
3920 return make_unibyte_string ((char *)&code
, 4);
3924 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3925 doc
: /* Get the creator code of FILENAME as a four character string. */)
3927 Lisp_Object filename
;
3935 Lisp_Object result
= Qnil
;
3936 CHECK_STRING (filename
);
3938 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3941 filename
= Fexpand_file_name (filename
, Qnil
);
3945 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3947 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3950 if (status
== noErr
)
3953 FSCatalogInfo catalogInfo
;
3955 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
3956 &catalogInfo
, NULL
, NULL
, NULL
);
3960 status
= FSpGetFInfo (&fss
, &finder_info
);
3962 if (status
== noErr
)
3965 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
3967 result
= mac_get_object_from_code (finder_info
.fdCreator
);
3972 if (status
!= noErr
) {
3973 error ("Error while getting file information.");
3978 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
3979 doc
: /* Get the type code of FILENAME as a four character string. */)
3981 Lisp_Object filename
;
3989 Lisp_Object result
= Qnil
;
3990 CHECK_STRING (filename
);
3992 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3995 filename
= Fexpand_file_name (filename
, Qnil
);
3999 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4001 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4004 if (status
== noErr
)
4007 FSCatalogInfo catalogInfo
;
4009 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4010 &catalogInfo
, NULL
, NULL
, NULL
);
4014 status
= FSpGetFInfo (&fss
, &finder_info
);
4016 if (status
== noErr
)
4019 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4021 result
= mac_get_object_from_code (finder_info
.fdType
);
4026 if (status
!= noErr
) {
4027 error ("Error while getting file information.");
4032 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4033 doc
: /* Set creator code of file FILENAME to CODE.
4034 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4035 assumed. Return non-nil if successful. */)
4037 Lisp_Object filename
, code
;
4046 CHECK_STRING (filename
);
4048 cCode
= mac_get_code_from_arg(code
, 'EMAx');
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
, &parentDir
);
4072 status
= FSpGetFInfo (&fss
, &finder_info
);
4074 if (status
== noErr
)
4077 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4078 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4079 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4081 finder_info
.fdCreator
= cCode
;
4082 status
= FSpSetFInfo (&fss
, &finder_info
);
4087 if (status
!= noErr
) {
4088 error ("Error while setting creator information.");
4093 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4094 doc
: /* Set file code of file FILENAME to CODE.
4095 CODE must be a 4-character string. Return non-nil if successful. */)
4097 Lisp_Object filename
, code
;
4106 CHECK_STRING (filename
);
4108 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4110 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4113 filename
= Fexpand_file_name (filename
, Qnil
);
4117 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4119 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4122 if (status
== noErr
)
4125 FSCatalogInfo catalogInfo
;
4127 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4128 &catalogInfo
, NULL
, NULL
, &parentDir
);
4132 status
= FSpGetFInfo (&fss
, &finder_info
);
4134 if (status
== noErr
)
4137 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4138 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4139 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4141 finder_info
.fdType
= cCode
;
4142 status
= FSpSetFInfo (&fss
, &finder_info
);
4147 if (status
!= noErr
) {
4148 error ("Error while setting creator information.");
4154 /* Compile and execute the AppleScript SCRIPT and return the error
4155 status as function value. A zero is returned if compilation and
4156 execution is successful, in which case *RESULT is set to a Lisp
4157 string containing the resulting script value. Otherwise, the Mac
4158 error code is returned and *RESULT is set to an error Lisp string.
4159 For documentation on the MacOS scripting architecture, see Inside
4160 Macintosh - Interapplication Communications: Scripting
4164 do_applescript (script
, result
)
4165 Lisp_Object script
, *result
;
4167 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4173 if (!as_scripting_component
)
4174 initialize_applescript();
4176 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4181 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4182 typeChar
, kOSAModeNull
, &result_desc
);
4184 if (osaerror
== noErr
)
4185 /* success: retrieve resulting script value */
4186 desc
= &result_desc
;
4187 else if (osaerror
== errOSAScriptError
)
4188 /* error executing AppleScript: retrieve error message */
4189 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4195 #if TARGET_API_MAC_CARBON
4196 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4197 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4198 #else /* not TARGET_API_MAC_CARBON */
4199 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4200 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4201 #endif /* not TARGET_API_MAC_CARBON */
4202 AEDisposeDesc (desc
);
4205 AEDisposeDesc (&script_desc
);
4211 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4212 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4213 If compilation and execution are successful, the resulting script
4214 value is returned as a string. Otherwise the function aborts and
4215 displays the error message returned by the AppleScript scripting
4223 CHECK_STRING (script
);
4226 status
= do_applescript (script
, &result
);
4230 else if (!STRINGP (result
))
4231 error ("AppleScript error %d", status
);
4233 error ("%s", SDATA (result
));
4237 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4238 Smac_file_name_to_posix
, 1, 1, 0,
4239 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4241 Lisp_Object filename
;
4243 char posix_filename
[MAXPATHLEN
+1];
4245 CHECK_STRING (filename
);
4247 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4248 return build_string (posix_filename
);
4254 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4255 Sposix_file_name_to_mac
, 1, 1, 0,
4256 doc
: /* Convert Posix FILENAME to Mac form. */)
4258 Lisp_Object filename
;
4260 char mac_filename
[MAXPATHLEN
+1];
4262 CHECK_STRING (filename
);
4264 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4265 return build_string (mac_filename
);
4271 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4272 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4273 Each type should be a string of length 4 or the symbol
4274 `undecoded-file-name'. */)
4275 (src_type
, src_data
, dst_type
)
4276 Lisp_Object src_type
, src_data
, dst_type
;
4279 Lisp_Object result
= Qnil
;
4280 DescType src_desc_type
, dst_desc_type
;
4283 CHECK_STRING (src_data
);
4284 if (EQ (src_type
, Qundecoded_file_name
))
4285 src_desc_type
= TYPE_FILE_NAME
;
4287 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4289 if (EQ (dst_type
, Qundecoded_file_name
))
4290 dst_desc_type
= TYPE_FILE_NAME
;
4292 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4295 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4296 dst_desc_type
, &dst_desc
);
4299 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4300 AEDisposeDesc (&dst_desc
);
4308 #if TARGET_API_MAC_CARBON
4309 static Lisp_Object Qxml
, Qmime_charset
;
4310 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4312 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4313 doc
: /* Return the application preference value for KEY.
4314 KEY is either a string specifying a preference key, or a list of key
4315 strings. If it is a list, the (i+1)-th element is used as a key for
4316 the CFDictionary value obtained by the i-th element. Return nil if
4317 lookup is failed at some stage.
4319 Optional arg APPLICATION is an application ID string. If omitted or
4320 nil, that stands for the current application.
4322 Optional arg FORMAT specifies the data format of the return value. If
4323 omitted or nil, each Core Foundation object is converted into a
4324 corresponding Lisp object as follows:
4326 Core Foundation Lisp Tag
4327 ------------------------------------------------------------
4328 CFString Multibyte string string
4329 CFNumber Integer or float number
4330 CFBoolean Symbol (t or nil) boolean
4331 CFDate List of three integers date
4332 (cf. `current-time')
4333 CFData Unibyte string data
4334 CFArray Vector array
4335 CFDictionary Alist or hash table dictionary
4336 (depending on HASH-BOUND)
4338 If it is t, a symbol that represents the type of the original Core
4339 Foundation object is prepended. If it is `xml', the value is returned
4340 as an XML representation.
4342 Optional arg HASH-BOUND specifies which kinds of the list objects,
4343 alists or hash tables, are used as the targets of the conversion from
4344 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4345 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4346 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4348 (key
, application
, format
, hash_bound
)
4349 Lisp_Object key
, application
, format
, hash_bound
;
4351 CFStringRef app_id
, key_str
;
4352 CFPropertyListRef app_plist
= NULL
, plist
;
4353 Lisp_Object result
= Qnil
, tmp
;
4356 key
= Fcons (key
, Qnil
);
4360 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4361 CHECK_STRING_CAR (tmp
);
4363 wrong_type_argument (Qlistp
, key
);
4365 if (!NILP (application
))
4366 CHECK_STRING (application
);
4367 CHECK_SYMBOL (format
);
4368 if (!NILP (hash_bound
))
4369 CHECK_NUMBER (hash_bound
);
4373 app_id
= kCFPreferencesCurrentApplication
;
4374 if (!NILP (application
))
4376 app_id
= cfstring_create_with_string (application
);
4380 key_str
= cfstring_create_with_string (XCAR (key
));
4381 if (key_str
== NULL
)
4383 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4384 CFRelease (key_str
);
4385 if (app_plist
== NULL
)
4389 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4391 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4393 key_str
= cfstring_create_with_string (XCAR (key
));
4394 if (key_str
== NULL
)
4396 plist
= CFDictionaryGetValue (plist
, key_str
);
4397 CFRelease (key_str
);
4404 if (EQ (format
, Qxml
))
4406 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4409 result
= cfdata_to_lisp (data
);
4414 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4415 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4420 CFRelease (app_plist
);
4429 static CFStringEncoding
4430 get_cfstring_encoding_from_lisp (obj
)
4433 CFStringRef iana_name
;
4434 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4437 return kCFStringEncodingUnicode
;
4442 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4444 Lisp_Object coding_spec
, plist
;
4446 coding_spec
= Fget (obj
, Qcoding_system
);
4447 plist
= XVECTOR (coding_spec
)->contents
[3];
4448 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4452 obj
= SYMBOL_NAME (obj
);
4456 iana_name
= cfstring_create_with_string (obj
);
4459 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4460 CFRelease (iana_name
);
4467 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4469 cfstring_create_normalized (str
, symbol
)
4474 TextEncodingVariant variant
;
4475 float initial_mag
= 0.0;
4476 CFStringRef result
= NULL
;
4478 if (EQ (symbol
, QNFD
))
4479 form
= kCFStringNormalizationFormD
;
4480 else if (EQ (symbol
, QNFKD
))
4481 form
= kCFStringNormalizationFormKD
;
4482 else if (EQ (symbol
, QNFC
))
4483 form
= kCFStringNormalizationFormC
;
4484 else if (EQ (symbol
, QNFKC
))
4485 form
= kCFStringNormalizationFormKC
;
4486 else if (EQ (symbol
, QHFS_plus_D
))
4488 variant
= kUnicodeHFSPlusDecompVariant
;
4491 else if (EQ (symbol
, QHFS_plus_C
))
4493 variant
= kUnicodeHFSPlusCompVariant
;
4499 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4503 CFStringNormalize (mut_str
, form
);
4507 else if (initial_mag
> 0.0)
4509 UnicodeToTextInfo uni
= NULL
;
4512 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4514 ByteCount out_read
, out_size
, out_len
;
4516 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4518 kTextEncodingDefaultFormat
);
4519 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4521 kTextEncodingDefaultFormat
);
4522 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4524 length
= CFStringGetLength (str
);
4525 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4529 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4530 if (in_text
== NULL
)
4532 buffer
= xmalloc (sizeof (UniChar
) * length
);
4533 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4538 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4539 while (err
== noErr
)
4541 out_buf
= xmalloc (out_size
);
4542 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4544 kUnicodeDefaultDirectionMask
,
4545 0, NULL
, NULL
, NULL
,
4546 out_size
, &out_read
, &out_len
,
4548 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4557 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4558 out_len
/ sizeof (UniChar
));
4560 DisposeUnicodeToTextInfo (&uni
);
4576 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4577 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4578 The conversion is performed using the converter provided by the system.
4579 Each encoding is specified by either a coding system symbol, a mime
4580 charset string, or an integer as a CFStringEncoding value. Nil for
4581 encoding means UTF-16 in native byte order, no byte order mark.
4582 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4583 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4584 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4585 On successful conversion, return the result string, else return nil. */)
4586 (string
, source
, target
, normalization_form
)
4587 Lisp_Object string
, source
, target
, normalization_form
;
4589 Lisp_Object result
= Qnil
;
4590 CFStringEncoding src_encoding
, tgt_encoding
;
4591 CFStringRef str
= NULL
;
4593 CHECK_STRING (string
);
4594 if (!INTEGERP (source
) && !STRINGP (source
))
4595 CHECK_SYMBOL (source
);
4596 if (!INTEGERP (target
) && !STRINGP (target
))
4597 CHECK_SYMBOL (target
);
4598 CHECK_SYMBOL (normalization_form
);
4602 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4603 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4605 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4606 use string_as_unibyte which works as well, except for the fact that
4607 it's too permissive (it doesn't check that the multibyte string only
4608 contain single-byte chars). */
4609 string
= Fstring_as_unibyte (string
);
4610 if (src_encoding
!= kCFStringEncodingInvalidId
4611 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4612 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4613 src_encoding
, !NILP (source
));
4614 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4617 CFStringRef saved_str
= str
;
4619 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4620 CFRelease (saved_str
);
4625 CFIndex str_len
, buf_len
;
4627 str_len
= CFStringGetLength (str
);
4628 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4629 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4631 result
= make_uninit_string (buf_len
);
4632 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4633 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4642 #endif /* TARGET_API_MAC_CARBON */
4645 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4646 doc
: /* Clear the font name table. */)
4650 mac_clear_font_name_table ();
4656 mac_get_system_locale ()
4664 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4665 region
= GetScriptManagerVariable (smRegionCode
);
4666 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4668 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4671 return build_string (str
);
4679 extern int inhibit_window_system
;
4680 extern int noninteractive
;
4682 /* Unlike in X11, window events in Carbon do not come from sockets.
4683 So we cannot simply use `select' to monitor two kinds of inputs:
4684 window events and process outputs. We emulate such functionality
4685 by regarding fd 0 as the window event channel and simultaneously
4686 monitoring both kinds of input channels. It is implemented by
4687 dividing into some cases:
4688 1. The window event channel is not involved.
4690 2. Sockets are not involved.
4691 -> Use ReceiveNextEvent.
4692 3. [If SELECT_USE_CFSOCKET is defined]
4693 Only the window event channel and socket read channels are
4694 involved, and timeout is not too short (greater than
4695 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4696 -> Create CFSocket for each socket and add it into the current
4697 event RunLoop so that a `ready-to-read' event can be posted
4698 to the event queue that is also used for window events. Then
4699 ReceiveNextEvent can wait for both kinds of inputs.
4701 -> Periodically poll the window input channel while repeatedly
4702 executing `select' with a short timeout
4703 (SELECT_POLLING_PERIOD_USEC microseconds). */
4705 #define SELECT_POLLING_PERIOD_USEC 20000
4706 #ifdef SELECT_USE_CFSOCKET
4707 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4708 #define EVENT_CLASS_SOCK 'Sock'
4711 socket_callback (s
, type
, address
, data
, info
)
4713 CFSocketCallBackType type
;
4720 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4721 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4722 ReleaseEvent (event
);
4724 #endif /* SELECT_USE_CFSOCKET */
4727 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4732 struct timeval
*timeout
;
4737 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4741 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4742 kEventLeaveInQueue
, NULL
);
4753 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4754 #undef SELECT_INVALIDATE_CFSOCKET
4758 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4763 struct timeval
*timeout
;
4767 EMACS_TIME select_timeout
;
4769 if (inhibit_window_system
|| noninteractive
4770 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4771 return select (n
, rfds
, wfds
, efds
, timeout
);
4775 if (wfds
== NULL
&& efds
== NULL
)
4778 SELECT_TYPE orfds
= *rfds
;
4780 EventTimeout timeout_sec
=
4782 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4783 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4784 : kEventDurationForever
);
4786 for (i
= 1; i
< n
; i
++)
4787 if (FD_ISSET (i
, rfds
))
4793 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4794 kEventLeaveInQueue
, NULL
);
4806 mac_prepare_for_quickdraw (NULL
);
4808 /* Avoid initial overhead of RunLoop setup for the case that
4809 some input is already available. */
4810 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4811 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4812 if (r
!= 0 || timeout_sec
== 0.0)
4817 #ifdef SELECT_USE_CFSOCKET
4818 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4819 goto poll_periodically
;
4822 CFRunLoopRef runloop
=
4823 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4824 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4825 #ifdef SELECT_INVALIDATE_CFSOCKET
4826 CFSocketRef
*shead
, *s
;
4828 CFRunLoopSourceRef
*shead
, *s
;
4833 #ifdef SELECT_INVALIDATE_CFSOCKET
4834 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4836 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4839 for (i
= 1; i
< n
; i
++)
4840 if (FD_ISSET (i
, rfds
))
4842 CFSocketRef socket
=
4843 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4844 socket_callback
, NULL
);
4845 CFRunLoopSourceRef source
=
4846 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4848 #ifdef SELECT_INVALIDATE_CFSOCKET
4849 CFSocketSetSocketFlags (socket
, 0);
4851 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4852 #ifdef SELECT_INVALIDATE_CFSOCKET
4862 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4867 #ifdef SELECT_INVALIDATE_CFSOCKET
4868 CFSocketInvalidate (*s
);
4870 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4885 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4886 GetEventTypeCount (specs
),
4888 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4889 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4896 #endif /* SELECT_USE_CFSOCKET */
4901 EMACS_TIME end_time
, now
, remaining_time
;
4902 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4910 remaining_time
= *timeout
;
4911 EMACS_GET_TIME (now
);
4912 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4917 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4918 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4919 select_timeout
= remaining_time
;
4920 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4932 EMACS_GET_TIME (now
);
4933 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4936 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4947 /* Set up environment variables so that Emacs can correctly find its
4948 support files when packaged as an application bundle. Directories
4949 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4950 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4951 by `make install' by default can instead be placed in
4952 .../Emacs.app/Contents/Resources/ and
4953 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4954 is changed only if it is not already set. Presumably if the user
4955 sets an environment variable, he will want to use files in his path
4956 instead of ones in the application bundle. */
4958 init_mac_osx_environment ()
4962 CFStringRef cf_app_bundle_pathname
;
4963 int app_bundle_pathname_len
;
4964 char *app_bundle_pathname
;
4968 /* Initialize locale related variables. */
4969 mac_system_script_code
=
4970 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4971 Vmac_system_locale
= mac_get_system_locale ();
4973 /* Fetch the pathname of the application bundle as a C string into
4974 app_bundle_pathname. */
4976 bundle
= CFBundleGetMainBundle ();
4977 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
4979 /* We could not find the bundle identifier. For now, prevent
4980 the fatal error by bringing it up in the terminal. */
4981 inhibit_window_system
= 1;
4985 bundleURL
= CFBundleCopyBundleURL (bundle
);
4989 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4990 kCFURLPOSIXPathStyle
);
4991 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4992 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4994 if (!CFStringGetCString (cf_app_bundle_pathname
,
4995 app_bundle_pathname
,
4996 app_bundle_pathname_len
+ 1,
4997 kCFStringEncodingISOLatin1
))
4999 CFRelease (cf_app_bundle_pathname
);
5003 CFRelease (cf_app_bundle_pathname
);
5005 /* P should have sufficient room for the pathname of the bundle plus
5006 the subpath in it leading to the respective directories. Q
5007 should have three times that much room because EMACSLOADPATH can
5008 have the value "<path to lisp dir>:<path to leim dir>:<path to
5010 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5011 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5012 if (!getenv ("EMACSLOADPATH"))
5016 strcpy (p
, app_bundle_pathname
);
5017 strcat (p
, "/Contents/Resources/lisp");
5018 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5021 strcpy (p
, app_bundle_pathname
);
5022 strcat (p
, "/Contents/Resources/leim");
5023 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5030 strcpy (p
, app_bundle_pathname
);
5031 strcat (p
, "/Contents/Resources/site-lisp");
5032 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5040 setenv ("EMACSLOADPATH", q
, 1);
5043 if (!getenv ("EMACSPATH"))
5047 strcpy (p
, app_bundle_pathname
);
5048 strcat (p
, "/Contents/MacOS/libexec");
5049 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5052 strcpy (p
, app_bundle_pathname
);
5053 strcat (p
, "/Contents/MacOS/bin");
5054 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5062 setenv ("EMACSPATH", q
, 1);
5065 if (!getenv ("EMACSDATA"))
5067 strcpy (p
, app_bundle_pathname
);
5068 strcat (p
, "/Contents/Resources/etc");
5069 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5070 setenv ("EMACSDATA", p
, 1);
5073 if (!getenv ("EMACSDOC"))
5075 strcpy (p
, app_bundle_pathname
);
5076 strcat (p
, "/Contents/Resources/etc");
5077 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5078 setenv ("EMACSDOC", p
, 1);
5081 if (!getenv ("INFOPATH"))
5083 strcpy (p
, app_bundle_pathname
);
5084 strcat (p
, "/Contents/Resources/info");
5085 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5086 setenv ("INFOPATH", p
, 1);
5089 #endif /* MAC_OSX */
5095 Qundecoded_file_name
= intern ("undecoded-file-name");
5096 staticpro (&Qundecoded_file_name
);
5098 #if TARGET_API_MAC_CARBON
5099 Qstring
= intern ("string"); staticpro (&Qstring
);
5100 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5101 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5102 Qdate
= intern ("date"); staticpro (&Qdate
);
5103 Qdata
= intern ("data"); staticpro (&Qdata
);
5104 Qarray
= intern ("array"); staticpro (&Qarray
);
5105 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5107 Qxml
= intern ("xml");
5110 Qmime_charset
= intern ("mime-charset");
5111 staticpro (&Qmime_charset
);
5113 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5114 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5115 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5116 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5117 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5118 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5121 defsubr (&Smac_coerce_ae_data
);
5122 #if TARGET_API_MAC_CARBON
5123 defsubr (&Smac_get_preference
);
5124 defsubr (&Smac_code_convert_string
);
5126 defsubr (&Smac_clear_font_name_table
);
5128 defsubr (&Smac_set_file_creator
);
5129 defsubr (&Smac_set_file_type
);
5130 defsubr (&Smac_get_file_creator
);
5131 defsubr (&Smac_get_file_type
);
5132 defsubr (&Sdo_applescript
);
5133 defsubr (&Smac_file_name_to_posix
);
5134 defsubr (&Sposix_file_name_to_mac
);
5136 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5137 doc
: /* The system script code. */);
5138 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5140 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5141 doc
: /* The system locale identifier string.
5142 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5143 information is not included. */);
5144 Vmac_system_locale
= mac_get_system_locale ();
5147 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5148 (do not change this comment) */