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
);
454 /* Just to be paranoid ... */
458 buf
= xmalloc (data_size
+ 1);
459 memcpy (buf
, data_ptr
, data_size
);
460 buf
[data_size
] = '\0';
461 err
= FSPathMakeRef (buf
, &fref
, NULL
);
464 err
= AECoercePtr (typeFSRef
, &fref
, sizeof (FSRef
),
471 buf
= xmalloc (data_size
+ 1);
472 memcpy (buf
, data_ptr
, data_size
);
473 buf
[data_size
] = '\0';
474 err
= posix_pathname_to_fsspec (buf
, &fs
);
477 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
480 else if (to_type
== TYPE_FILE_NAME
)
481 /* Coercion to undecoded file name. */
485 CFStringRef str
= NULL
;
486 CFDataRef data
= NULL
;
488 if (type_code
== typeFileURL
)
489 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
490 kCFStringEncodingUTF8
, NULL
);
497 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
501 size
= AEGetDescDataSize (&desc
);
502 buf
= xmalloc (size
);
503 err
= AEGetDescData (&desc
, buf
, size
);
505 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
506 kCFStringEncodingUTF8
, NULL
);
508 AEDisposeDesc (&desc
);
513 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
518 data
= CFStringCreateExternalRepresentation (NULL
, str
,
519 kCFStringEncodingUTF8
,
525 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
526 CFDataGetLength (data
), result
);
532 /* Coercion from typeAlias to typeFileURL fails on Mac OS X
533 10.2. In such cases, try typeFSRef as a target type. */
534 char file_name
[MAXPATHLEN
];
536 if (type_code
== typeFSRef
&& data_size
== sizeof (FSRef
))
537 err
= FSRefMakePath (data_ptr
, file_name
, sizeof (file_name
));
543 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
547 err
= AEGetDescData (&desc
, &fref
, sizeof (FSRef
));
548 AEDisposeDesc (&desc
);
551 err
= FSRefMakePath (&fref
, file_name
, sizeof (file_name
));
554 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
555 strlen (file_name
), result
);
558 char file_name
[MAXPATHLEN
];
560 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
561 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
562 sizeof (file_name
) - 1);
568 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
571 #if TARGET_API_MAC_CARBON
572 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
574 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
576 AEDisposeDesc (&desc
);
579 err
= fsspec_to_posix_pathname (&fs
, file_name
,
580 sizeof (file_name
) - 1);
583 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
584 strlen (file_name
), result
);
591 return errAECoercionFail
;
596 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
597 const AEDesc
*from_desc
;
603 DescType from_type
= from_desc
->descriptorType
;
605 if (from_type
== typeNull
)
606 err
= errAECoercionFail
;
607 else if (from_type
== to_type
|| to_type
== typeWildCard
)
608 err
= AEDuplicateDesc (from_desc
, result
);
614 #if TARGET_API_MAC_CARBON
615 data_size
= AEGetDescDataSize (from_desc
);
617 data_size
= GetHandleSize (from_desc
->dataHandle
);
619 data_ptr
= xmalloc (data_size
);
620 #if TARGET_API_MAC_CARBON
621 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
623 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
626 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
628 handler_refcon
, result
);
633 return errAECoercionFail
;
638 init_coercion_handler ()
642 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
643 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
645 if (coerce_file_name_ptrUPP
== NULL
)
647 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
648 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
651 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
652 (AECoercionHandlerUPP
)
653 coerce_file_name_ptrUPP
, 0, false, false);
655 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
656 (AECoercionHandlerUPP
)
657 coerce_file_name_ptrUPP
, 0, false, false);
659 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
660 coerce_file_name_descUPP
, 0, true, false);
662 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
663 coerce_file_name_descUPP
, 0, true, false);
667 #if TARGET_API_MAC_CARBON
669 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
672 EventParamName
*names
;
673 EventParamType
*types
;
677 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
678 AEAddressDesc address_desc
;
684 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
685 sizeof (ProcessSerialNumber
), &address_desc
);
688 err
= AECreateAppleEvent (0, 0, /* Dummy class and ID. */
689 &address_desc
, /* NULL is not allowed
690 on Mac OS Classic. */
691 kAutoGenerateReturnID
,
692 kAnyTransactionID
, result
);
693 AEDisposeDesc (&address_desc
);
698 for (i
= 0; i
< num_params
; i
++)
702 case typeCFStringRef
:
703 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
704 sizeof (CFStringRef
), NULL
, &string
);
707 data
= CFStringCreateExternalRepresentation (NULL
, string
,
708 kCFStringEncodingUTF8
,
712 /* typeUTF8Text is not available on Mac OS X 10.1. */
713 AEPutParamPtr (result
, names
[i
], 'utf8',
714 CFDataGetBytePtr (data
), CFDataGetLength (data
));
720 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
724 buf
= xmalloc (size
);
725 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
728 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
738 /***********************************************************************
739 Conversion between Lisp and Core Foundation objects
740 ***********************************************************************/
742 #if TARGET_API_MAC_CARBON
743 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
744 static Lisp_Object Qarray
, Qdictionary
;
746 struct cfdict_context
749 int with_tag
, hash_bound
;
752 /* C string to CFString. */
755 cfstring_create_with_utf8_cstring (c_str
)
760 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
762 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
763 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
769 /* Lisp string to CFString. */
772 cfstring_create_with_string (s
)
775 CFStringRef string
= NULL
;
777 if (STRING_MULTIBYTE (s
))
779 char *p
, *end
= SDATA (s
) + SBYTES (s
);
781 for (p
= SDATA (s
); p
< end
; p
++)
784 s
= ENCODE_UTF_8 (s
);
787 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
788 kCFStringEncodingUTF8
, false);
792 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
793 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
794 kCFStringEncodingMacRoman
, false);
800 /* From CFData to a lisp string. Always returns a unibyte string. */
803 cfdata_to_lisp (data
)
806 CFIndex len
= CFDataGetLength (data
);
807 Lisp_Object result
= make_uninit_string (len
);
809 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
815 /* From CFString to a lisp string. Returns a unibyte string
816 containing a UTF-8 byte sequence. */
819 cfstring_to_lisp_nodecode (string
)
822 Lisp_Object result
= Qnil
;
823 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
826 result
= make_unibyte_string (s
, strlen (s
));
830 CFStringCreateExternalRepresentation (NULL
, string
,
831 kCFStringEncodingUTF8
, '?');
835 result
= cfdata_to_lisp (data
);
844 /* From CFString to a lisp string. Never returns a unibyte string
845 (even if it only contains ASCII characters).
846 This may cause GC during code conversion. */
849 cfstring_to_lisp (string
)
852 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
856 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
857 /* This may be superfluous. Just to make sure that the result
858 is a multibyte string. */
859 result
= string_to_multibyte (result
);
866 /* CFNumber to a lisp integer or a lisp float. */
869 cfnumber_to_lisp (number
)
872 Lisp_Object result
= Qnil
;
873 #if BITS_PER_EMACS_INT > 32
875 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
878 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
882 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
883 && !FIXNUM_OVERFLOW_P (int_val
))
884 result
= make_number (int_val
);
886 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
887 result
= make_float (float_val
);
892 /* CFDate to a list of three integers as in a return value of
896 cfdate_to_lisp (date
)
899 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
900 static CFAbsoluteTime epoch
= 0.0, sec
;
904 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
906 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
907 high
= sec
/ 65536.0;
908 low
= sec
- high
* 65536.0;
910 return list3 (make_number (high
), make_number (low
), make_number (0));
914 /* CFBoolean to a lisp symbol, `t' or `nil'. */
917 cfboolean_to_lisp (boolean
)
918 CFBooleanRef boolean
;
920 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
924 /* Any Core Foundation object to a (lengthy) lisp string. */
927 cfobject_desc_to_lisp (object
)
930 Lisp_Object result
= Qnil
;
931 CFStringRef desc
= CFCopyDescription (object
);
935 result
= cfstring_to_lisp (desc
);
943 /* Callback functions for cfproperty_list_to_lisp. */
946 cfdictionary_add_to_list (key
, value
, context
)
951 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
954 Fcons (Fcons (cfstring_to_lisp (key
),
955 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
961 cfdictionary_puthash (key
, value
, context
)
966 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
967 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
968 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
971 hash_lookup (h
, lisp_key
, &hash_code
);
972 hash_put (h
, lisp_key
,
973 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
978 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
979 non-zero, a symbol that represents the type of the original Core
980 Foundation object is prepended. HASH_BOUND specifies which kinds
981 of the lisp objects, alists or hash tables, are used as the targets
982 of the conversion from CFDictionary. If HASH_BOUND is negative,
983 always generate alists. If HASH_BOUND >= 0, generate an alist if
984 the number of keys in the dictionary is smaller than HASH_BOUND,
985 and a hash table otherwise. */
988 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
989 CFPropertyListRef plist
;
990 int with_tag
, hash_bound
;
992 CFTypeID type_id
= CFGetTypeID (plist
);
993 Lisp_Object tag
= Qnil
, result
= Qnil
;
994 struct gcpro gcpro1
, gcpro2
;
996 GCPRO2 (tag
, result
);
998 if (type_id
== CFStringGetTypeID ())
1001 result
= cfstring_to_lisp (plist
);
1003 else if (type_id
== CFNumberGetTypeID ())
1006 result
= cfnumber_to_lisp (plist
);
1008 else if (type_id
== CFBooleanGetTypeID ())
1011 result
= cfboolean_to_lisp (plist
);
1013 else if (type_id
== CFDateGetTypeID ())
1016 result
= cfdate_to_lisp (plist
);
1018 else if (type_id
== CFDataGetTypeID ())
1021 result
= cfdata_to_lisp (plist
);
1023 else if (type_id
== CFArrayGetTypeID ())
1025 CFIndex index
, count
= CFArrayGetCount (plist
);
1028 result
= Fmake_vector (make_number (count
), Qnil
);
1029 for (index
= 0; index
< count
; index
++)
1030 XVECTOR (result
)->contents
[index
] =
1031 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1032 with_tag
, hash_bound
);
1034 else if (type_id
== CFDictionaryGetTypeID ())
1036 struct cfdict_context context
;
1037 CFIndex count
= CFDictionaryGetCount (plist
);
1040 context
.result
= &result
;
1041 context
.with_tag
= with_tag
;
1042 context
.hash_bound
= hash_bound
;
1043 if (hash_bound
< 0 || count
< hash_bound
)
1046 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1051 result
= make_hash_table (Qequal
,
1052 make_number (count
),
1053 make_float (DEFAULT_REHASH_SIZE
),
1054 make_float (DEFAULT_REHASH_THRESHOLD
),
1056 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1066 result
= Fcons (tag
, result
);
1073 /***********************************************************************
1074 Emulation of the X Resource Manager
1075 ***********************************************************************/
1077 /* Parser functions for resource lines. Each function takes an
1078 address of a variable whose value points to the head of a string.
1079 The value will be advanced so that it points to the next character
1080 of the parsed part when the function returns.
1082 A resource name such as "Emacs*font" is parsed into a non-empty
1083 list called `quarks'. Each element is either a Lisp string that
1084 represents a concrete component, a Lisp symbol LOOSE_BINDING
1085 (actually Qlambda) that represents any number (>=0) of intervening
1086 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1087 that represents as any single component. */
1091 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1092 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1095 skip_white_space (p
)
1098 /* WhiteSpace = {<space> | <horizontal tab>} */
1099 while (*P
== ' ' || *P
== '\t')
1107 /* Comment = "!" {<any character except null or newline>} */
1120 /* Don't interpret filename. Just skip until the newline. */
1122 parse_include_file (p
)
1125 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1142 /* Binding = "." | "*" */
1143 if (*P
== '.' || *P
== '*')
1145 char binding
= *P
++;
1147 while (*P
== '.' || *P
== '*')
1160 /* Component = "?" | ComponentName
1161 ComponentName = NameChar {NameChar}
1162 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1166 return SINGLE_COMPONENT
;
1168 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1172 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1175 return make_unibyte_string (start
, P
- start
);
1182 parse_resource_name (p
)
1185 Lisp_Object result
= Qnil
, component
;
1188 /* ResourceName = [Binding] {Component Binding} ComponentName */
1189 if (parse_binding (p
) == '*')
1190 result
= Fcons (LOOSE_BINDING
, result
);
1192 component
= parse_component (p
);
1193 if (NILP (component
))
1196 result
= Fcons (component
, result
);
1197 while ((binding
= parse_binding (p
)) != '\0')
1200 result
= Fcons (LOOSE_BINDING
, result
);
1201 component
= parse_component (p
);
1202 if (NILP (component
))
1205 result
= Fcons (component
, result
);
1208 /* The final component should not be '?'. */
1209 if (EQ (component
, SINGLE_COMPONENT
))
1212 return Fnreverse (result
);
1220 Lisp_Object seq
= Qnil
, result
;
1221 int buf_len
, total_len
= 0, len
, continue_p
;
1223 q
= strchr (P
, '\n');
1224 buf_len
= q
? q
- P
: strlen (P
);
1225 buf
= xmalloc (buf_len
);
1238 else if (*P
== '\\')
1243 else if (*P
== '\n')
1254 else if ('0' <= P
[0] && P
[0] <= '7'
1255 && '0' <= P
[1] && P
[1] <= '7'
1256 && '0' <= P
[2] && P
[2] <= '7')
1258 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1268 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1273 q
= strchr (P
, '\n');
1274 len
= q
? q
- P
: strlen (P
);
1279 buf
= xmalloc (buf_len
);
1287 if (SBYTES (XCAR (seq
)) == total_len
)
1288 return make_string (SDATA (XCAR (seq
)), total_len
);
1291 buf
= xmalloc (total_len
);
1292 q
= buf
+ total_len
;
1293 for (; CONSP (seq
); seq
= XCDR (seq
))
1295 len
= SBYTES (XCAR (seq
));
1297 memcpy (q
, SDATA (XCAR (seq
)), len
);
1299 result
= make_string (buf
, total_len
);
1306 parse_resource_line (p
)
1309 Lisp_Object quarks
, value
;
1311 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1312 if (parse_comment (p
) || parse_include_file (p
))
1315 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1316 skip_white_space (p
);
1317 quarks
= parse_resource_name (p
);
1320 skip_white_space (p
);
1324 skip_white_space (p
);
1325 value
= parse_value (p
);
1326 return Fcons (quarks
, value
);
1329 /* Skip the remaining data as a dummy value. */
1336 /* Equivalents of X Resource Manager functions.
1338 An X Resource Database acts as a collection of resource names and
1339 associated values. It is implemented as a trie on quarks. Namely,
1340 each edge is labeled by either a string, LOOSE_BINDING, or
1341 SINGLE_COMPONENT. Each node has a node id, which is a unique
1342 nonnegative integer, and the root node id is 0. A database is
1343 implemented as a hash table that maps a pair (SRC-NODE-ID .
1344 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1345 in the table as a value for HASHKEY_MAX_NID. A value associated to
1346 a node is recorded as a value for the node id.
1348 A database also has a cache for past queries as a value for
1349 HASHKEY_QUERY_CACHE. It is another hash table that maps
1350 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1352 #define HASHKEY_MAX_NID (make_number (0))
1353 #define HASHKEY_QUERY_CACHE (make_number (-1))
1356 xrm_create_database ()
1358 XrmDatabase database
;
1360 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1361 make_float (DEFAULT_REHASH_SIZE
),
1362 make_float (DEFAULT_REHASH_THRESHOLD
),
1364 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1365 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1371 xrm_q_put_resource (database
, quarks
, value
)
1372 XrmDatabase database
;
1373 Lisp_Object quarks
, value
;
1375 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1378 Lisp_Object node_id
, key
;
1380 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1382 XSETINT (node_id
, 0);
1383 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1385 key
= Fcons (node_id
, XCAR (quarks
));
1386 i
= hash_lookup (h
, key
, &hash_code
);
1390 XSETINT (node_id
, max_nid
);
1391 hash_put (h
, key
, node_id
, hash_code
);
1394 node_id
= HASH_VALUE (h
, i
);
1396 Fputhash (node_id
, value
, database
);
1398 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1399 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1402 /* Merge multiple resource entries specified by DATA into a resource
1403 database DATABASE. DATA points to the head of a null-terminated
1404 string consisting of multiple resource lines. It's like a
1405 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1408 xrm_merge_string_database (database
, data
)
1409 XrmDatabase database
;
1412 Lisp_Object quarks_value
;
1416 quarks_value
= parse_resource_line (&data
);
1417 if (!NILP (quarks_value
))
1418 xrm_q_put_resource (database
,
1419 XCAR (quarks_value
), XCDR (quarks_value
));
1424 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1425 XrmDatabase database
;
1426 Lisp_Object node_id
, quark_name
, quark_class
;
1428 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1429 Lisp_Object key
, labels
[3], value
;
1432 if (!CONSP (quark_name
))
1433 return Fgethash (node_id
, database
, Qnil
);
1435 /* First, try tight bindings */
1436 labels
[0] = XCAR (quark_name
);
1437 labels
[1] = XCAR (quark_class
);
1438 labels
[2] = SINGLE_COMPONENT
;
1440 key
= Fcons (node_id
, Qnil
);
1441 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1443 XSETCDR (key
, labels
[k
]);
1444 i
= hash_lookup (h
, key
, NULL
);
1447 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1448 XCDR (quark_name
), XCDR (quark_class
));
1454 /* Then, try loose bindings */
1455 XSETCDR (key
, LOOSE_BINDING
);
1456 i
= hash_lookup (h
, key
, NULL
);
1459 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1460 quark_name
, quark_class
);
1464 return xrm_q_get_resource_1 (database
, node_id
,
1465 XCDR (quark_name
), XCDR (quark_class
));
1472 xrm_q_get_resource (database
, quark_name
, quark_class
)
1473 XrmDatabase database
;
1474 Lisp_Object quark_name
, quark_class
;
1476 return xrm_q_get_resource_1 (database
, make_number (0),
1477 quark_name
, quark_class
);
1480 /* Retrieve a resource value for the specified NAME and CLASS from the
1481 resource database DATABASE. It corresponds to XrmGetResource. */
1484 xrm_get_resource (database
, name
, class)
1485 XrmDatabase database
;
1488 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1490 struct Lisp_Hash_Table
*h
;
1494 nc
= strlen (class);
1495 key
= make_uninit_string (nn
+ nc
+ 1);
1496 strcpy (SDATA (key
), name
);
1497 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1499 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1500 if (NILP (query_cache
))
1502 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1503 make_float (DEFAULT_REHASH_SIZE
),
1504 make_float (DEFAULT_REHASH_THRESHOLD
),
1506 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1508 h
= XHASH_TABLE (query_cache
);
1509 i
= hash_lookup (h
, key
, &hash_code
);
1511 return HASH_VALUE (h
, i
);
1513 quark_name
= parse_resource_name (&name
);
1516 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1517 if (!STRINGP (XCAR (tmp
)))
1520 quark_class
= parse_resource_name (&class);
1523 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1524 if (!STRINGP (XCAR (tmp
)))
1531 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1532 hash_put (h
, key
, tmp
, hash_code
);
1537 #if TARGET_API_MAC_CARBON
1539 xrm_cfproperty_list_to_value (plist
)
1540 CFPropertyListRef plist
;
1542 CFTypeID type_id
= CFGetTypeID (plist
);
1544 if (type_id
== CFStringGetTypeID ())
1545 return cfstring_to_lisp (plist
);
1546 else if (type_id
== CFNumberGetTypeID ())
1549 Lisp_Object result
= Qnil
;
1551 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1554 result
= cfstring_to_lisp (string
);
1559 else if (type_id
== CFBooleanGetTypeID ())
1560 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1561 else if (type_id
== CFDataGetTypeID ())
1562 return cfdata_to_lisp (plist
);
1568 /* Create a new resource database from the preferences for the
1569 application APPLICATION. APPLICATION is either a string that
1570 specifies an application ID, or NULL that represents the current
1574 xrm_get_preference_database (application
)
1577 #if TARGET_API_MAC_CARBON
1578 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1579 CFMutableSetRef key_set
= NULL
;
1580 CFArrayRef key_array
;
1581 CFIndex index
, count
;
1583 XrmDatabase database
;
1584 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1585 CFPropertyListRef plist
;
1587 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1589 user_doms
[0] = kCFPreferencesCurrentUser
;
1590 user_doms
[1] = kCFPreferencesAnyUser
;
1591 host_doms
[0] = kCFPreferencesCurrentHost
;
1592 host_doms
[1] = kCFPreferencesAnyHost
;
1594 database
= xrm_create_database ();
1596 GCPRO3 (database
, quarks
, value
);
1600 app_id
= kCFPreferencesCurrentApplication
;
1603 app_id
= cfstring_create_with_utf8_cstring (application
);
1608 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1609 if (key_set
== NULL
)
1611 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1612 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1614 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1618 count
= CFArrayGetCount (key_array
);
1619 for (index
= 0; index
< count
; index
++)
1620 CFSetAddValue (key_set
,
1621 CFArrayGetValueAtIndex (key_array
, index
));
1622 CFRelease (key_array
);
1626 count
= CFSetGetCount (key_set
);
1627 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1628 CFSetGetValues (key_set
, (const void **)keys
);
1629 for (index
= 0; index
< count
; index
++)
1631 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1632 quarks
= parse_resource_name (&res_name
);
1633 if (!(NILP (quarks
) || *res_name
))
1635 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1636 value
= xrm_cfproperty_list_to_value (plist
);
1639 xrm_q_put_resource (database
, quarks
, value
);
1646 CFRelease (key_set
);
1655 return xrm_create_database ();
1662 /* The following functions with "sys_" prefix are stubs to Unix
1663 functions that have already been implemented by CW or MPW. The
1664 calls to them in Emacs source course are #define'd to call the sys_
1665 versions by the header files s-mac.h. In these stubs pathnames are
1666 converted between their Unix and Mac forms. */
1669 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1670 + 17 leap days. These are for adjusting time values returned by
1671 MacOS Toolbox functions. */
1673 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1676 #if __MSL__ < 0x6000
1677 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1678 a leap year! This is for adjusting time_t values returned by MSL
1680 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1681 #else /* __MSL__ >= 0x6000 */
1682 /* CW changes Pro 6 to follow Unix! */
1683 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1684 #endif /* __MSL__ >= 0x6000 */
1686 /* MPW library functions follow Unix (confused?). */
1687 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1688 #else /* not __MRC__ */
1690 #endif /* not __MRC__ */
1693 /* Define our own stat function for both MrC and CW. The reason for
1694 doing this: "stat" is both the name of a struct and function name:
1695 can't use the same trick like that for sys_open, sys_close, etc. to
1696 redirect Emacs's calls to our own version that converts Unix style
1697 filenames to Mac style filename because all sorts of compilation
1698 errors will be generated if stat is #define'd to be sys_stat. */
1701 stat_noalias (const char *path
, struct stat
*buf
)
1703 char mac_pathname
[MAXPATHLEN
+1];
1706 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1709 c2pstr (mac_pathname
);
1710 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1711 cipb
.hFileInfo
.ioVRefNum
= 0;
1712 cipb
.hFileInfo
.ioDirID
= 0;
1713 cipb
.hFileInfo
.ioFDirIndex
= 0;
1714 /* set to 0 to get information about specific dir or file */
1716 errno
= PBGetCatInfo (&cipb
, false);
1717 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1722 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1724 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1726 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1727 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1728 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1729 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1730 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1731 /* size of dir = number of files and dirs */
1734 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1735 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1739 buf
->st_mode
= S_IFREG
| S_IREAD
;
1740 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1741 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1742 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1743 buf
->st_mode
|= S_IEXEC
;
1744 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1745 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1746 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1749 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1750 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1753 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1755 /* identify alias files as symlinks */
1756 buf
->st_mode
&= ~S_IFREG
;
1757 buf
->st_mode
|= S_IFLNK
;
1761 buf
->st_uid
= getuid ();
1762 buf
->st_gid
= getgid ();
1770 lstat (const char *path
, struct stat
*buf
)
1773 char true_pathname
[MAXPATHLEN
+1];
1775 /* Try looking for the file without resolving aliases first. */
1776 if ((result
= stat_noalias (path
, buf
)) >= 0)
1779 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1782 return stat_noalias (true_pathname
, buf
);
1787 stat (const char *path
, struct stat
*sb
)
1790 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1793 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1794 ! (sb
->st_mode
& S_IFLNK
))
1797 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1800 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1803 fully_resolved_name
[len
] = '\0';
1804 /* in fact our readlink terminates strings */
1805 return lstat (fully_resolved_name
, sb
);
1808 return lstat (true_pathname
, sb
);
1813 /* CW defines fstat in stat.mac.c while MPW does not provide this
1814 function. Without the information of how to get from a file
1815 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1816 to implement this function. Fortunately, there is only one place
1817 where this function is called in our configuration: in fileio.c,
1818 where only the st_dev and st_ino fields are used to determine
1819 whether two fildes point to different i-nodes to prevent copying
1820 a file onto itself equal. What we have here probably needs
1824 fstat (int fildes
, struct stat
*buf
)
1827 buf
->st_ino
= fildes
;
1828 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1829 return 0; /* success */
1831 #endif /* __MRC__ */
1835 mkdir (const char *dirname
, int mode
)
1837 #pragma unused(mode)
1840 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1842 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1845 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1848 c2pstr (mac_pathname
);
1849 hfpb
.ioNamePtr
= mac_pathname
;
1850 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1851 hfpb
.ioDirID
= 0; /* parent is the root */
1853 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1854 /* just return the Mac OSErr code for now */
1855 return errno
== noErr
? 0 : -1;
1860 sys_rmdir (const char *dirname
)
1863 char mac_pathname
[MAXPATHLEN
+1];
1865 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1868 c2pstr (mac_pathname
);
1869 hfpb
.ioNamePtr
= mac_pathname
;
1870 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1871 hfpb
.ioDirID
= 0; /* parent is the root */
1873 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1874 return errno
== noErr
? 0 : -1;
1879 /* No implementation yet. */
1881 execvp (const char *path
, ...)
1885 #endif /* __MRC__ */
1889 utime (const char *path
, const struct utimbuf
*times
)
1891 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1893 char mac_pathname
[MAXPATHLEN
+1];
1896 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1899 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1901 fully_resolved_name
[len
] = '\0';
1903 strcpy (fully_resolved_name
, true_pathname
);
1905 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1908 c2pstr (mac_pathname
);
1909 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1910 cipb
.hFileInfo
.ioVRefNum
= 0;
1911 cipb
.hFileInfo
.ioDirID
= 0;
1912 cipb
.hFileInfo
.ioFDirIndex
= 0;
1913 /* set to 0 to get information about specific dir or file */
1915 errno
= PBGetCatInfo (&cipb
, false);
1919 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1922 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1924 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1929 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1931 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1934 errno
= PBSetCatInfo (&cipb
, false);
1935 return errno
== noErr
? 0 : -1;
1949 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1951 access (const char *path
, int mode
)
1953 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1955 char mac_pathname
[MAXPATHLEN
+1];
1958 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1961 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1963 fully_resolved_name
[len
] = '\0';
1965 strcpy (fully_resolved_name
, true_pathname
);
1967 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1970 c2pstr (mac_pathname
);
1971 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1972 cipb
.hFileInfo
.ioVRefNum
= 0;
1973 cipb
.hFileInfo
.ioDirID
= 0;
1974 cipb
.hFileInfo
.ioFDirIndex
= 0;
1975 /* set to 0 to get information about specific dir or file */
1977 errno
= PBGetCatInfo (&cipb
, false);
1981 if (mode
== F_OK
) /* got this far, file exists */
1985 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1989 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1996 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1997 /* don't allow if lock bit is on */
2003 #define DEV_NULL_FD 0x10000
2007 sys_open (const char *path
, int oflag
)
2009 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2011 char mac_pathname
[MAXPATHLEN
+1];
2013 if (strcmp (path
, "/dev/null") == 0)
2014 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2016 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2019 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2021 fully_resolved_name
[len
] = '\0';
2023 strcpy (fully_resolved_name
, true_pathname
);
2025 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2030 int res
= open (mac_pathname
, oflag
);
2031 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2032 if (oflag
& O_CREAT
)
2033 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2035 #else /* not __MRC__ */
2036 return open (mac_pathname
, oflag
);
2037 #endif /* not __MRC__ */
2044 sys_creat (const char *path
, mode_t mode
)
2046 char true_pathname
[MAXPATHLEN
+1];
2048 char mac_pathname
[MAXPATHLEN
+1];
2050 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2053 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2058 int result
= creat (mac_pathname
);
2059 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2061 #else /* not __MRC__ */
2062 return creat (mac_pathname
, mode
);
2063 #endif /* not __MRC__ */
2070 sys_unlink (const char *path
)
2072 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2074 char mac_pathname
[MAXPATHLEN
+1];
2076 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2079 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2081 fully_resolved_name
[len
] = '\0';
2083 strcpy (fully_resolved_name
, true_pathname
);
2085 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2088 return unlink (mac_pathname
);
2094 sys_read (int fildes
, char *buf
, int count
)
2096 if (fildes
== 0) /* this should not be used for console input */
2099 #if __MSL__ >= 0x6000
2100 return _read (fildes
, buf
, count
);
2102 return read (fildes
, buf
, count
);
2109 sys_write (int fildes
, const char *buf
, int count
)
2111 if (fildes
== DEV_NULL_FD
)
2114 #if __MSL__ >= 0x6000
2115 return _write (fildes
, buf
, count
);
2117 return write (fildes
, buf
, count
);
2124 sys_rename (const char * old_name
, const char * new_name
)
2126 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2127 char fully_resolved_old_name
[MAXPATHLEN
+1];
2129 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2131 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2134 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2136 fully_resolved_old_name
[len
] = '\0';
2138 strcpy (fully_resolved_old_name
, true_old_pathname
);
2140 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2143 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2146 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2151 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2154 /* If a file with new_name already exists, rename deletes the old
2155 file in Unix. CW version fails in these situation. So we add a
2156 call to unlink here. */
2157 (void) unlink (mac_new_name
);
2159 return rename (mac_old_name
, mac_new_name
);
2164 extern FILE *fopen (const char *name
, const char *mode
);
2166 sys_fopen (const char *name
, const char *mode
)
2168 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2170 char mac_pathname
[MAXPATHLEN
+1];
2172 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2175 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2177 fully_resolved_name
[len
] = '\0';
2179 strcpy (fully_resolved_name
, true_pathname
);
2181 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2186 if (mode
[0] == 'w' || mode
[0] == 'a')
2187 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2188 #endif /* not __MRC__ */
2189 return fopen (mac_pathname
, mode
);
2194 #include "keyboard.h"
2195 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2198 select (n
, rfds
, wfds
, efds
, timeout
)
2203 struct timeval
*timeout
;
2206 #if TARGET_API_MAC_CARBON
2207 EventTimeout timeout_sec
=
2209 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2210 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2211 : kEventDurationForever
);
2214 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2216 #else /* not TARGET_API_MAC_CARBON */
2218 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2219 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2221 /* Can only handle wait for keyboard input. */
2222 if (n
> 1 || wfds
|| efds
)
2225 /* Also return true if an event other than a keyDown has occurred.
2226 This causes kbd_buffer_get_event in keyboard.c to call
2227 read_avail_input which in turn calls XTread_socket to poll for
2228 these events. Otherwise these never get processed except but a
2229 very slow poll timer. */
2230 if (mac_wait_next_event (&e
, sleep_time
, false))
2233 err
= -9875; /* eventLoopTimedOutErr */
2234 #endif /* not TARGET_API_MAC_CARBON */
2236 if (FD_ISSET (0, rfds
))
2247 if (input_polling_used ())
2249 /* It could be confusing if a real alarm arrives while
2250 processing the fake one. Turn it off and let the
2251 handler reset it. */
2252 extern void poll_for_input_1
P_ ((void));
2253 int old_poll_suppress_count
= poll_suppress_count
;
2254 poll_suppress_count
= 1;
2255 poll_for_input_1 ();
2256 poll_suppress_count
= old_poll_suppress_count
;
2266 /* Simulation of SIGALRM. The stub for function signal stores the
2267 signal handler function in alarm_signal_func if a SIGALRM is
2271 #include "syssignal.h"
2273 static TMTask mac_atimer_task
;
2275 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2277 static int signal_mask
= 0;
2280 __sigfun alarm_signal_func
= (__sigfun
) 0;
2282 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2283 #else /* not __MRC__ and not __MWERKS__ */
2285 #endif /* not __MRC__ and not __MWERKS__ */
2289 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2291 sys_signal (int signal_num
, __sigfun signal_func
)
2293 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2295 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2296 #else /* not __MRC__ and not __MWERKS__ */
2298 #endif /* not __MRC__ and not __MWERKS__ */
2300 if (signal_num
!= SIGALRM
)
2301 return signal (signal_num
, signal_func
);
2305 __sigfun old_signal_func
;
2307 __signal_func_ptr old_signal_func
;
2311 old_signal_func
= alarm_signal_func
;
2312 alarm_signal_func
= signal_func
;
2313 return old_signal_func
;
2319 mac_atimer_handler (qlink
)
2322 if (alarm_signal_func
)
2323 (alarm_signal_func
) (SIGALRM
);
2328 set_mac_atimer (count
)
2331 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2333 if (mac_atimer_handlerUPP
== NULL
)
2334 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2335 mac_atimer_task
.tmCount
= 0;
2336 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2337 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2338 InsTime (mac_atimer_qlink
);
2340 PrimeTime (mac_atimer_qlink
, count
);
2345 remove_mac_atimer (remaining_count
)
2346 long *remaining_count
;
2348 if (mac_atimer_qlink
)
2350 RmvTime (mac_atimer_qlink
);
2351 if (remaining_count
)
2352 *remaining_count
= mac_atimer_task
.tmCount
;
2353 mac_atimer_qlink
= NULL
;
2365 int old_mask
= signal_mask
;
2367 signal_mask
|= mask
;
2369 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2370 remove_mac_atimer (NULL
);
2377 sigsetmask (int mask
)
2379 int old_mask
= signal_mask
;
2383 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2384 if (signal_mask
& sigmask (SIGALRM
))
2385 remove_mac_atimer (NULL
);
2387 set_mac_atimer (mac_atimer_task
.tmCount
);
2396 long remaining_count
;
2398 if (remove_mac_atimer (&remaining_count
) == 0)
2400 set_mac_atimer (seconds
* 1000);
2402 return remaining_count
/ 1000;
2406 mac_atimer_task
.tmCount
= seconds
* 1000;
2414 setitimer (which
, value
, ovalue
)
2416 const struct itimerval
*value
;
2417 struct itimerval
*ovalue
;
2419 long remaining_count
;
2420 long count
= (EMACS_SECS (value
->it_value
) * 1000
2421 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2423 if (remove_mac_atimer (&remaining_count
) == 0)
2427 bzero (ovalue
, sizeof (*ovalue
));
2428 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2429 (remaining_count
% 1000) * 1000);
2431 set_mac_atimer (count
);
2434 mac_atimer_task
.tmCount
= count
;
2440 /* gettimeofday should return the amount of time (in a timeval
2441 structure) since midnight today. The toolbox function Microseconds
2442 returns the number of microseconds (in a UnsignedWide value) since
2443 the machine was booted. Also making this complicated is WideAdd,
2444 WideSubtract, etc. take wide values. */
2451 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2452 UnsignedWide uw_microseconds
;
2453 wide w_microseconds
;
2454 time_t sys_time (time_t *);
2456 /* If this function is called for the first time, record the number
2457 of seconds since midnight and the number of microseconds since
2458 boot at the time of this first call. */
2463 systime
= sys_time (NULL
);
2464 /* Store microseconds since midnight in wall_clock_at_epoch. */
2465 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2466 Microseconds (&uw_microseconds
);
2467 /* Store microseconds since boot in clicks_at_epoch. */
2468 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2469 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2472 /* Get time since boot */
2473 Microseconds (&uw_microseconds
);
2475 /* Convert to time since midnight*/
2476 w_microseconds
.hi
= uw_microseconds
.hi
;
2477 w_microseconds
.lo
= uw_microseconds
.lo
;
2478 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2479 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2480 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2488 sleep (unsigned int seconds
)
2490 unsigned long time_up
;
2493 time_up
= TickCount () + seconds
* 60;
2494 while (TickCount () < time_up
)
2496 /* Accept no event; just wait. by T.I. */
2497 WaitNextEvent (0, &e
, 30, NULL
);
2502 #endif /* __MRC__ */
2505 /* The time functions adjust time values according to the difference
2506 between the Unix and CW epoches. */
2509 extern struct tm
*gmtime (const time_t *);
2511 sys_gmtime (const time_t *timer
)
2513 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2515 return gmtime (&unix_time
);
2520 extern struct tm
*localtime (const time_t *);
2522 sys_localtime (const time_t *timer
)
2524 #if __MSL__ >= 0x6000
2525 time_t unix_time
= *timer
;
2527 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2530 return localtime (&unix_time
);
2535 extern char *ctime (const time_t *);
2537 sys_ctime (const time_t *timer
)
2539 #if __MSL__ >= 0x6000
2540 time_t unix_time
= *timer
;
2542 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2545 return ctime (&unix_time
);
2550 extern time_t time (time_t *);
2552 sys_time (time_t *timer
)
2554 #if __MSL__ >= 0x6000
2555 time_t mac_time
= time (NULL
);
2557 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2567 /* no subprocesses, empty wait */
2577 croak (char *badfunc
)
2579 printf ("%s not yet implemented\r\n", badfunc
);
2585 mktemp (char *template)
2590 len
= strlen (template);
2592 while (k
>= 0 && template[k
] == 'X')
2595 k
++; /* make k index of first 'X' */
2599 /* Zero filled, number of digits equal to the number of X's. */
2600 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2609 /* Emulate getpwuid, getpwnam and others. */
2611 #define PASSWD_FIELD_SIZE 256
2613 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2614 static char my_passwd_dir
[MAXPATHLEN
+1];
2616 static struct passwd my_passwd
=
2622 static struct group my_group
=
2624 /* There are no groups on the mac, so we just return "root" as the
2630 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2632 char emacs_passwd_dir
[MAXPATHLEN
+1];
2638 init_emacs_passwd_dir ()
2642 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2644 /* Need pathname of first ancestor that begins with "emacs"
2645 since Mac emacs application is somewhere in the emacs-*
2647 int len
= strlen (emacs_passwd_dir
);
2649 /* j points to the "/" following the directory name being
2652 while (i
>= 0 && !found
)
2654 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2656 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2657 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2659 emacs_passwd_dir
[j
+1] = '\0';
2670 /* Setting to "/" probably won't work but set it to something
2672 strcpy (emacs_passwd_dir
, "/");
2673 strcpy (my_passwd_dir
, "/");
2678 static struct passwd emacs_passwd
=
2684 static int my_passwd_inited
= 0;
2692 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2693 directory where Emacs was started. */
2695 owner_name
= (char **) GetResource ('STR ',-16096);
2699 BlockMove ((unsigned char *) *owner_name
,
2700 (unsigned char *) my_passwd_name
,
2702 HUnlock (owner_name
);
2703 p2cstr ((unsigned char *) my_passwd_name
);
2706 my_passwd_name
[0] = 0;
2711 getpwuid (uid_t uid
)
2713 if (!my_passwd_inited
)
2716 my_passwd_inited
= 1;
2724 getgrgid (gid_t gid
)
2731 getpwnam (const char *name
)
2733 if (strcmp (name
, "emacs") == 0)
2734 return &emacs_passwd
;
2736 if (!my_passwd_inited
)
2739 my_passwd_inited
= 1;
2746 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2747 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2768 error ("Can't spawn subshell");
2773 request_sigio (void)
2779 unrequest_sigio (void)
2794 pipe (int _fildes
[2])
2801 /* Hard and symbolic links. */
2804 symlink (const char *name1
, const char *name2
)
2812 link (const char *name1
, const char *name2
)
2818 #endif /* ! MAC_OSX */
2820 /* Determine the path name of the file specified by VREFNUM, DIRID,
2821 and NAME and place that in the buffer PATH of length
2824 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2825 long dir_id
, ConstStr255Param name
)
2831 if (strlen (name
) > man_path_len
)
2834 memcpy (dir_name
, name
, name
[0]+1);
2835 memcpy (path
, name
, name
[0]+1);
2838 cipb
.dirInfo
.ioDrParID
= dir_id
;
2839 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2843 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2844 cipb
.dirInfo
.ioFDirIndex
= -1;
2845 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2846 /* go up to parent each time */
2848 err
= PBGetCatInfo (&cipb
, false);
2853 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2856 strcat (dir_name
, ":");
2857 strcat (dir_name
, path
);
2858 /* attach to front since we're going up directory tree */
2859 strcpy (path
, dir_name
);
2861 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2862 /* stop when we see the volume's root directory */
2864 return 1; /* success */
2871 posix_pathname_to_fsspec (ufn
, fs
)
2875 Str255 mac_pathname
;
2877 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2881 c2pstr (mac_pathname
);
2882 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2887 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2892 char mac_pathname
[MAXPATHLEN
];
2894 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2895 fs
->vRefNum
, fs
->parID
, fs
->name
)
2896 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2903 readlink (const char *path
, char *buf
, int bufsiz
)
2905 char mac_sym_link_name
[MAXPATHLEN
+1];
2908 Boolean target_is_folder
, was_aliased
;
2909 Str255 directory_name
, mac_pathname
;
2912 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2915 c2pstr (mac_sym_link_name
);
2916 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2923 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2924 if (err
!= noErr
|| !was_aliased
)
2930 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2937 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2943 return strlen (buf
);
2947 /* Convert a path to one with aliases fully expanded. */
2950 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2952 char *q
, temp
[MAXPATHLEN
+1];
2956 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2963 q
= strchr (p
+ 1, '/');
2965 q
= strchr (p
, '/');
2966 len
= 0; /* loop may not be entered, e.g., for "/" */
2971 strncat (temp
, p
, q
- p
);
2972 len
= readlink (temp
, buf
, bufsiz
);
2975 if (strlen (temp
) + 1 > bufsiz
)
2985 if (len
+ strlen (p
) + 1 >= bufsiz
)
2989 return len
+ strlen (p
);
2994 umask (mode_t numask
)
2996 static mode_t mask
= 022;
2997 mode_t oldmask
= mask
;
3004 chmod (const char *path
, mode_t mode
)
3006 /* say it always succeed for now */
3012 fchmod (int fd
, mode_t mode
)
3014 /* say it always succeed for now */
3020 fchown (int fd
, uid_t owner
, gid_t group
)
3022 /* say it always succeed for now */
3031 return fcntl (oldd
, F_DUPFD
, 0);
3033 /* current implementation of fcntl in fcntl.mac.c simply returns old
3035 return fcntl (oldd
, F_DUPFD
);
3042 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3043 newd if it already exists. Then, attempt to dup oldd. If not
3044 successful, call dup2 recursively until we are, then close the
3045 unsuccessful ones. */
3048 dup2 (int oldd
, int newd
)
3059 ret
= dup2 (oldd
, newd
);
3065 /* let it fail for now */
3082 ioctl (int d
, int request
, void *argp
)
3092 if (fildes
>=0 && fildes
<= 2)
3125 #endif /* __MRC__ */
3129 #if __MSL__ < 0x6000
3137 #endif /* __MWERKS__ */
3139 #endif /* ! MAC_OSX */
3142 /* Return the path to the directory in which Emacs can create
3143 temporary files. The MacOS "temporary items" directory cannot be
3144 used because it removes the file written by a process when it
3145 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3146 again not exactly). And of course Emacs needs to read back the
3147 files written by its subprocesses. So here we write the files to a
3148 directory "Emacs" in the Preferences Folder. This directory is
3149 created if it does not exist. */
3152 get_temp_dir_name ()
3154 static char *temp_dir_name
= NULL
;
3159 char unix_dir_name
[MAXPATHLEN
+1];
3162 /* Cache directory name with pointer temp_dir_name.
3163 Look for it only the first time. */
3166 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3167 &vol_ref_num
, &dir_id
);
3171 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3174 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3175 strcat (full_path
, "Emacs:");
3179 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3182 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3185 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3188 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3189 strcpy (temp_dir_name
, unix_dir_name
);
3192 return temp_dir_name
;
3197 /* Allocate and construct an array of pointers to strings from a list
3198 of strings stored in a 'STR#' resource. The returned pointer array
3199 is stored in the style of argv and environ: if the 'STR#' resource
3200 contains numString strings, a pointer array with numString+1
3201 elements is returned in which the last entry contains a null
3202 pointer. The pointer to the pointer array is passed by pointer in
3203 parameter t. The resource ID of the 'STR#' resource is passed in
3204 parameter StringListID.
3208 get_string_list (char ***t
, short string_list_id
)
3214 h
= GetResource ('STR#', string_list_id
);
3219 num_strings
= * (short *) p
;
3221 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3222 for (i
= 0; i
< num_strings
; i
++)
3224 short length
= *p
++;
3225 (*t
)[i
] = (char *) malloc (length
+ 1);
3226 strncpy ((*t
)[i
], p
, length
);
3227 (*t
)[i
][length
] = '\0';
3230 (*t
)[num_strings
] = 0;
3235 /* Return no string in case GetResource fails. Bug fixed by
3236 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3237 option (no sym -on implies -opt local). */
3238 *t
= (char **) malloc (sizeof (char *));
3245 get_path_to_system_folder ()
3251 static char system_folder_unix_name
[MAXPATHLEN
+1];
3254 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3255 &vol_ref_num
, &dir_id
);
3259 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3262 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3266 return system_folder_unix_name
;
3272 #define ENVIRON_STRING_LIST_ID 128
3274 /* Get environment variable definitions from STR# resource. */
3281 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3287 /* Make HOME directory the one Emacs starts up in if not specified
3289 if (getenv ("HOME") == NULL
)
3291 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3294 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3297 strcpy (environ
[i
], "HOME=");
3298 strcat (environ
[i
], my_passwd_dir
);
3305 /* Make HOME directory the one Emacs starts up in if not specified
3307 if (getenv ("MAIL") == NULL
)
3309 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3312 char * path_to_system_folder
= get_path_to_system_folder ();
3313 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3316 strcpy (environ
[i
], "MAIL=");
3317 strcat (environ
[i
], path_to_system_folder
);
3318 strcat (environ
[i
], "Eudora Folder/In");
3326 /* Return the value of the environment variable NAME. */
3329 getenv (const char *name
)
3331 int length
= strlen(name
);
3334 for (e
= environ
; *e
!= 0; e
++)
3335 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3336 return &(*e
)[length
+ 1];
3338 if (strcmp (name
, "TMPDIR") == 0)
3339 return get_temp_dir_name ();
3346 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3347 char *sys_siglist
[] =
3349 "Zero is not a signal!!!",
3351 "Interactive user interrupt", /* 2 */ "?",
3352 "Floating point exception", /* 4 */ "?", "?", "?",
3353 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3354 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3355 "?", "?", "?", "?", "?", "?", "?", "?",
3359 char *sys_siglist
[] =
3361 "Zero is not a signal!!!",
3363 "Floating point exception",
3364 "Illegal instruction",
3365 "Interactive user interrupt",
3366 "Segment violation",
3369 #else /* not __MRC__ and not __MWERKS__ */
3371 #endif /* not __MRC__ and not __MWERKS__ */
3374 #include <utsname.h>
3377 uname (struct utsname
*name
)
3380 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3383 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3384 p2cstr (name
->nodename
);
3392 /* Event class of HLE sent to subprocess. */
3393 const OSType kEmacsSubprocessSend
= 'ESND';
3395 /* Event class of HLE sent back from subprocess. */
3396 const OSType kEmacsSubprocessReply
= 'ERPY';
3400 mystrchr (char *s
, char c
)
3402 while (*s
&& *s
!= c
)
3430 mystrcpy (char *to
, char *from
)
3442 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3443 terminated). The process should run with the default directory
3444 "workdir", read input from "infn", and write output and error to
3445 "outfn" and "errfn", resp. The Process Manager call
3446 LaunchApplication is used to start the subprocess. We use high
3447 level events as the mechanism to pass arguments to the subprocess
3448 and to make Emacs wait for the subprocess to terminate and pass
3449 back a result code. The bulk of the code here packs the arguments
3450 into one message to be passed together with the high level event.
3451 Emacs also sometimes starts a subprocess using a shell to perform
3452 wildcard filename expansion. Since we don't really have a shell on
3453 the Mac, this case is detected and the starting of the shell is
3454 by-passed. We really need to add code here to do filename
3455 expansion to support such functionality.
3457 We can't use this strategy in Carbon because the High Level Event
3458 APIs are not available. */
3461 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3462 unsigned char **argv
;
3463 const char *workdir
;
3464 const char *infn
, *outfn
, *errfn
;
3466 #if TARGET_API_MAC_CARBON
3468 #else /* not TARGET_API_MAC_CARBON */
3469 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3470 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3471 int paramlen
, argc
, newargc
, j
, retries
;
3472 char **newargv
, *param
, *p
;
3475 LaunchParamBlockRec lpbr
;
3476 EventRecord send_event
, reply_event
;
3477 RgnHandle cursor_region_handle
;
3479 unsigned long ref_con
, len
;
3481 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3483 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3485 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3487 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3490 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3491 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3500 /* If a subprocess is invoked with a shell, we receive 3 arguments
3501 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3502 bins>/<command> <command args>" */
3503 j
= strlen (argv
[0]);
3504 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3505 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3507 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3509 /* The arguments for the command in argv[2] are separated by
3510 spaces. Count them and put the count in newargc. */
3511 command
= (char *) alloca (strlen (argv
[2])+2);
3512 strcpy (command
, argv
[2]);
3513 if (command
[strlen (command
) - 1] != ' ')
3514 strcat (command
, " ");
3518 t
= mystrchr (t
, ' ');
3522 t
= mystrchr (t
+1, ' ');
3525 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3528 for (j
= 0; j
< newargc
; j
++)
3530 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3531 mystrcpy (newargv
[j
], t
);
3534 paramlen
+= strlen (newargv
[j
]) + 1;
3537 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3539 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3544 { /* sometimes Emacs call "sh" without a path for the command */
3546 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3547 strcpy (t
, "~emacs/");
3548 strcat (t
, newargv
[0]);
3551 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3552 make_number (X_OK
));
3556 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3560 strcpy (macappname
, tempmacpathname
);
3564 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3567 newargv
= (char **) alloca (sizeof (char *) * argc
);
3569 for (j
= 1; j
< argc
; j
++)
3571 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3573 char *t
= strchr (argv
[j
], ' ');
3576 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3577 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3578 tempcmdname
[t
-argv
[j
]] = '\0';
3579 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3582 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3584 strcpy (newargv
[j
], tempmaccmdname
);
3585 strcat (newargv
[j
], t
);
3589 char tempmaccmdname
[MAXPATHLEN
+1];
3590 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3593 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3594 strcpy (newargv
[j
], tempmaccmdname
);
3598 newargv
[j
] = argv
[j
];
3599 paramlen
+= strlen (newargv
[j
]) + 1;
3603 /* After expanding all the arguments, we now know the length of the
3604 parameter block to be sent to the subprocess as a message
3605 attached to the HLE. */
3606 param
= (char *) malloc (paramlen
+ 1);
3612 /* first byte of message contains number of arguments for command */
3613 strcpy (p
, macworkdir
);
3614 p
+= strlen (macworkdir
);
3616 /* null terminate strings sent so it's possible to use strcpy over there */
3617 strcpy (p
, macinfn
);
3618 p
+= strlen (macinfn
);
3620 strcpy (p
, macoutfn
);
3621 p
+= strlen (macoutfn
);
3623 strcpy (p
, macerrfn
);
3624 p
+= strlen (macerrfn
);
3626 for (j
= 1; j
< newargc
; j
++)
3628 strcpy (p
, newargv
[j
]);
3629 p
+= strlen (newargv
[j
]);
3633 c2pstr (macappname
);
3635 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3643 lpbr
.launchBlockID
= extendedBlock
;
3644 lpbr
.launchEPBLength
= extendedBlockLen
;
3645 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3646 lpbr
.launchAppSpec
= &spec
;
3647 lpbr
.launchAppParameters
= NULL
;
3649 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3656 send_event
.what
= kHighLevelEvent
;
3657 send_event
.message
= kEmacsSubprocessSend
;
3658 /* Event ID stored in "where" unused */
3661 /* OS may think current subprocess has terminated if previous one
3662 terminated recently. */
3665 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3666 paramlen
+ 1, receiverIDisPSN
);
3668 while (iErr
== sessClosedErr
&& retries
-- > 0);
3676 cursor_region_handle
= NewRgn ();
3678 /* Wait for the subprocess to finish, when it will send us a ERPY
3679 high level event. */
3681 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3682 cursor_region_handle
)
3683 && reply_event
.message
== kEmacsSubprocessReply
)
3686 /* The return code is sent through the refCon */
3687 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3690 DisposeHandle ((Handle
) cursor_region_handle
);
3695 DisposeHandle ((Handle
) cursor_region_handle
);
3699 #endif /* not TARGET_API_MAC_CARBON */
3704 opendir (const char *dirname
)
3706 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3707 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3711 int len
, vol_name_len
;
3713 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3716 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3718 fully_resolved_name
[len
] = '\0';
3720 strcpy (fully_resolved_name
, true_pathname
);
3722 dirp
= (DIR *) malloc (sizeof(DIR));
3726 /* Handle special case when dirname is "/": sets up for readir to
3727 get all mount volumes. */
3728 if (strcmp (fully_resolved_name
, "/") == 0)
3730 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3731 dirp
->current_index
= 1; /* index for first volume */
3735 /* Handle typical cases: not accessing all mounted volumes. */
3736 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3739 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3740 len
= strlen (mac_pathname
);
3741 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3742 strcat (mac_pathname
, ":");
3744 /* Extract volume name */
3745 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3746 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3747 vol_name
[vol_name_len
] = '\0';
3748 strcat (vol_name
, ":");
3750 c2pstr (mac_pathname
);
3751 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3752 /* using full pathname so vRefNum and DirID ignored */
3753 cipb
.hFileInfo
.ioVRefNum
= 0;
3754 cipb
.hFileInfo
.ioDirID
= 0;
3755 cipb
.hFileInfo
.ioFDirIndex
= 0;
3756 /* set to 0 to get information about specific dir or file */
3758 errno
= PBGetCatInfo (&cipb
, false);
3765 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3766 return 0; /* not a directory */
3768 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3769 dirp
->getting_volumes
= 0;
3770 dirp
->current_index
= 1; /* index for first file/directory */
3773 vpb
.ioNamePtr
= vol_name
;
3774 /* using full pathname so vRefNum and DirID ignored */
3776 vpb
.ioVolIndex
= -1;
3777 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3784 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3801 HParamBlockRec hpblock
;
3803 static struct dirent s_dirent
;
3804 static Str255 s_name
;
3808 /* Handle the root directory containing the mounted volumes. Call
3809 PBHGetVInfo specifying an index to obtain the info for a volume.
3810 PBHGetVInfo returns an error when it receives an index beyond the
3811 last volume, at which time we should return a nil dirent struct
3813 if (dp
->getting_volumes
)
3815 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3816 hpblock
.volumeParam
.ioVRefNum
= 0;
3817 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3819 errno
= PBHGetVInfo (&hpblock
, false);
3827 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3829 dp
->current_index
++;
3831 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3832 s_dirent
.d_name
= s_name
;
3838 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3839 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3840 /* location to receive filename returned */
3842 /* return only visible files */
3846 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3847 /* directory ID found by opendir */
3848 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3850 errno
= PBGetCatInfo (&cipb
, false);
3857 /* insist on a visible entry */
3858 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3859 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3861 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3863 dp
->current_index
++;
3876 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3877 /* value unimportant: non-zero for valid file */
3878 s_dirent
.d_name
= s_name
;
3888 char mac_pathname
[MAXPATHLEN
+1];
3889 Str255 directory_name
;
3893 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3896 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3902 #endif /* ! MAC_OSX */
3906 initialize_applescript ()
3911 /* if open fails, as_scripting_component is set to NULL. Its
3912 subsequent use in OSA calls will fail with badComponentInstance
3914 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3915 kAppleScriptSubtype
);
3917 null_desc
.descriptorType
= typeNull
;
3918 null_desc
.dataHandle
= 0;
3919 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3920 kOSANullScript
, &as_script_context
);
3922 as_script_context
= kOSANullScript
;
3923 /* use default context if create fails */
3928 terminate_applescript()
3930 OSADispose (as_scripting_component
, as_script_context
);
3931 CloseComponent (as_scripting_component
);
3934 /* Convert a lisp string to the 4 byte character code. */
3937 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
3946 /* check type string */
3948 if (SBYTES (arg
) != 4)
3950 error ("Wrong argument: need string of length 4 for code");
3952 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
3957 /* Convert the 4 byte character code into a 4 byte string. */
3960 mac_get_object_from_code(OSType defCode
)
3962 UInt32 code
= EndianU32_NtoB (defCode
);
3964 return make_unibyte_string ((char *)&code
, 4);
3968 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
3969 doc
: /* Get the creator code of FILENAME as a four character string. */)
3971 Lisp_Object filename
;
3979 Lisp_Object result
= Qnil
;
3980 CHECK_STRING (filename
);
3982 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
3985 filename
= Fexpand_file_name (filename
, Qnil
);
3989 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
3991 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
3994 if (status
== noErr
)
3997 FSCatalogInfo catalogInfo
;
3999 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4000 &catalogInfo
, NULL
, NULL
, NULL
);
4004 status
= FSpGetFInfo (&fss
, &finder_info
);
4006 if (status
== noErr
)
4009 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4011 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4016 if (status
!= noErr
) {
4017 error ("Error while getting file information.");
4022 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4023 doc
: /* Get the type code of FILENAME as a four character string. */)
4025 Lisp_Object filename
;
4033 Lisp_Object result
= Qnil
;
4034 CHECK_STRING (filename
);
4036 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4039 filename
= Fexpand_file_name (filename
, Qnil
);
4043 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4045 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4048 if (status
== noErr
)
4051 FSCatalogInfo catalogInfo
;
4053 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4054 &catalogInfo
, NULL
, NULL
, NULL
);
4058 status
= FSpGetFInfo (&fss
, &finder_info
);
4060 if (status
== noErr
)
4063 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4065 result
= mac_get_object_from_code (finder_info
.fdType
);
4070 if (status
!= noErr
) {
4071 error ("Error while getting file information.");
4076 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4077 doc
: /* Set creator code of file FILENAME to CODE.
4078 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4079 assumed. Return non-nil if successful. */)
4081 Lisp_Object filename
, code
;
4090 CHECK_STRING (filename
);
4092 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4094 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4097 filename
= Fexpand_file_name (filename
, Qnil
);
4101 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4103 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4106 if (status
== noErr
)
4109 FSCatalogInfo catalogInfo
;
4111 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4112 &catalogInfo
, NULL
, NULL
, &parentDir
);
4116 status
= FSpGetFInfo (&fss
, &finder_info
);
4118 if (status
== noErr
)
4121 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4122 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4123 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4125 finder_info
.fdCreator
= cCode
;
4126 status
= FSpSetFInfo (&fss
, &finder_info
);
4131 if (status
!= noErr
) {
4132 error ("Error while setting creator information.");
4137 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4138 doc
: /* Set file code of file FILENAME to CODE.
4139 CODE must be a 4-character string. Return non-nil if successful. */)
4141 Lisp_Object filename
, code
;
4150 CHECK_STRING (filename
);
4152 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4154 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4157 filename
= Fexpand_file_name (filename
, Qnil
);
4161 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4163 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4166 if (status
== noErr
)
4169 FSCatalogInfo catalogInfo
;
4171 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4172 &catalogInfo
, NULL
, NULL
, &parentDir
);
4176 status
= FSpGetFInfo (&fss
, &finder_info
);
4178 if (status
== noErr
)
4181 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4182 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4183 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4185 finder_info
.fdType
= cCode
;
4186 status
= FSpSetFInfo (&fss
, &finder_info
);
4191 if (status
!= noErr
) {
4192 error ("Error while setting creator information.");
4198 /* Compile and execute the AppleScript SCRIPT and return the error
4199 status as function value. A zero is returned if compilation and
4200 execution is successful, in which case *RESULT is set to a Lisp
4201 string containing the resulting script value. Otherwise, the Mac
4202 error code is returned and *RESULT is set to an error Lisp string.
4203 For documentation on the MacOS scripting architecture, see Inside
4204 Macintosh - Interapplication Communications: Scripting
4208 do_applescript (script
, result
)
4209 Lisp_Object script
, *result
;
4211 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4217 if (!as_scripting_component
)
4218 initialize_applescript();
4220 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4225 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4226 typeChar
, kOSAModeNull
, &result_desc
);
4228 if (osaerror
== noErr
)
4229 /* success: retrieve resulting script value */
4230 desc
= &result_desc
;
4231 else if (osaerror
== errOSAScriptError
)
4232 /* error executing AppleScript: retrieve error message */
4233 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4239 #if TARGET_API_MAC_CARBON
4240 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4241 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4242 #else /* not TARGET_API_MAC_CARBON */
4243 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4244 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4245 #endif /* not TARGET_API_MAC_CARBON */
4246 AEDisposeDesc (desc
);
4249 AEDisposeDesc (&script_desc
);
4255 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4256 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4257 If compilation and execution are successful, the resulting script
4258 value is returned as a string. Otherwise the function aborts and
4259 displays the error message returned by the AppleScript scripting
4267 CHECK_STRING (script
);
4270 status
= do_applescript (script
, &result
);
4274 else if (!STRINGP (result
))
4275 error ("AppleScript error %d", status
);
4277 error ("%s", SDATA (result
));
4281 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4282 Smac_file_name_to_posix
, 1, 1, 0,
4283 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4285 Lisp_Object filename
;
4287 char posix_filename
[MAXPATHLEN
+1];
4289 CHECK_STRING (filename
);
4291 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4292 return build_string (posix_filename
);
4298 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4299 Sposix_file_name_to_mac
, 1, 1, 0,
4300 doc
: /* Convert Posix FILENAME to Mac form. */)
4302 Lisp_Object filename
;
4304 char mac_filename
[MAXPATHLEN
+1];
4306 CHECK_STRING (filename
);
4308 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4309 return build_string (mac_filename
);
4315 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4316 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4317 Each type should be a string of length 4 or the symbol
4318 `undecoded-file-name'. */)
4319 (src_type
, src_data
, dst_type
)
4320 Lisp_Object src_type
, src_data
, dst_type
;
4323 Lisp_Object result
= Qnil
;
4324 DescType src_desc_type
, dst_desc_type
;
4327 CHECK_STRING (src_data
);
4328 if (EQ (src_type
, Qundecoded_file_name
))
4329 src_desc_type
= TYPE_FILE_NAME
;
4331 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4333 if (EQ (dst_type
, Qundecoded_file_name
))
4334 dst_desc_type
= TYPE_FILE_NAME
;
4336 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4339 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4340 dst_desc_type
, &dst_desc
);
4343 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4344 AEDisposeDesc (&dst_desc
);
4352 #if TARGET_API_MAC_CARBON
4353 static Lisp_Object Qxml
, Qmime_charset
;
4354 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4356 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4357 doc
: /* Return the application preference value for KEY.
4358 KEY is either a string specifying a preference key, or a list of key
4359 strings. If it is a list, the (i+1)-th element is used as a key for
4360 the CFDictionary value obtained by the i-th element. Return nil if
4361 lookup is failed at some stage.
4363 Optional arg APPLICATION is an application ID string. If omitted or
4364 nil, that stands for the current application.
4366 Optional arg FORMAT specifies the data format of the return value. If
4367 omitted or nil, each Core Foundation object is converted into a
4368 corresponding Lisp object as follows:
4370 Core Foundation Lisp Tag
4371 ------------------------------------------------------------
4372 CFString Multibyte string string
4373 CFNumber Integer or float number
4374 CFBoolean Symbol (t or nil) boolean
4375 CFDate List of three integers date
4376 (cf. `current-time')
4377 CFData Unibyte string data
4378 CFArray Vector array
4379 CFDictionary Alist or hash table dictionary
4380 (depending on HASH-BOUND)
4382 If it is t, a symbol that represents the type of the original Core
4383 Foundation object is prepended. If it is `xml', the value is returned
4384 as an XML representation.
4386 Optional arg HASH-BOUND specifies which kinds of the list objects,
4387 alists or hash tables, are used as the targets of the conversion from
4388 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4389 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4390 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4392 (key
, application
, format
, hash_bound
)
4393 Lisp_Object key
, application
, format
, hash_bound
;
4395 CFStringRef app_id
, key_str
;
4396 CFPropertyListRef app_plist
= NULL
, plist
;
4397 Lisp_Object result
= Qnil
, tmp
;
4400 key
= Fcons (key
, Qnil
);
4404 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4405 CHECK_STRING_CAR (tmp
);
4407 wrong_type_argument (Qlistp
, key
);
4409 if (!NILP (application
))
4410 CHECK_STRING (application
);
4411 CHECK_SYMBOL (format
);
4412 if (!NILP (hash_bound
))
4413 CHECK_NUMBER (hash_bound
);
4417 app_id
= kCFPreferencesCurrentApplication
;
4418 if (!NILP (application
))
4420 app_id
= cfstring_create_with_string (application
);
4424 key_str
= cfstring_create_with_string (XCAR (key
));
4425 if (key_str
== NULL
)
4427 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4428 CFRelease (key_str
);
4429 if (app_plist
== NULL
)
4433 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4435 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4437 key_str
= cfstring_create_with_string (XCAR (key
));
4438 if (key_str
== NULL
)
4440 plist
= CFDictionaryGetValue (plist
, key_str
);
4441 CFRelease (key_str
);
4448 if (EQ (format
, Qxml
))
4450 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4453 result
= cfdata_to_lisp (data
);
4458 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4459 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4464 CFRelease (app_plist
);
4473 static CFStringEncoding
4474 get_cfstring_encoding_from_lisp (obj
)
4477 CFStringRef iana_name
;
4478 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4481 return kCFStringEncodingUnicode
;
4486 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4488 Lisp_Object coding_spec
, plist
;
4490 coding_spec
= Fget (obj
, Qcoding_system
);
4491 plist
= XVECTOR (coding_spec
)->contents
[3];
4492 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4496 obj
= SYMBOL_NAME (obj
);
4500 iana_name
= cfstring_create_with_string (obj
);
4503 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4504 CFRelease (iana_name
);
4511 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4513 cfstring_create_normalized (str
, symbol
)
4518 TextEncodingVariant variant
;
4519 float initial_mag
= 0.0;
4520 CFStringRef result
= NULL
;
4522 if (EQ (symbol
, QNFD
))
4523 form
= kCFStringNormalizationFormD
;
4524 else if (EQ (symbol
, QNFKD
))
4525 form
= kCFStringNormalizationFormKD
;
4526 else if (EQ (symbol
, QNFC
))
4527 form
= kCFStringNormalizationFormC
;
4528 else if (EQ (symbol
, QNFKC
))
4529 form
= kCFStringNormalizationFormKC
;
4530 else if (EQ (symbol
, QHFS_plus_D
))
4532 variant
= kUnicodeHFSPlusDecompVariant
;
4535 else if (EQ (symbol
, QHFS_plus_C
))
4537 variant
= kUnicodeHFSPlusCompVariant
;
4543 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4547 CFStringNormalize (mut_str
, form
);
4551 else if (initial_mag
> 0.0)
4553 UnicodeToTextInfo uni
= NULL
;
4556 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4558 ByteCount out_read
, out_size
, out_len
;
4560 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4562 kTextEncodingDefaultFormat
);
4563 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4565 kTextEncodingDefaultFormat
);
4566 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4568 length
= CFStringGetLength (str
);
4569 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4573 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4574 if (in_text
== NULL
)
4576 buffer
= xmalloc (sizeof (UniChar
) * length
);
4577 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4582 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4583 while (err
== noErr
)
4585 out_buf
= xmalloc (out_size
);
4586 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4588 kUnicodeDefaultDirectionMask
,
4589 0, NULL
, NULL
, NULL
,
4590 out_size
, &out_read
, &out_len
,
4592 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4601 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4602 out_len
/ sizeof (UniChar
));
4604 DisposeUnicodeToTextInfo (&uni
);
4620 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4621 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4622 The conversion is performed using the converter provided by the system.
4623 Each encoding is specified by either a coding system symbol, a mime
4624 charset string, or an integer as a CFStringEncoding value. Nil for
4625 encoding means UTF-16 in native byte order, no byte order mark.
4626 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4627 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4628 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4629 On successful conversion, return the result string, else return nil. */)
4630 (string
, source
, target
, normalization_form
)
4631 Lisp_Object string
, source
, target
, normalization_form
;
4633 Lisp_Object result
= Qnil
;
4634 CFStringEncoding src_encoding
, tgt_encoding
;
4635 CFStringRef str
= NULL
;
4637 CHECK_STRING (string
);
4638 if (!INTEGERP (source
) && !STRINGP (source
))
4639 CHECK_SYMBOL (source
);
4640 if (!INTEGERP (target
) && !STRINGP (target
))
4641 CHECK_SYMBOL (target
);
4642 CHECK_SYMBOL (normalization_form
);
4646 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4647 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4649 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4650 use string_as_unibyte which works as well, except for the fact that
4651 it's too permissive (it doesn't check that the multibyte string only
4652 contain single-byte chars). */
4653 string
= Fstring_as_unibyte (string
);
4654 if (src_encoding
!= kCFStringEncodingInvalidId
4655 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4656 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4657 src_encoding
, !NILP (source
));
4658 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4661 CFStringRef saved_str
= str
;
4663 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4664 CFRelease (saved_str
);
4669 CFIndex str_len
, buf_len
;
4671 str_len
= CFStringGetLength (str
);
4672 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4673 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4675 result
= make_uninit_string (buf_len
);
4676 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4677 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4686 #endif /* TARGET_API_MAC_CARBON */
4689 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
4690 doc
: /* Clear the font name table. */)
4694 mac_clear_font_name_table ();
4700 mac_get_system_locale ()
4708 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4709 region
= GetScriptManagerVariable (smRegionCode
);
4710 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4712 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4715 return build_string (str
);
4723 extern int inhibit_window_system
;
4724 extern int noninteractive
;
4726 /* Unlike in X11, window events in Carbon do not come from sockets.
4727 So we cannot simply use `select' to monitor two kinds of inputs:
4728 window events and process outputs. We emulate such functionality
4729 by regarding fd 0 as the window event channel and simultaneously
4730 monitoring both kinds of input channels. It is implemented by
4731 dividing into some cases:
4732 1. The window event channel is not involved.
4734 2. Sockets are not involved.
4735 -> Use ReceiveNextEvent.
4736 3. [If SELECT_USE_CFSOCKET is defined]
4737 Only the window event channel and socket read channels are
4738 involved, and timeout is not too short (greater than
4739 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4740 -> Create CFSocket for each socket and add it into the current
4741 event RunLoop so that a `ready-to-read' event can be posted
4742 to the event queue that is also used for window events. Then
4743 ReceiveNextEvent can wait for both kinds of inputs.
4745 -> Periodically poll the window input channel while repeatedly
4746 executing `select' with a short timeout
4747 (SELECT_POLLING_PERIOD_USEC microseconds). */
4749 #define SELECT_POLLING_PERIOD_USEC 20000
4750 #ifdef SELECT_USE_CFSOCKET
4751 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4752 #define EVENT_CLASS_SOCK 'Sock'
4755 socket_callback (s
, type
, address
, data
, info
)
4757 CFSocketCallBackType type
;
4764 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4765 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4766 ReleaseEvent (event
);
4768 #endif /* SELECT_USE_CFSOCKET */
4771 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4776 struct timeval
*timeout
;
4781 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4785 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4786 kEventLeaveInQueue
, NULL
);
4797 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4798 #undef SELECT_INVALIDATE_CFSOCKET
4802 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4807 struct timeval
*timeout
;
4811 EMACS_TIME select_timeout
;
4813 if (inhibit_window_system
|| noninteractive
4814 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4815 return select (n
, rfds
, wfds
, efds
, timeout
);
4819 if (wfds
== NULL
&& efds
== NULL
)
4822 SELECT_TYPE orfds
= *rfds
;
4824 EventTimeout timeout_sec
=
4826 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4827 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4828 : kEventDurationForever
);
4830 for (i
= 1; i
< n
; i
++)
4831 if (FD_ISSET (i
, rfds
))
4837 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4838 kEventLeaveInQueue
, NULL
);
4850 mac_prepare_for_quickdraw (NULL
);
4852 /* Avoid initial overhead of RunLoop setup for the case that
4853 some input is already available. */
4854 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4855 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4856 if (r
!= 0 || timeout_sec
== 0.0)
4861 #ifdef SELECT_USE_CFSOCKET
4862 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4863 goto poll_periodically
;
4866 CFRunLoopRef runloop
=
4867 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4868 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4869 #ifdef SELECT_INVALIDATE_CFSOCKET
4870 CFSocketRef
*shead
, *s
;
4872 CFRunLoopSourceRef
*shead
, *s
;
4877 #ifdef SELECT_INVALIDATE_CFSOCKET
4878 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4880 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4883 for (i
= 1; i
< n
; i
++)
4884 if (FD_ISSET (i
, rfds
))
4886 CFSocketRef socket
=
4887 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4888 socket_callback
, NULL
);
4889 CFRunLoopSourceRef source
=
4890 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4892 #ifdef SELECT_INVALIDATE_CFSOCKET
4893 CFSocketSetSocketFlags (socket
, 0);
4895 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4896 #ifdef SELECT_INVALIDATE_CFSOCKET
4906 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4911 #ifdef SELECT_INVALIDATE_CFSOCKET
4912 CFSocketInvalidate (*s
);
4914 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4929 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4930 GetEventTypeCount (specs
),
4932 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4933 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4940 #endif /* SELECT_USE_CFSOCKET */
4945 EMACS_TIME end_time
, now
, remaining_time
;
4946 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4954 remaining_time
= *timeout
;
4955 EMACS_GET_TIME (now
);
4956 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4961 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4962 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4963 select_timeout
= remaining_time
;
4964 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4976 EMACS_GET_TIME (now
);
4977 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4980 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4991 /* Set up environment variables so that Emacs can correctly find its
4992 support files when packaged as an application bundle. Directories
4993 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4994 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4995 by `make install' by default can instead be placed in
4996 .../Emacs.app/Contents/Resources/ and
4997 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4998 is changed only if it is not already set. Presumably if the user
4999 sets an environment variable, he will want to use files in his path
5000 instead of ones in the application bundle. */
5002 init_mac_osx_environment ()
5006 CFStringRef cf_app_bundle_pathname
;
5007 int app_bundle_pathname_len
;
5008 char *app_bundle_pathname
;
5012 /* Initialize locale related variables. */
5013 mac_system_script_code
=
5014 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5015 Vmac_system_locale
= mac_get_system_locale ();
5017 /* Fetch the pathname of the application bundle as a C string into
5018 app_bundle_pathname. */
5020 bundle
= CFBundleGetMainBundle ();
5021 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5023 /* We could not find the bundle identifier. For now, prevent
5024 the fatal error by bringing it up in the terminal. */
5025 inhibit_window_system
= 1;
5029 bundleURL
= CFBundleCopyBundleURL (bundle
);
5033 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5034 kCFURLPOSIXPathStyle
);
5035 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5036 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5038 if (!CFStringGetCString (cf_app_bundle_pathname
,
5039 app_bundle_pathname
,
5040 app_bundle_pathname_len
+ 1,
5041 kCFStringEncodingISOLatin1
))
5043 CFRelease (cf_app_bundle_pathname
);
5047 CFRelease (cf_app_bundle_pathname
);
5049 /* P should have sufficient room for the pathname of the bundle plus
5050 the subpath in it leading to the respective directories. Q
5051 should have three times that much room because EMACSLOADPATH can
5052 have the value "<path to lisp dir>:<path to leim dir>:<path to
5054 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5055 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5056 if (!getenv ("EMACSLOADPATH"))
5060 strcpy (p
, app_bundle_pathname
);
5061 strcat (p
, "/Contents/Resources/lisp");
5062 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5065 strcpy (p
, app_bundle_pathname
);
5066 strcat (p
, "/Contents/Resources/leim");
5067 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5074 strcpy (p
, app_bundle_pathname
);
5075 strcat (p
, "/Contents/Resources/site-lisp");
5076 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5084 setenv ("EMACSLOADPATH", q
, 1);
5087 if (!getenv ("EMACSPATH"))
5091 strcpy (p
, app_bundle_pathname
);
5092 strcat (p
, "/Contents/MacOS/libexec");
5093 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5096 strcpy (p
, app_bundle_pathname
);
5097 strcat (p
, "/Contents/MacOS/bin");
5098 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5106 setenv ("EMACSPATH", q
, 1);
5109 if (!getenv ("EMACSDATA"))
5111 strcpy (p
, app_bundle_pathname
);
5112 strcat (p
, "/Contents/Resources/etc");
5113 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5114 setenv ("EMACSDATA", p
, 1);
5117 if (!getenv ("EMACSDOC"))
5119 strcpy (p
, app_bundle_pathname
);
5120 strcat (p
, "/Contents/Resources/etc");
5121 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5122 setenv ("EMACSDOC", p
, 1);
5125 if (!getenv ("INFOPATH"))
5127 strcpy (p
, app_bundle_pathname
);
5128 strcat (p
, "/Contents/Resources/info");
5129 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5130 setenv ("INFOPATH", p
, 1);
5133 #endif /* MAC_OSX */
5139 Qundecoded_file_name
= intern ("undecoded-file-name");
5140 staticpro (&Qundecoded_file_name
);
5142 #if TARGET_API_MAC_CARBON
5143 Qstring
= intern ("string"); staticpro (&Qstring
);
5144 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5145 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5146 Qdate
= intern ("date"); staticpro (&Qdate
);
5147 Qdata
= intern ("data"); staticpro (&Qdata
);
5148 Qarray
= intern ("array"); staticpro (&Qarray
);
5149 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5151 Qxml
= intern ("xml");
5154 Qmime_charset
= intern ("mime-charset");
5155 staticpro (&Qmime_charset
);
5157 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5158 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5159 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5160 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5161 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5162 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5165 defsubr (&Smac_coerce_ae_data
);
5166 #if TARGET_API_MAC_CARBON
5167 defsubr (&Smac_get_preference
);
5168 defsubr (&Smac_code_convert_string
);
5170 defsubr (&Smac_clear_font_name_table
);
5172 defsubr (&Smac_set_file_creator
);
5173 defsubr (&Smac_set_file_type
);
5174 defsubr (&Smac_get_file_creator
);
5175 defsubr (&Smac_get_file_type
);
5176 defsubr (&Sdo_applescript
);
5177 defsubr (&Smac_file_name_to_posix
);
5178 defsubr (&Sposix_file_name_to_mac
);
5180 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5181 doc
: /* The system script code. */);
5182 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5184 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5185 doc
: /* The system locale identifier string.
5186 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5187 information is not included. */);
5188 Vmac_system_locale
= mac_get_system_locale ();
5191 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5192 (do not change this comment) */