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 const 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 (class, id
, result
)
675 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
676 AEAddressDesc address_desc
;
678 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
679 sizeof (ProcessSerialNumber
), &address_desc
);
682 err
= AECreateAppleEvent (class, id
,
683 &address_desc
, /* NULL is not allowed
684 on Mac OS Classic. */
685 kAutoGenerateReturnID
,
686 kAnyTransactionID
, result
);
687 AEDisposeDesc (&address_desc
);
694 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
697 EventParamName
*names
;
698 EventParamType
*types
;
707 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
711 for (i
= 0; i
< num_params
; i
++)
715 case typeCFStringRef
:
716 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
717 sizeof (CFStringRef
), NULL
, &string
);
720 data
= CFStringCreateExternalRepresentation (NULL
, string
,
721 kCFStringEncodingUTF8
,
725 /* typeUTF8Text is not available on Mac OS X 10.1. */
726 AEPutParamPtr (result
, names
[i
], 'utf8',
727 CFDataGetBytePtr (data
), CFDataGetLength (data
));
733 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
737 buf
= xrealloc (buf
, size
);
738 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
741 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
751 create_apple_event_from_drag_ref (drag
, num_types
, types
, result
)
763 err
= CountDragItems (drag
, &num_items
);
766 err
= AECreateList (NULL
, 0, false, &items
);
770 for (index
= 1; index
<= num_items
; index
++)
773 DescType desc_type
= typeNull
;
776 err
= GetDragItemReferenceNumber (drag
, index
, &item
);
781 for (i
= 0; i
< num_types
; i
++)
783 err
= GetFlavorDataSize (drag
, item
, types
[i
], &size
);
786 buf
= xrealloc (buf
, size
);
787 err
= GetFlavorData (drag
, item
, types
[i
], buf
, &size
, 0);
791 desc_type
= types
[i
];
796 err
= AEPutPtr (&items
, index
, desc_type
,
797 desc_type
!= typeNull
? buf
: NULL
,
798 desc_type
!= typeNull
? size
: 0);
807 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
809 err
= AEPutParamDesc (result
, keyDirectObject
, &items
);
811 AEDisposeDesc (result
);
814 AEDisposeDesc (&items
);
818 #endif /* TARGET_API_MAC_CARBON */
820 /***********************************************************************
821 Conversion between Lisp and Core Foundation objects
822 ***********************************************************************/
824 #if TARGET_API_MAC_CARBON
825 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
826 static Lisp_Object Qarray
, Qdictionary
;
828 struct cfdict_context
831 int with_tag
, hash_bound
;
834 /* C string to CFString. */
837 cfstring_create_with_utf8_cstring (c_str
)
842 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
844 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
845 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
851 /* Lisp string to CFString. */
854 cfstring_create_with_string (s
)
857 CFStringRef string
= NULL
;
859 if (STRING_MULTIBYTE (s
))
861 char *p
, *end
= SDATA (s
) + SBYTES (s
);
863 for (p
= SDATA (s
); p
< end
; p
++)
866 s
= ENCODE_UTF_8 (s
);
869 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
870 kCFStringEncodingUTF8
, false);
874 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
875 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
876 kCFStringEncodingMacRoman
, false);
882 /* From CFData to a lisp string. Always returns a unibyte string. */
885 cfdata_to_lisp (data
)
888 CFIndex len
= CFDataGetLength (data
);
889 Lisp_Object result
= make_uninit_string (len
);
891 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
897 /* From CFString to a lisp string. Returns a unibyte string
898 containing a UTF-8 byte sequence. */
901 cfstring_to_lisp_nodecode (string
)
904 Lisp_Object result
= Qnil
;
905 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
908 result
= make_unibyte_string (s
, strlen (s
));
912 CFStringCreateExternalRepresentation (NULL
, string
,
913 kCFStringEncodingUTF8
, '?');
917 result
= cfdata_to_lisp (data
);
926 /* From CFString to a lisp string. Never returns a unibyte string
927 (even if it only contains ASCII characters).
928 This may cause GC during code conversion. */
931 cfstring_to_lisp (string
)
934 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
938 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
939 /* This may be superfluous. Just to make sure that the result
940 is a multibyte string. */
941 result
= string_to_multibyte (result
);
948 /* CFNumber to a lisp integer or a lisp float. */
951 cfnumber_to_lisp (number
)
954 Lisp_Object result
= Qnil
;
955 #if BITS_PER_EMACS_INT > 32
957 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
960 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
964 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
965 && !FIXNUM_OVERFLOW_P (int_val
))
966 result
= make_number (int_val
);
968 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
969 result
= make_float (float_val
);
974 /* CFDate to a list of three integers as in a return value of
978 cfdate_to_lisp (date
)
981 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
982 static CFAbsoluteTime epoch
= 0.0, sec
;
986 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
988 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
989 high
= sec
/ 65536.0;
990 low
= sec
- high
* 65536.0;
992 return list3 (make_number (high
), make_number (low
), make_number (0));
996 /* CFBoolean to a lisp symbol, `t' or `nil'. */
999 cfboolean_to_lisp (boolean
)
1000 CFBooleanRef boolean
;
1002 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
1006 /* Any Core Foundation object to a (lengthy) lisp string. */
1009 cfobject_desc_to_lisp (object
)
1012 Lisp_Object result
= Qnil
;
1013 CFStringRef desc
= CFCopyDescription (object
);
1017 result
= cfstring_to_lisp (desc
);
1025 /* Callback functions for cfproperty_list_to_lisp. */
1028 cfdictionary_add_to_list (key
, value
, context
)
1033 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1036 Fcons (Fcons (cfstring_to_lisp (key
),
1037 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
1043 cfdictionary_puthash (key
, value
, context
)
1048 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
1049 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1050 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
1053 hash_lookup (h
, lisp_key
, &hash_code
);
1054 hash_put (h
, lisp_key
,
1055 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
1060 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1061 non-zero, a symbol that represents the type of the original Core
1062 Foundation object is prepended. HASH_BOUND specifies which kinds
1063 of the lisp objects, alists or hash tables, are used as the targets
1064 of the conversion from CFDictionary. If HASH_BOUND is negative,
1065 always generate alists. If HASH_BOUND >= 0, generate an alist if
1066 the number of keys in the dictionary is smaller than HASH_BOUND,
1067 and a hash table otherwise. */
1070 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
1071 CFPropertyListRef plist
;
1072 int with_tag
, hash_bound
;
1074 CFTypeID type_id
= CFGetTypeID (plist
);
1075 Lisp_Object tag
= Qnil
, result
= Qnil
;
1076 struct gcpro gcpro1
, gcpro2
;
1078 GCPRO2 (tag
, result
);
1080 if (type_id
== CFStringGetTypeID ())
1083 result
= cfstring_to_lisp (plist
);
1085 else if (type_id
== CFNumberGetTypeID ())
1088 result
= cfnumber_to_lisp (plist
);
1090 else if (type_id
== CFBooleanGetTypeID ())
1093 result
= cfboolean_to_lisp (plist
);
1095 else if (type_id
== CFDateGetTypeID ())
1098 result
= cfdate_to_lisp (plist
);
1100 else if (type_id
== CFDataGetTypeID ())
1103 result
= cfdata_to_lisp (plist
);
1105 else if (type_id
== CFArrayGetTypeID ())
1107 CFIndex index
, count
= CFArrayGetCount (plist
);
1110 result
= Fmake_vector (make_number (count
), Qnil
);
1111 for (index
= 0; index
< count
; index
++)
1112 XVECTOR (result
)->contents
[index
] =
1113 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1114 with_tag
, hash_bound
);
1116 else if (type_id
== CFDictionaryGetTypeID ())
1118 struct cfdict_context context
;
1119 CFIndex count
= CFDictionaryGetCount (plist
);
1122 context
.result
= &result
;
1123 context
.with_tag
= with_tag
;
1124 context
.hash_bound
= hash_bound
;
1125 if (hash_bound
< 0 || count
< hash_bound
)
1128 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1133 result
= make_hash_table (Qequal
,
1134 make_number (count
),
1135 make_float (DEFAULT_REHASH_SIZE
),
1136 make_float (DEFAULT_REHASH_THRESHOLD
),
1138 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1148 result
= Fcons (tag
, result
);
1155 /***********************************************************************
1156 Emulation of the X Resource Manager
1157 ***********************************************************************/
1159 /* Parser functions for resource lines. Each function takes an
1160 address of a variable whose value points to the head of a string.
1161 The value will be advanced so that it points to the next character
1162 of the parsed part when the function returns.
1164 A resource name such as "Emacs*font" is parsed into a non-empty
1165 list called `quarks'. Each element is either a Lisp string that
1166 represents a concrete component, a Lisp symbol LOOSE_BINDING
1167 (actually Qlambda) that represents any number (>=0) of intervening
1168 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1169 that represents as any single component. */
1173 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1174 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1177 skip_white_space (p
)
1180 /* WhiteSpace = {<space> | <horizontal tab>} */
1181 while (*P
== ' ' || *P
== '\t')
1189 /* Comment = "!" {<any character except null or newline>} */
1202 /* Don't interpret filename. Just skip until the newline. */
1204 parse_include_file (p
)
1207 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1224 /* Binding = "." | "*" */
1225 if (*P
== '.' || *P
== '*')
1227 char binding
= *P
++;
1229 while (*P
== '.' || *P
== '*')
1242 /* Component = "?" | ComponentName
1243 ComponentName = NameChar {NameChar}
1244 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1248 return SINGLE_COMPONENT
;
1250 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1254 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1257 return make_unibyte_string (start
, P
- start
);
1264 parse_resource_name (p
)
1267 Lisp_Object result
= Qnil
, component
;
1270 /* ResourceName = [Binding] {Component Binding} ComponentName */
1271 if (parse_binding (p
) == '*')
1272 result
= Fcons (LOOSE_BINDING
, result
);
1274 component
= parse_component (p
);
1275 if (NILP (component
))
1278 result
= Fcons (component
, result
);
1279 while ((binding
= parse_binding (p
)) != '\0')
1282 result
= Fcons (LOOSE_BINDING
, result
);
1283 component
= parse_component (p
);
1284 if (NILP (component
))
1287 result
= Fcons (component
, result
);
1290 /* The final component should not be '?'. */
1291 if (EQ (component
, SINGLE_COMPONENT
))
1294 return Fnreverse (result
);
1302 Lisp_Object seq
= Qnil
, result
;
1303 int buf_len
, total_len
= 0, len
, continue_p
;
1305 q
= strchr (P
, '\n');
1306 buf_len
= q
? q
- P
: strlen (P
);
1307 buf
= xmalloc (buf_len
);
1320 else if (*P
== '\\')
1325 else if (*P
== '\n')
1336 else if ('0' <= P
[0] && P
[0] <= '7'
1337 && '0' <= P
[1] && P
[1] <= '7'
1338 && '0' <= P
[2] && P
[2] <= '7')
1340 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1350 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1355 q
= strchr (P
, '\n');
1356 len
= q
? q
- P
: strlen (P
);
1361 buf
= xmalloc (buf_len
);
1369 if (SBYTES (XCAR (seq
)) == total_len
)
1370 return make_string (SDATA (XCAR (seq
)), total_len
);
1373 buf
= xmalloc (total_len
);
1374 q
= buf
+ total_len
;
1375 for (; CONSP (seq
); seq
= XCDR (seq
))
1377 len
= SBYTES (XCAR (seq
));
1379 memcpy (q
, SDATA (XCAR (seq
)), len
);
1381 result
= make_string (buf
, total_len
);
1388 parse_resource_line (p
)
1391 Lisp_Object quarks
, value
;
1393 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1394 if (parse_comment (p
) || parse_include_file (p
))
1397 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1398 skip_white_space (p
);
1399 quarks
= parse_resource_name (p
);
1402 skip_white_space (p
);
1406 skip_white_space (p
);
1407 value
= parse_value (p
);
1408 return Fcons (quarks
, value
);
1411 /* Skip the remaining data as a dummy value. */
1418 /* Equivalents of X Resource Manager functions.
1420 An X Resource Database acts as a collection of resource names and
1421 associated values. It is implemented as a trie on quarks. Namely,
1422 each edge is labeled by either a string, LOOSE_BINDING, or
1423 SINGLE_COMPONENT. Each node has a node id, which is a unique
1424 nonnegative integer, and the root node id is 0. A database is
1425 implemented as a hash table that maps a pair (SRC-NODE-ID .
1426 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1427 in the table as a value for HASHKEY_MAX_NID. A value associated to
1428 a node is recorded as a value for the node id.
1430 A database also has a cache for past queries as a value for
1431 HASHKEY_QUERY_CACHE. It is another hash table that maps
1432 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1434 #define HASHKEY_MAX_NID (make_number (0))
1435 #define HASHKEY_QUERY_CACHE (make_number (-1))
1438 xrm_create_database ()
1440 XrmDatabase database
;
1442 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1443 make_float (DEFAULT_REHASH_SIZE
),
1444 make_float (DEFAULT_REHASH_THRESHOLD
),
1446 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1447 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1453 xrm_q_put_resource (database
, quarks
, value
)
1454 XrmDatabase database
;
1455 Lisp_Object quarks
, value
;
1457 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1460 Lisp_Object node_id
, key
;
1462 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1464 XSETINT (node_id
, 0);
1465 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1467 key
= Fcons (node_id
, XCAR (quarks
));
1468 i
= hash_lookup (h
, key
, &hash_code
);
1472 XSETINT (node_id
, max_nid
);
1473 hash_put (h
, key
, node_id
, hash_code
);
1476 node_id
= HASH_VALUE (h
, i
);
1478 Fputhash (node_id
, value
, database
);
1480 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1481 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1484 /* Merge multiple resource entries specified by DATA into a resource
1485 database DATABASE. DATA points to the head of a null-terminated
1486 string consisting of multiple resource lines. It's like a
1487 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1490 xrm_merge_string_database (database
, data
)
1491 XrmDatabase database
;
1494 Lisp_Object quarks_value
;
1498 quarks_value
= parse_resource_line (&data
);
1499 if (!NILP (quarks_value
))
1500 xrm_q_put_resource (database
,
1501 XCAR (quarks_value
), XCDR (quarks_value
));
1506 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1507 XrmDatabase database
;
1508 Lisp_Object node_id
, quark_name
, quark_class
;
1510 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1511 Lisp_Object key
, labels
[3], value
;
1514 if (!CONSP (quark_name
))
1515 return Fgethash (node_id
, database
, Qnil
);
1517 /* First, try tight bindings */
1518 labels
[0] = XCAR (quark_name
);
1519 labels
[1] = XCAR (quark_class
);
1520 labels
[2] = SINGLE_COMPONENT
;
1522 key
= Fcons (node_id
, Qnil
);
1523 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1525 XSETCDR (key
, labels
[k
]);
1526 i
= hash_lookup (h
, key
, NULL
);
1529 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1530 XCDR (quark_name
), XCDR (quark_class
));
1536 /* Then, try loose bindings */
1537 XSETCDR (key
, LOOSE_BINDING
);
1538 i
= hash_lookup (h
, key
, NULL
);
1541 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1542 quark_name
, quark_class
);
1546 return xrm_q_get_resource_1 (database
, node_id
,
1547 XCDR (quark_name
), XCDR (quark_class
));
1554 xrm_q_get_resource (database
, quark_name
, quark_class
)
1555 XrmDatabase database
;
1556 Lisp_Object quark_name
, quark_class
;
1558 return xrm_q_get_resource_1 (database
, make_number (0),
1559 quark_name
, quark_class
);
1562 /* Retrieve a resource value for the specified NAME and CLASS from the
1563 resource database DATABASE. It corresponds to XrmGetResource. */
1566 xrm_get_resource (database
, name
, class)
1567 XrmDatabase database
;
1570 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1572 struct Lisp_Hash_Table
*h
;
1576 nc
= strlen (class);
1577 key
= make_uninit_string (nn
+ nc
+ 1);
1578 strcpy (SDATA (key
), name
);
1579 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1581 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1582 if (NILP (query_cache
))
1584 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1585 make_float (DEFAULT_REHASH_SIZE
),
1586 make_float (DEFAULT_REHASH_THRESHOLD
),
1588 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1590 h
= XHASH_TABLE (query_cache
);
1591 i
= hash_lookup (h
, key
, &hash_code
);
1593 return HASH_VALUE (h
, i
);
1595 quark_name
= parse_resource_name (&name
);
1598 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1599 if (!STRINGP (XCAR (tmp
)))
1602 quark_class
= parse_resource_name (&class);
1605 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1606 if (!STRINGP (XCAR (tmp
)))
1613 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1614 hash_put (h
, key
, tmp
, hash_code
);
1619 #if TARGET_API_MAC_CARBON
1621 xrm_cfproperty_list_to_value (plist
)
1622 CFPropertyListRef plist
;
1624 CFTypeID type_id
= CFGetTypeID (plist
);
1626 if (type_id
== CFStringGetTypeID ())
1627 return cfstring_to_lisp (plist
);
1628 else if (type_id
== CFNumberGetTypeID ())
1631 Lisp_Object result
= Qnil
;
1633 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1636 result
= cfstring_to_lisp (string
);
1641 else if (type_id
== CFBooleanGetTypeID ())
1642 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1643 else if (type_id
== CFDataGetTypeID ())
1644 return cfdata_to_lisp (plist
);
1650 /* Create a new resource database from the preferences for the
1651 application APPLICATION. APPLICATION is either a string that
1652 specifies an application ID, or NULL that represents the current
1656 xrm_get_preference_database (application
)
1659 #if TARGET_API_MAC_CARBON
1660 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1661 CFMutableSetRef key_set
= NULL
;
1662 CFArrayRef key_array
;
1663 CFIndex index
, count
;
1665 XrmDatabase database
;
1666 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1667 CFPropertyListRef plist
;
1669 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1671 user_doms
[0] = kCFPreferencesCurrentUser
;
1672 user_doms
[1] = kCFPreferencesAnyUser
;
1673 host_doms
[0] = kCFPreferencesCurrentHost
;
1674 host_doms
[1] = kCFPreferencesAnyHost
;
1676 database
= xrm_create_database ();
1678 GCPRO3 (database
, quarks
, value
);
1682 app_id
= kCFPreferencesCurrentApplication
;
1685 app_id
= cfstring_create_with_utf8_cstring (application
);
1690 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1691 if (key_set
== NULL
)
1693 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1694 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1696 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1700 count
= CFArrayGetCount (key_array
);
1701 for (index
= 0; index
< count
; index
++)
1702 CFSetAddValue (key_set
,
1703 CFArrayGetValueAtIndex (key_array
, index
));
1704 CFRelease (key_array
);
1708 count
= CFSetGetCount (key_set
);
1709 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1710 CFSetGetValues (key_set
, (const void **)keys
);
1711 for (index
= 0; index
< count
; index
++)
1713 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1714 quarks
= parse_resource_name (&res_name
);
1715 if (!(NILP (quarks
) || *res_name
))
1717 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1718 value
= xrm_cfproperty_list_to_value (plist
);
1721 xrm_q_put_resource (database
, quarks
, value
);
1728 CFRelease (key_set
);
1737 return xrm_create_database ();
1744 /* The following functions with "sys_" prefix are stubs to Unix
1745 functions that have already been implemented by CW or MPW. The
1746 calls to them in Emacs source course are #define'd to call the sys_
1747 versions by the header files s-mac.h. In these stubs pathnames are
1748 converted between their Unix and Mac forms. */
1751 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1752 + 17 leap days. These are for adjusting time values returned by
1753 MacOS Toolbox functions. */
1755 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1758 #if __MSL__ < 0x6000
1759 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1760 a leap year! This is for adjusting time_t values returned by MSL
1762 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1763 #else /* __MSL__ >= 0x6000 */
1764 /* CW changes Pro 6 to follow Unix! */
1765 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1766 #endif /* __MSL__ >= 0x6000 */
1768 /* MPW library functions follow Unix (confused?). */
1769 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1770 #else /* not __MRC__ */
1772 #endif /* not __MRC__ */
1775 /* Define our own stat function for both MrC and CW. The reason for
1776 doing this: "stat" is both the name of a struct and function name:
1777 can't use the same trick like that for sys_open, sys_close, etc. to
1778 redirect Emacs's calls to our own version that converts Unix style
1779 filenames to Mac style filename because all sorts of compilation
1780 errors will be generated if stat is #define'd to be sys_stat. */
1783 stat_noalias (const char *path
, struct stat
*buf
)
1785 char mac_pathname
[MAXPATHLEN
+1];
1788 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1791 c2pstr (mac_pathname
);
1792 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1793 cipb
.hFileInfo
.ioVRefNum
= 0;
1794 cipb
.hFileInfo
.ioDirID
= 0;
1795 cipb
.hFileInfo
.ioFDirIndex
= 0;
1796 /* set to 0 to get information about specific dir or file */
1798 errno
= PBGetCatInfo (&cipb
, false);
1799 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1804 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1806 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1808 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1809 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1810 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1811 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1812 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1813 /* size of dir = number of files and dirs */
1816 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1817 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1821 buf
->st_mode
= S_IFREG
| S_IREAD
;
1822 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1823 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1824 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1825 buf
->st_mode
|= S_IEXEC
;
1826 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1827 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1828 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1831 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1832 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1835 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1837 /* identify alias files as symlinks */
1838 buf
->st_mode
&= ~S_IFREG
;
1839 buf
->st_mode
|= S_IFLNK
;
1843 buf
->st_uid
= getuid ();
1844 buf
->st_gid
= getgid ();
1852 lstat (const char *path
, struct stat
*buf
)
1855 char true_pathname
[MAXPATHLEN
+1];
1857 /* Try looking for the file without resolving aliases first. */
1858 if ((result
= stat_noalias (path
, buf
)) >= 0)
1861 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1864 return stat_noalias (true_pathname
, buf
);
1869 stat (const char *path
, struct stat
*sb
)
1872 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1875 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1876 ! (sb
->st_mode
& S_IFLNK
))
1879 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1882 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1885 fully_resolved_name
[len
] = '\0';
1886 /* in fact our readlink terminates strings */
1887 return lstat (fully_resolved_name
, sb
);
1890 return lstat (true_pathname
, sb
);
1895 /* CW defines fstat in stat.mac.c while MPW does not provide this
1896 function. Without the information of how to get from a file
1897 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1898 to implement this function. Fortunately, there is only one place
1899 where this function is called in our configuration: in fileio.c,
1900 where only the st_dev and st_ino fields are used to determine
1901 whether two fildes point to different i-nodes to prevent copying
1902 a file onto itself equal. What we have here probably needs
1906 fstat (int fildes
, struct stat
*buf
)
1909 buf
->st_ino
= fildes
;
1910 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1911 return 0; /* success */
1913 #endif /* __MRC__ */
1917 mkdir (const char *dirname
, int mode
)
1919 #pragma unused(mode)
1922 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1924 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1927 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1930 c2pstr (mac_pathname
);
1931 hfpb
.ioNamePtr
= mac_pathname
;
1932 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1933 hfpb
.ioDirID
= 0; /* parent is the root */
1935 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1936 /* just return the Mac OSErr code for now */
1937 return errno
== noErr
? 0 : -1;
1942 sys_rmdir (const char *dirname
)
1945 char mac_pathname
[MAXPATHLEN
+1];
1947 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1950 c2pstr (mac_pathname
);
1951 hfpb
.ioNamePtr
= mac_pathname
;
1952 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1953 hfpb
.ioDirID
= 0; /* parent is the root */
1955 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1956 return errno
== noErr
? 0 : -1;
1961 /* No implementation yet. */
1963 execvp (const char *path
, ...)
1967 #endif /* __MRC__ */
1971 utime (const char *path
, const struct utimbuf
*times
)
1973 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1975 char mac_pathname
[MAXPATHLEN
+1];
1978 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1981 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1983 fully_resolved_name
[len
] = '\0';
1985 strcpy (fully_resolved_name
, true_pathname
);
1987 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1990 c2pstr (mac_pathname
);
1991 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1992 cipb
.hFileInfo
.ioVRefNum
= 0;
1993 cipb
.hFileInfo
.ioDirID
= 0;
1994 cipb
.hFileInfo
.ioFDirIndex
= 0;
1995 /* set to 0 to get information about specific dir or file */
1997 errno
= PBGetCatInfo (&cipb
, false);
2001 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
2004 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2006 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
2011 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2013 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
2016 errno
= PBSetCatInfo (&cipb
, false);
2017 return errno
== noErr
? 0 : -1;
2031 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2033 access (const char *path
, int mode
)
2035 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2037 char mac_pathname
[MAXPATHLEN
+1];
2040 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2043 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2045 fully_resolved_name
[len
] = '\0';
2047 strcpy (fully_resolved_name
, true_pathname
);
2049 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2052 c2pstr (mac_pathname
);
2053 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2054 cipb
.hFileInfo
.ioVRefNum
= 0;
2055 cipb
.hFileInfo
.ioDirID
= 0;
2056 cipb
.hFileInfo
.ioFDirIndex
= 0;
2057 /* set to 0 to get information about specific dir or file */
2059 errno
= PBGetCatInfo (&cipb
, false);
2063 if (mode
== F_OK
) /* got this far, file exists */
2067 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
2071 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2078 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2079 /* don't allow if lock bit is on */
2085 #define DEV_NULL_FD 0x10000
2089 sys_open (const char *path
, int oflag
)
2091 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2093 char mac_pathname
[MAXPATHLEN
+1];
2095 if (strcmp (path
, "/dev/null") == 0)
2096 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2098 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2101 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2103 fully_resolved_name
[len
] = '\0';
2105 strcpy (fully_resolved_name
, true_pathname
);
2107 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2112 int res
= open (mac_pathname
, oflag
);
2113 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2114 if (oflag
& O_CREAT
)
2115 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2117 #else /* not __MRC__ */
2118 return open (mac_pathname
, oflag
);
2119 #endif /* not __MRC__ */
2126 sys_creat (const char *path
, mode_t mode
)
2128 char true_pathname
[MAXPATHLEN
+1];
2130 char mac_pathname
[MAXPATHLEN
+1];
2132 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2135 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2140 int result
= creat (mac_pathname
);
2141 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2143 #else /* not __MRC__ */
2144 return creat (mac_pathname
, mode
);
2145 #endif /* not __MRC__ */
2152 sys_unlink (const char *path
)
2154 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2156 char mac_pathname
[MAXPATHLEN
+1];
2158 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2161 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2163 fully_resolved_name
[len
] = '\0';
2165 strcpy (fully_resolved_name
, true_pathname
);
2167 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2170 return unlink (mac_pathname
);
2176 sys_read (int fildes
, char *buf
, int count
)
2178 if (fildes
== 0) /* this should not be used for console input */
2181 #if __MSL__ >= 0x6000
2182 return _read (fildes
, buf
, count
);
2184 return read (fildes
, buf
, count
);
2191 sys_write (int fildes
, const char *buf
, int count
)
2193 if (fildes
== DEV_NULL_FD
)
2196 #if __MSL__ >= 0x6000
2197 return _write (fildes
, buf
, count
);
2199 return write (fildes
, buf
, count
);
2206 sys_rename (const char * old_name
, const char * new_name
)
2208 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2209 char fully_resolved_old_name
[MAXPATHLEN
+1];
2211 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2213 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2216 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2218 fully_resolved_old_name
[len
] = '\0';
2220 strcpy (fully_resolved_old_name
, true_old_pathname
);
2222 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2225 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2228 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2233 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2236 /* If a file with new_name already exists, rename deletes the old
2237 file in Unix. CW version fails in these situation. So we add a
2238 call to unlink here. */
2239 (void) unlink (mac_new_name
);
2241 return rename (mac_old_name
, mac_new_name
);
2246 extern FILE *fopen (const char *name
, const char *mode
);
2248 sys_fopen (const char *name
, const char *mode
)
2250 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2252 char mac_pathname
[MAXPATHLEN
+1];
2254 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2257 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2259 fully_resolved_name
[len
] = '\0';
2261 strcpy (fully_resolved_name
, true_pathname
);
2263 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2268 if (mode
[0] == 'w' || mode
[0] == 'a')
2269 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2270 #endif /* not __MRC__ */
2271 return fopen (mac_pathname
, mode
);
2276 #include "keyboard.h"
2277 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2280 select (n
, rfds
, wfds
, efds
, timeout
)
2285 struct timeval
*timeout
;
2288 #if TARGET_API_MAC_CARBON
2289 EventTimeout timeout_sec
=
2291 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2292 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2293 : kEventDurationForever
);
2296 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2298 #else /* not TARGET_API_MAC_CARBON */
2300 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2301 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2303 /* Can only handle wait for keyboard input. */
2304 if (n
> 1 || wfds
|| efds
)
2307 /* Also return true if an event other than a keyDown has occurred.
2308 This causes kbd_buffer_get_event in keyboard.c to call
2309 read_avail_input which in turn calls XTread_socket to poll for
2310 these events. Otherwise these never get processed except but a
2311 very slow poll timer. */
2312 if (mac_wait_next_event (&e
, sleep_time
, false))
2315 err
= -9875; /* eventLoopTimedOutErr */
2316 #endif /* not TARGET_API_MAC_CARBON */
2318 if (FD_ISSET (0, rfds
))
2329 if (input_polling_used ())
2331 /* It could be confusing if a real alarm arrives while
2332 processing the fake one. Turn it off and let the
2333 handler reset it. */
2334 extern void poll_for_input_1
P_ ((void));
2335 int old_poll_suppress_count
= poll_suppress_count
;
2336 poll_suppress_count
= 1;
2337 poll_for_input_1 ();
2338 poll_suppress_count
= old_poll_suppress_count
;
2348 /* Simulation of SIGALRM. The stub for function signal stores the
2349 signal handler function in alarm_signal_func if a SIGALRM is
2353 #include "syssignal.h"
2355 static TMTask mac_atimer_task
;
2357 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2359 static int signal_mask
= 0;
2362 __sigfun alarm_signal_func
= (__sigfun
) 0;
2364 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2365 #else /* not __MRC__ and not __MWERKS__ */
2367 #endif /* not __MRC__ and not __MWERKS__ */
2371 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2373 sys_signal (int signal_num
, __sigfun signal_func
)
2375 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2377 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2378 #else /* not __MRC__ and not __MWERKS__ */
2380 #endif /* not __MRC__ and not __MWERKS__ */
2382 if (signal_num
!= SIGALRM
)
2383 return signal (signal_num
, signal_func
);
2387 __sigfun old_signal_func
;
2389 __signal_func_ptr old_signal_func
;
2393 old_signal_func
= alarm_signal_func
;
2394 alarm_signal_func
= signal_func
;
2395 return old_signal_func
;
2401 mac_atimer_handler (qlink
)
2404 if (alarm_signal_func
)
2405 (alarm_signal_func
) (SIGALRM
);
2410 set_mac_atimer (count
)
2413 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2415 if (mac_atimer_handlerUPP
== NULL
)
2416 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2417 mac_atimer_task
.tmCount
= 0;
2418 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2419 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2420 InsTime (mac_atimer_qlink
);
2422 PrimeTime (mac_atimer_qlink
, count
);
2427 remove_mac_atimer (remaining_count
)
2428 long *remaining_count
;
2430 if (mac_atimer_qlink
)
2432 RmvTime (mac_atimer_qlink
);
2433 if (remaining_count
)
2434 *remaining_count
= mac_atimer_task
.tmCount
;
2435 mac_atimer_qlink
= NULL
;
2447 int old_mask
= signal_mask
;
2449 signal_mask
|= mask
;
2451 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2452 remove_mac_atimer (NULL
);
2459 sigsetmask (int mask
)
2461 int old_mask
= signal_mask
;
2465 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2466 if (signal_mask
& sigmask (SIGALRM
))
2467 remove_mac_atimer (NULL
);
2469 set_mac_atimer (mac_atimer_task
.tmCount
);
2478 long remaining_count
;
2480 if (remove_mac_atimer (&remaining_count
) == 0)
2482 set_mac_atimer (seconds
* 1000);
2484 return remaining_count
/ 1000;
2488 mac_atimer_task
.tmCount
= seconds
* 1000;
2496 setitimer (which
, value
, ovalue
)
2498 const struct itimerval
*value
;
2499 struct itimerval
*ovalue
;
2501 long remaining_count
;
2502 long count
= (EMACS_SECS (value
->it_value
) * 1000
2503 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2505 if (remove_mac_atimer (&remaining_count
) == 0)
2509 bzero (ovalue
, sizeof (*ovalue
));
2510 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2511 (remaining_count
% 1000) * 1000);
2513 set_mac_atimer (count
);
2516 mac_atimer_task
.tmCount
= count
;
2522 /* gettimeofday should return the amount of time (in a timeval
2523 structure) since midnight today. The toolbox function Microseconds
2524 returns the number of microseconds (in a UnsignedWide value) since
2525 the machine was booted. Also making this complicated is WideAdd,
2526 WideSubtract, etc. take wide values. */
2533 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2534 UnsignedWide uw_microseconds
;
2535 wide w_microseconds
;
2536 time_t sys_time (time_t *);
2538 /* If this function is called for the first time, record the number
2539 of seconds since midnight and the number of microseconds since
2540 boot at the time of this first call. */
2545 systime
= sys_time (NULL
);
2546 /* Store microseconds since midnight in wall_clock_at_epoch. */
2547 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2548 Microseconds (&uw_microseconds
);
2549 /* Store microseconds since boot in clicks_at_epoch. */
2550 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2551 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2554 /* Get time since boot */
2555 Microseconds (&uw_microseconds
);
2557 /* Convert to time since midnight*/
2558 w_microseconds
.hi
= uw_microseconds
.hi
;
2559 w_microseconds
.lo
= uw_microseconds
.lo
;
2560 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2561 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2562 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2570 sleep (unsigned int seconds
)
2572 unsigned long time_up
;
2575 time_up
= TickCount () + seconds
* 60;
2576 while (TickCount () < time_up
)
2578 /* Accept no event; just wait. by T.I. */
2579 WaitNextEvent (0, &e
, 30, NULL
);
2584 #endif /* __MRC__ */
2587 /* The time functions adjust time values according to the difference
2588 between the Unix and CW epoches. */
2591 extern struct tm
*gmtime (const time_t *);
2593 sys_gmtime (const time_t *timer
)
2595 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2597 return gmtime (&unix_time
);
2602 extern struct tm
*localtime (const time_t *);
2604 sys_localtime (const time_t *timer
)
2606 #if __MSL__ >= 0x6000
2607 time_t unix_time
= *timer
;
2609 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2612 return localtime (&unix_time
);
2617 extern char *ctime (const time_t *);
2619 sys_ctime (const time_t *timer
)
2621 #if __MSL__ >= 0x6000
2622 time_t unix_time
= *timer
;
2624 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2627 return ctime (&unix_time
);
2632 extern time_t time (time_t *);
2634 sys_time (time_t *timer
)
2636 #if __MSL__ >= 0x6000
2637 time_t mac_time
= time (NULL
);
2639 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2649 /* no subprocesses, empty wait */
2659 croak (char *badfunc
)
2661 printf ("%s not yet implemented\r\n", badfunc
);
2667 mktemp (char *template)
2672 len
= strlen (template);
2674 while (k
>= 0 && template[k
] == 'X')
2677 k
++; /* make k index of first 'X' */
2681 /* Zero filled, number of digits equal to the number of X's. */
2682 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2691 /* Emulate getpwuid, getpwnam and others. */
2693 #define PASSWD_FIELD_SIZE 256
2695 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2696 static char my_passwd_dir
[MAXPATHLEN
+1];
2698 static struct passwd my_passwd
=
2704 static struct group my_group
=
2706 /* There are no groups on the mac, so we just return "root" as the
2712 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2714 char emacs_passwd_dir
[MAXPATHLEN
+1];
2720 init_emacs_passwd_dir ()
2724 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2726 /* Need pathname of first ancestor that begins with "emacs"
2727 since Mac emacs application is somewhere in the emacs-*
2729 int len
= strlen (emacs_passwd_dir
);
2731 /* j points to the "/" following the directory name being
2734 while (i
>= 0 && !found
)
2736 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2738 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2739 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2741 emacs_passwd_dir
[j
+1] = '\0';
2752 /* Setting to "/" probably won't work but set it to something
2754 strcpy (emacs_passwd_dir
, "/");
2755 strcpy (my_passwd_dir
, "/");
2760 static struct passwd emacs_passwd
=
2766 static int my_passwd_inited
= 0;
2774 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2775 directory where Emacs was started. */
2777 owner_name
= (char **) GetResource ('STR ',-16096);
2781 BlockMove ((unsigned char *) *owner_name
,
2782 (unsigned char *) my_passwd_name
,
2784 HUnlock (owner_name
);
2785 p2cstr ((unsigned char *) my_passwd_name
);
2788 my_passwd_name
[0] = 0;
2793 getpwuid (uid_t uid
)
2795 if (!my_passwd_inited
)
2798 my_passwd_inited
= 1;
2806 getgrgid (gid_t gid
)
2813 getpwnam (const char *name
)
2815 if (strcmp (name
, "emacs") == 0)
2816 return &emacs_passwd
;
2818 if (!my_passwd_inited
)
2821 my_passwd_inited
= 1;
2828 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2829 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2850 error ("Can't spawn subshell");
2855 request_sigio (void)
2861 unrequest_sigio (void)
2876 pipe (int _fildes
[2])
2883 /* Hard and symbolic links. */
2886 symlink (const char *name1
, const char *name2
)
2894 link (const char *name1
, const char *name2
)
2900 #endif /* ! MAC_OSX */
2902 /* Determine the path name of the file specified by VREFNUM, DIRID,
2903 and NAME and place that in the buffer PATH of length
2906 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2907 long dir_id
, ConstStr255Param name
)
2913 if (strlen (name
) > man_path_len
)
2916 memcpy (dir_name
, name
, name
[0]+1);
2917 memcpy (path
, name
, name
[0]+1);
2920 cipb
.dirInfo
.ioDrParID
= dir_id
;
2921 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2925 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2926 cipb
.dirInfo
.ioFDirIndex
= -1;
2927 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2928 /* go up to parent each time */
2930 err
= PBGetCatInfo (&cipb
, false);
2935 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2938 strcat (dir_name
, ":");
2939 strcat (dir_name
, path
);
2940 /* attach to front since we're going up directory tree */
2941 strcpy (path
, dir_name
);
2943 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2944 /* stop when we see the volume's root directory */
2946 return 1; /* success */
2953 posix_pathname_to_fsspec (ufn
, fs
)
2957 Str255 mac_pathname
;
2959 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2963 c2pstr (mac_pathname
);
2964 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2969 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2974 char mac_pathname
[MAXPATHLEN
];
2976 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2977 fs
->vRefNum
, fs
->parID
, fs
->name
)
2978 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2985 readlink (const char *path
, char *buf
, int bufsiz
)
2987 char mac_sym_link_name
[MAXPATHLEN
+1];
2990 Boolean target_is_folder
, was_aliased
;
2991 Str255 directory_name
, mac_pathname
;
2994 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2997 c2pstr (mac_sym_link_name
);
2998 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
3005 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
3006 if (err
!= noErr
|| !was_aliased
)
3012 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
3019 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
3025 return strlen (buf
);
3029 /* Convert a path to one with aliases fully expanded. */
3032 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
3034 char *q
, temp
[MAXPATHLEN
+1];
3038 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
3045 q
= strchr (p
+ 1, '/');
3047 q
= strchr (p
, '/');
3048 len
= 0; /* loop may not be entered, e.g., for "/" */
3053 strncat (temp
, p
, q
- p
);
3054 len
= readlink (temp
, buf
, bufsiz
);
3057 if (strlen (temp
) + 1 > bufsiz
)
3067 if (len
+ strlen (p
) + 1 >= bufsiz
)
3071 return len
+ strlen (p
);
3076 umask (mode_t numask
)
3078 static mode_t mask
= 022;
3079 mode_t oldmask
= mask
;
3086 chmod (const char *path
, mode_t mode
)
3088 /* say it always succeed for now */
3094 fchmod (int fd
, mode_t mode
)
3096 /* say it always succeed for now */
3102 fchown (int fd
, uid_t owner
, gid_t group
)
3104 /* say it always succeed for now */
3113 return fcntl (oldd
, F_DUPFD
, 0);
3115 /* current implementation of fcntl in fcntl.mac.c simply returns old
3117 return fcntl (oldd
, F_DUPFD
);
3124 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3125 newd if it already exists. Then, attempt to dup oldd. If not
3126 successful, call dup2 recursively until we are, then close the
3127 unsuccessful ones. */
3130 dup2 (int oldd
, int newd
)
3141 ret
= dup2 (oldd
, newd
);
3147 /* let it fail for now */
3164 ioctl (int d
, int request
, void *argp
)
3174 if (fildes
>=0 && fildes
<= 2)
3207 #endif /* __MRC__ */
3211 #if __MSL__ < 0x6000
3219 #endif /* __MWERKS__ */
3221 #endif /* ! MAC_OSX */
3224 /* Return the path to the directory in which Emacs can create
3225 temporary files. The MacOS "temporary items" directory cannot be
3226 used because it removes the file written by a process when it
3227 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3228 again not exactly). And of course Emacs needs to read back the
3229 files written by its subprocesses. So here we write the files to a
3230 directory "Emacs" in the Preferences Folder. This directory is
3231 created if it does not exist. */
3234 get_temp_dir_name ()
3236 static char *temp_dir_name
= NULL
;
3241 char unix_dir_name
[MAXPATHLEN
+1];
3244 /* Cache directory name with pointer temp_dir_name.
3245 Look for it only the first time. */
3248 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3249 &vol_ref_num
, &dir_id
);
3253 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3256 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3257 strcat (full_path
, "Emacs:");
3261 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3264 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3267 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3270 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3271 strcpy (temp_dir_name
, unix_dir_name
);
3274 return temp_dir_name
;
3279 /* Allocate and construct an array of pointers to strings from a list
3280 of strings stored in a 'STR#' resource. The returned pointer array
3281 is stored in the style of argv and environ: if the 'STR#' resource
3282 contains numString strings, a pointer array with numString+1
3283 elements is returned in which the last entry contains a null
3284 pointer. The pointer to the pointer array is passed by pointer in
3285 parameter t. The resource ID of the 'STR#' resource is passed in
3286 parameter StringListID.
3290 get_string_list (char ***t
, short string_list_id
)
3296 h
= GetResource ('STR#', string_list_id
);
3301 num_strings
= * (short *) p
;
3303 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3304 for (i
= 0; i
< num_strings
; i
++)
3306 short length
= *p
++;
3307 (*t
)[i
] = (char *) malloc (length
+ 1);
3308 strncpy ((*t
)[i
], p
, length
);
3309 (*t
)[i
][length
] = '\0';
3312 (*t
)[num_strings
] = 0;
3317 /* Return no string in case GetResource fails. Bug fixed by
3318 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3319 option (no sym -on implies -opt local). */
3320 *t
= (char **) malloc (sizeof (char *));
3327 get_path_to_system_folder ()
3333 static char system_folder_unix_name
[MAXPATHLEN
+1];
3336 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3337 &vol_ref_num
, &dir_id
);
3341 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3344 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3348 return system_folder_unix_name
;
3354 #define ENVIRON_STRING_LIST_ID 128
3356 /* Get environment variable definitions from STR# resource. */
3363 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3369 /* Make HOME directory the one Emacs starts up in if not specified
3371 if (getenv ("HOME") == NULL
)
3373 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3376 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3379 strcpy (environ
[i
], "HOME=");
3380 strcat (environ
[i
], my_passwd_dir
);
3387 /* Make HOME directory the one Emacs starts up in if not specified
3389 if (getenv ("MAIL") == NULL
)
3391 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3394 char * path_to_system_folder
= get_path_to_system_folder ();
3395 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3398 strcpy (environ
[i
], "MAIL=");
3399 strcat (environ
[i
], path_to_system_folder
);
3400 strcat (environ
[i
], "Eudora Folder/In");
3408 /* Return the value of the environment variable NAME. */
3411 getenv (const char *name
)
3413 int length
= strlen(name
);
3416 for (e
= environ
; *e
!= 0; e
++)
3417 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3418 return &(*e
)[length
+ 1];
3420 if (strcmp (name
, "TMPDIR") == 0)
3421 return get_temp_dir_name ();
3428 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3429 char *sys_siglist
[] =
3431 "Zero is not a signal!!!",
3433 "Interactive user interrupt", /* 2 */ "?",
3434 "Floating point exception", /* 4 */ "?", "?", "?",
3435 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3436 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3437 "?", "?", "?", "?", "?", "?", "?", "?",
3441 char *sys_siglist
[] =
3443 "Zero is not a signal!!!",
3445 "Floating point exception",
3446 "Illegal instruction",
3447 "Interactive user interrupt",
3448 "Segment violation",
3451 #else /* not __MRC__ and not __MWERKS__ */
3453 #endif /* not __MRC__ and not __MWERKS__ */
3456 #include <utsname.h>
3459 uname (struct utsname
*name
)
3462 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3465 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3466 p2cstr (name
->nodename
);
3474 /* Event class of HLE sent to subprocess. */
3475 const OSType kEmacsSubprocessSend
= 'ESND';
3477 /* Event class of HLE sent back from subprocess. */
3478 const OSType kEmacsSubprocessReply
= 'ERPY';
3482 mystrchr (char *s
, char c
)
3484 while (*s
&& *s
!= c
)
3512 mystrcpy (char *to
, char *from
)
3524 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3525 terminated). The process should run with the default directory
3526 "workdir", read input from "infn", and write output and error to
3527 "outfn" and "errfn", resp. The Process Manager call
3528 LaunchApplication is used to start the subprocess. We use high
3529 level events as the mechanism to pass arguments to the subprocess
3530 and to make Emacs wait for the subprocess to terminate and pass
3531 back a result code. The bulk of the code here packs the arguments
3532 into one message to be passed together with the high level event.
3533 Emacs also sometimes starts a subprocess using a shell to perform
3534 wildcard filename expansion. Since we don't really have a shell on
3535 the Mac, this case is detected and the starting of the shell is
3536 by-passed. We really need to add code here to do filename
3537 expansion to support such functionality.
3539 We can't use this strategy in Carbon because the High Level Event
3540 APIs are not available. */
3543 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3544 unsigned char **argv
;
3545 const char *workdir
;
3546 const char *infn
, *outfn
, *errfn
;
3548 #if TARGET_API_MAC_CARBON
3550 #else /* not TARGET_API_MAC_CARBON */
3551 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3552 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3553 int paramlen
, argc
, newargc
, j
, retries
;
3554 char **newargv
, *param
, *p
;
3557 LaunchParamBlockRec lpbr
;
3558 EventRecord send_event
, reply_event
;
3559 RgnHandle cursor_region_handle
;
3561 unsigned long ref_con
, len
;
3563 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3565 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3567 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3569 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3572 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3573 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3582 /* If a subprocess is invoked with a shell, we receive 3 arguments
3583 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3584 bins>/<command> <command args>" */
3585 j
= strlen (argv
[0]);
3586 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3587 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3589 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3591 /* The arguments for the command in argv[2] are separated by
3592 spaces. Count them and put the count in newargc. */
3593 command
= (char *) alloca (strlen (argv
[2])+2);
3594 strcpy (command
, argv
[2]);
3595 if (command
[strlen (command
) - 1] != ' ')
3596 strcat (command
, " ");
3600 t
= mystrchr (t
, ' ');
3604 t
= mystrchr (t
+1, ' ');
3607 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3610 for (j
= 0; j
< newargc
; j
++)
3612 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3613 mystrcpy (newargv
[j
], t
);
3616 paramlen
+= strlen (newargv
[j
]) + 1;
3619 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3621 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3626 { /* sometimes Emacs call "sh" without a path for the command */
3628 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3629 strcpy (t
, "~emacs/");
3630 strcat (t
, newargv
[0]);
3633 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3634 make_number (X_OK
));
3638 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3642 strcpy (macappname
, tempmacpathname
);
3646 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3649 newargv
= (char **) alloca (sizeof (char *) * argc
);
3651 for (j
= 1; j
< argc
; j
++)
3653 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3655 char *t
= strchr (argv
[j
], ' ');
3658 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3659 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3660 tempcmdname
[t
-argv
[j
]] = '\0';
3661 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3664 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3666 strcpy (newargv
[j
], tempmaccmdname
);
3667 strcat (newargv
[j
], t
);
3671 char tempmaccmdname
[MAXPATHLEN
+1];
3672 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3675 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3676 strcpy (newargv
[j
], tempmaccmdname
);
3680 newargv
[j
] = argv
[j
];
3681 paramlen
+= strlen (newargv
[j
]) + 1;
3685 /* After expanding all the arguments, we now know the length of the
3686 parameter block to be sent to the subprocess as a message
3687 attached to the HLE. */
3688 param
= (char *) malloc (paramlen
+ 1);
3694 /* first byte of message contains number of arguments for command */
3695 strcpy (p
, macworkdir
);
3696 p
+= strlen (macworkdir
);
3698 /* null terminate strings sent so it's possible to use strcpy over there */
3699 strcpy (p
, macinfn
);
3700 p
+= strlen (macinfn
);
3702 strcpy (p
, macoutfn
);
3703 p
+= strlen (macoutfn
);
3705 strcpy (p
, macerrfn
);
3706 p
+= strlen (macerrfn
);
3708 for (j
= 1; j
< newargc
; j
++)
3710 strcpy (p
, newargv
[j
]);
3711 p
+= strlen (newargv
[j
]);
3715 c2pstr (macappname
);
3717 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3725 lpbr
.launchBlockID
= extendedBlock
;
3726 lpbr
.launchEPBLength
= extendedBlockLen
;
3727 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3728 lpbr
.launchAppSpec
= &spec
;
3729 lpbr
.launchAppParameters
= NULL
;
3731 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3738 send_event
.what
= kHighLevelEvent
;
3739 send_event
.message
= kEmacsSubprocessSend
;
3740 /* Event ID stored in "where" unused */
3743 /* OS may think current subprocess has terminated if previous one
3744 terminated recently. */
3747 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3748 paramlen
+ 1, receiverIDisPSN
);
3750 while (iErr
== sessClosedErr
&& retries
-- > 0);
3758 cursor_region_handle
= NewRgn ();
3760 /* Wait for the subprocess to finish, when it will send us a ERPY
3761 high level event. */
3763 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3764 cursor_region_handle
)
3765 && reply_event
.message
== kEmacsSubprocessReply
)
3768 /* The return code is sent through the refCon */
3769 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3772 DisposeHandle ((Handle
) cursor_region_handle
);
3777 DisposeHandle ((Handle
) cursor_region_handle
);
3781 #endif /* not TARGET_API_MAC_CARBON */
3786 opendir (const char *dirname
)
3788 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3789 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3793 int len
, vol_name_len
;
3795 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3798 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3800 fully_resolved_name
[len
] = '\0';
3802 strcpy (fully_resolved_name
, true_pathname
);
3804 dirp
= (DIR *) malloc (sizeof(DIR));
3808 /* Handle special case when dirname is "/": sets up for readir to
3809 get all mount volumes. */
3810 if (strcmp (fully_resolved_name
, "/") == 0)
3812 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3813 dirp
->current_index
= 1; /* index for first volume */
3817 /* Handle typical cases: not accessing all mounted volumes. */
3818 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3821 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3822 len
= strlen (mac_pathname
);
3823 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3824 strcat (mac_pathname
, ":");
3826 /* Extract volume name */
3827 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3828 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3829 vol_name
[vol_name_len
] = '\0';
3830 strcat (vol_name
, ":");
3832 c2pstr (mac_pathname
);
3833 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3834 /* using full pathname so vRefNum and DirID ignored */
3835 cipb
.hFileInfo
.ioVRefNum
= 0;
3836 cipb
.hFileInfo
.ioDirID
= 0;
3837 cipb
.hFileInfo
.ioFDirIndex
= 0;
3838 /* set to 0 to get information about specific dir or file */
3840 errno
= PBGetCatInfo (&cipb
, false);
3847 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3848 return 0; /* not a directory */
3850 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3851 dirp
->getting_volumes
= 0;
3852 dirp
->current_index
= 1; /* index for first file/directory */
3855 vpb
.ioNamePtr
= vol_name
;
3856 /* using full pathname so vRefNum and DirID ignored */
3858 vpb
.ioVolIndex
= -1;
3859 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3866 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3883 HParamBlockRec hpblock
;
3885 static struct dirent s_dirent
;
3886 static Str255 s_name
;
3890 /* Handle the root directory containing the mounted volumes. Call
3891 PBHGetVInfo specifying an index to obtain the info for a volume.
3892 PBHGetVInfo returns an error when it receives an index beyond the
3893 last volume, at which time we should return a nil dirent struct
3895 if (dp
->getting_volumes
)
3897 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3898 hpblock
.volumeParam
.ioVRefNum
= 0;
3899 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3901 errno
= PBHGetVInfo (&hpblock
, false);
3909 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3911 dp
->current_index
++;
3913 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3914 s_dirent
.d_name
= s_name
;
3920 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3921 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3922 /* location to receive filename returned */
3924 /* return only visible files */
3928 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3929 /* directory ID found by opendir */
3930 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3932 errno
= PBGetCatInfo (&cipb
, false);
3939 /* insist on a visible entry */
3940 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3941 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3943 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3945 dp
->current_index
++;
3958 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3959 /* value unimportant: non-zero for valid file */
3960 s_dirent
.d_name
= s_name
;
3970 char mac_pathname
[MAXPATHLEN
+1];
3971 Str255 directory_name
;
3975 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3978 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3984 #endif /* ! MAC_OSX */
3988 initialize_applescript ()
3993 /* if open fails, as_scripting_component is set to NULL. Its
3994 subsequent use in OSA calls will fail with badComponentInstance
3996 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3997 kAppleScriptSubtype
);
3999 null_desc
.descriptorType
= typeNull
;
4000 null_desc
.dataHandle
= 0;
4001 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
4002 kOSANullScript
, &as_script_context
);
4004 as_script_context
= kOSANullScript
;
4005 /* use default context if create fails */
4010 terminate_applescript()
4012 OSADispose (as_scripting_component
, as_script_context
);
4013 CloseComponent (as_scripting_component
);
4016 /* Convert a lisp string to the 4 byte character code. */
4019 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
4028 /* check type string */
4030 if (SBYTES (arg
) != 4)
4032 error ("Wrong argument: need string of length 4 for code");
4034 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
4039 /* Convert the 4 byte character code into a 4 byte string. */
4042 mac_get_object_from_code(OSType defCode
)
4044 UInt32 code
= EndianU32_NtoB (defCode
);
4046 return make_unibyte_string ((char *)&code
, 4);
4050 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
4051 doc
: /* Get the creator code of FILENAME as a four character string. */)
4053 Lisp_Object filename
;
4061 Lisp_Object result
= Qnil
;
4062 CHECK_STRING (filename
);
4064 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4067 filename
= Fexpand_file_name (filename
, Qnil
);
4071 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4073 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4076 if (status
== noErr
)
4079 FSCatalogInfo catalogInfo
;
4081 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4082 &catalogInfo
, NULL
, NULL
, NULL
);
4086 status
= FSpGetFInfo (&fss
, &finder_info
);
4088 if (status
== noErr
)
4091 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4093 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4098 if (status
!= noErr
) {
4099 error ("Error while getting file information.");
4104 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4105 doc
: /* Get the type code of FILENAME as a four character string. */)
4107 Lisp_Object filename
;
4115 Lisp_Object result
= Qnil
;
4116 CHECK_STRING (filename
);
4118 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4121 filename
= Fexpand_file_name (filename
, Qnil
);
4125 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4127 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4130 if (status
== noErr
)
4133 FSCatalogInfo catalogInfo
;
4135 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4136 &catalogInfo
, NULL
, NULL
, NULL
);
4140 status
= FSpGetFInfo (&fss
, &finder_info
);
4142 if (status
== noErr
)
4145 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4147 result
= mac_get_object_from_code (finder_info
.fdType
);
4152 if (status
!= noErr
) {
4153 error ("Error while getting file information.");
4158 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4159 doc
: /* Set creator code of file FILENAME to CODE.
4160 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4161 assumed. Return non-nil if successful. */)
4163 Lisp_Object filename
, code
;
4172 CHECK_STRING (filename
);
4174 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4176 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4179 filename
= Fexpand_file_name (filename
, Qnil
);
4183 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4185 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4188 if (status
== noErr
)
4191 FSCatalogInfo catalogInfo
;
4193 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4194 &catalogInfo
, NULL
, NULL
, &parentDir
);
4198 status
= FSpGetFInfo (&fss
, &finder_info
);
4200 if (status
== noErr
)
4203 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4204 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4205 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4207 finder_info
.fdCreator
= cCode
;
4208 status
= FSpSetFInfo (&fss
, &finder_info
);
4213 if (status
!= noErr
) {
4214 error ("Error while setting creator information.");
4219 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4220 doc
: /* Set file code of file FILENAME to CODE.
4221 CODE must be a 4-character string. Return non-nil if successful. */)
4223 Lisp_Object filename
, code
;
4232 CHECK_STRING (filename
);
4234 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4236 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4239 filename
= Fexpand_file_name (filename
, Qnil
);
4243 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4245 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4248 if (status
== noErr
)
4251 FSCatalogInfo catalogInfo
;
4253 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4254 &catalogInfo
, NULL
, NULL
, &parentDir
);
4258 status
= FSpGetFInfo (&fss
, &finder_info
);
4260 if (status
== noErr
)
4263 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4264 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4265 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4267 finder_info
.fdType
= cCode
;
4268 status
= FSpSetFInfo (&fss
, &finder_info
);
4273 if (status
!= noErr
) {
4274 error ("Error while setting creator information.");
4280 /* Compile and execute the AppleScript SCRIPT and return the error
4281 status as function value. A zero is returned if compilation and
4282 execution is successful, in which case *RESULT is set to a Lisp
4283 string containing the resulting script value. Otherwise, the Mac
4284 error code is returned and *RESULT is set to an error Lisp string.
4285 For documentation on the MacOS scripting architecture, see Inside
4286 Macintosh - Interapplication Communications: Scripting
4290 do_applescript (script
, result
)
4291 Lisp_Object script
, *result
;
4293 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4299 if (!as_scripting_component
)
4300 initialize_applescript();
4302 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4307 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4308 typeChar
, kOSAModeNull
, &result_desc
);
4310 if (osaerror
== noErr
)
4311 /* success: retrieve resulting script value */
4312 desc
= &result_desc
;
4313 else if (osaerror
== errOSAScriptError
)
4314 /* error executing AppleScript: retrieve error message */
4315 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4321 #if TARGET_API_MAC_CARBON
4322 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4323 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4324 #else /* not TARGET_API_MAC_CARBON */
4325 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4326 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4327 #endif /* not TARGET_API_MAC_CARBON */
4328 AEDisposeDesc (desc
);
4331 AEDisposeDesc (&script_desc
);
4337 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4338 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4339 If compilation and execution are successful, the resulting script
4340 value is returned as a string. Otherwise the function aborts and
4341 displays the error message returned by the AppleScript scripting
4349 CHECK_STRING (script
);
4352 status
= do_applescript (script
, &result
);
4356 else if (!STRINGP (result
))
4357 error ("AppleScript error %d", status
);
4359 error ("%s", SDATA (result
));
4363 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4364 Smac_file_name_to_posix
, 1, 1, 0,
4365 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4367 Lisp_Object filename
;
4369 char posix_filename
[MAXPATHLEN
+1];
4371 CHECK_STRING (filename
);
4373 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4374 return build_string (posix_filename
);
4380 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4381 Sposix_file_name_to_mac
, 1, 1, 0,
4382 doc
: /* Convert Posix FILENAME to Mac form. */)
4384 Lisp_Object filename
;
4386 char mac_filename
[MAXPATHLEN
+1];
4388 CHECK_STRING (filename
);
4390 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4391 return build_string (mac_filename
);
4397 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4398 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4399 Each type should be a string of length 4 or the symbol
4400 `undecoded-file-name'. */)
4401 (src_type
, src_data
, dst_type
)
4402 Lisp_Object src_type
, src_data
, dst_type
;
4405 Lisp_Object result
= Qnil
;
4406 DescType src_desc_type
, dst_desc_type
;
4409 CHECK_STRING (src_data
);
4410 if (EQ (src_type
, Qundecoded_file_name
))
4411 src_desc_type
= TYPE_FILE_NAME
;
4413 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4415 if (EQ (dst_type
, Qundecoded_file_name
))
4416 dst_desc_type
= TYPE_FILE_NAME
;
4418 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4421 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4422 dst_desc_type
, &dst_desc
);
4425 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4426 AEDisposeDesc (&dst_desc
);
4434 #if TARGET_API_MAC_CARBON
4435 static Lisp_Object Qxml
, Qmime_charset
;
4436 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4438 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4439 doc
: /* Return the application preference value for KEY.
4440 KEY is either a string specifying a preference key, or a list of key
4441 strings. If it is a list, the (i+1)-th element is used as a key for
4442 the CFDictionary value obtained by the i-th element. Return nil if
4443 lookup is failed at some stage.
4445 Optional arg APPLICATION is an application ID string. If omitted or
4446 nil, that stands for the current application.
4448 Optional arg FORMAT specifies the data format of the return value. If
4449 omitted or nil, each Core Foundation object is converted into a
4450 corresponding Lisp object as follows:
4452 Core Foundation Lisp Tag
4453 ------------------------------------------------------------
4454 CFString Multibyte string string
4455 CFNumber Integer or float number
4456 CFBoolean Symbol (t or nil) boolean
4457 CFDate List of three integers date
4458 (cf. `current-time')
4459 CFData Unibyte string data
4460 CFArray Vector array
4461 CFDictionary Alist or hash table dictionary
4462 (depending on HASH-BOUND)
4464 If it is t, a symbol that represents the type of the original Core
4465 Foundation object is prepended. If it is `xml', the value is returned
4466 as an XML representation.
4468 Optional arg HASH-BOUND specifies which kinds of the list objects,
4469 alists or hash tables, are used as the targets of the conversion from
4470 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4471 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4472 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4474 (key
, application
, format
, hash_bound
)
4475 Lisp_Object key
, application
, format
, hash_bound
;
4477 CFStringRef app_id
, key_str
;
4478 CFPropertyListRef app_plist
= NULL
, plist
;
4479 Lisp_Object result
= Qnil
, tmp
;
4482 key
= Fcons (key
, Qnil
);
4486 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4487 CHECK_STRING_CAR (tmp
);
4489 wrong_type_argument (Qlistp
, key
);
4491 if (!NILP (application
))
4492 CHECK_STRING (application
);
4493 CHECK_SYMBOL (format
);
4494 if (!NILP (hash_bound
))
4495 CHECK_NUMBER (hash_bound
);
4499 app_id
= kCFPreferencesCurrentApplication
;
4500 if (!NILP (application
))
4502 app_id
= cfstring_create_with_string (application
);
4506 key_str
= cfstring_create_with_string (XCAR (key
));
4507 if (key_str
== NULL
)
4509 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4510 CFRelease (key_str
);
4511 if (app_plist
== NULL
)
4515 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4517 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4519 key_str
= cfstring_create_with_string (XCAR (key
));
4520 if (key_str
== NULL
)
4522 plist
= CFDictionaryGetValue (plist
, key_str
);
4523 CFRelease (key_str
);
4530 if (EQ (format
, Qxml
))
4532 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4535 result
= cfdata_to_lisp (data
);
4540 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4541 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4546 CFRelease (app_plist
);
4555 static CFStringEncoding
4556 get_cfstring_encoding_from_lisp (obj
)
4559 CFStringRef iana_name
;
4560 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4563 return kCFStringEncodingUnicode
;
4568 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4570 Lisp_Object coding_spec
, plist
;
4572 coding_spec
= Fget (obj
, Qcoding_system
);
4573 plist
= XVECTOR (coding_spec
)->contents
[3];
4574 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4578 obj
= SYMBOL_NAME (obj
);
4582 iana_name
= cfstring_create_with_string (obj
);
4585 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4586 CFRelease (iana_name
);
4593 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4595 cfstring_create_normalized (str
, symbol
)
4600 TextEncodingVariant variant
;
4601 float initial_mag
= 0.0;
4602 CFStringRef result
= NULL
;
4604 if (EQ (symbol
, QNFD
))
4605 form
= kCFStringNormalizationFormD
;
4606 else if (EQ (symbol
, QNFKD
))
4607 form
= kCFStringNormalizationFormKD
;
4608 else if (EQ (symbol
, QNFC
))
4609 form
= kCFStringNormalizationFormC
;
4610 else if (EQ (symbol
, QNFKC
))
4611 form
= kCFStringNormalizationFormKC
;
4612 else if (EQ (symbol
, QHFS_plus_D
))
4614 variant
= kUnicodeHFSPlusDecompVariant
;
4617 else if (EQ (symbol
, QHFS_plus_C
))
4619 variant
= kUnicodeHFSPlusCompVariant
;
4625 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4629 CFStringNormalize (mut_str
, form
);
4633 else if (initial_mag
> 0.0)
4635 UnicodeToTextInfo uni
= NULL
;
4638 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4640 ByteCount out_read
, out_size
, out_len
;
4642 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4644 kTextEncodingDefaultFormat
);
4645 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4647 kTextEncodingDefaultFormat
);
4648 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4650 length
= CFStringGetLength (str
);
4651 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4655 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4656 if (in_text
== NULL
)
4658 buffer
= xmalloc (sizeof (UniChar
) * length
);
4659 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4664 err
= CreateUnicodeToTextInfo(&map
, &uni
);
4665 while (err
== noErr
)
4667 out_buf
= xmalloc (out_size
);
4668 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4670 kUnicodeDefaultDirectionMask
,
4671 0, NULL
, NULL
, NULL
,
4672 out_size
, &out_read
, &out_len
,
4674 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4683 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4684 out_len
/ sizeof (UniChar
));
4686 DisposeUnicodeToTextInfo (&uni
);
4702 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4703 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4704 The conversion is performed using the converter provided by the system.
4705 Each encoding is specified by either a coding system symbol, a mime
4706 charset string, or an integer as a CFStringEncoding value. Nil for
4707 encoding means UTF-16 in native byte order, no byte order mark.
4708 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4709 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4710 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4711 On successful conversion, return the result string, else return nil. */)
4712 (string
, source
, target
, normalization_form
)
4713 Lisp_Object string
, source
, target
, normalization_form
;
4715 Lisp_Object result
= Qnil
;
4716 CFStringEncoding src_encoding
, tgt_encoding
;
4717 CFStringRef str
= NULL
;
4719 CHECK_STRING (string
);
4720 if (!INTEGERP (source
) && !STRINGP (source
))
4721 CHECK_SYMBOL (source
);
4722 if (!INTEGERP (target
) && !STRINGP (target
))
4723 CHECK_SYMBOL (target
);
4724 CHECK_SYMBOL (normalization_form
);
4728 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4729 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4731 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4732 use string_as_unibyte which works as well, except for the fact that
4733 it's too permissive (it doesn't check that the multibyte string only
4734 contain single-byte chars). */
4735 string
= Fstring_as_unibyte (string
);
4736 if (src_encoding
!= kCFStringEncodingInvalidId
4737 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4738 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4739 src_encoding
, !NILP (source
));
4740 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4743 CFStringRef saved_str
= str
;
4745 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4746 CFRelease (saved_str
);
4751 CFIndex str_len
, buf_len
;
4753 str_len
= CFStringGetLength (str
);
4754 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4755 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4757 result
= make_uninit_string (buf_len
);
4758 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4759 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4768 #endif /* TARGET_API_MAC_CARBON */
4772 mac_get_system_locale ()
4780 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4781 region
= GetScriptManagerVariable (smRegionCode
);
4782 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4784 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4787 return build_string (str
);
4795 extern int inhibit_window_system
;
4796 extern int noninteractive
;
4798 /* Unlike in X11, window events in Carbon do not come from sockets.
4799 So we cannot simply use `select' to monitor two kinds of inputs:
4800 window events and process outputs. We emulate such functionality
4801 by regarding fd 0 as the window event channel and simultaneously
4802 monitoring both kinds of input channels. It is implemented by
4803 dividing into some cases:
4804 1. The window event channel is not involved.
4806 2. Sockets are not involved.
4807 -> Use ReceiveNextEvent.
4808 3. [If SELECT_USE_CFSOCKET is defined]
4809 Only the window event channel and socket read channels are
4810 involved, and timeout is not too short (greater than
4811 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4812 -> Create CFSocket for each socket and add it into the current
4813 event RunLoop so that a `ready-to-read' event can be posted
4814 to the event queue that is also used for window events. Then
4815 ReceiveNextEvent can wait for both kinds of inputs.
4817 -> Periodically poll the window input channel while repeatedly
4818 executing `select' with a short timeout
4819 (SELECT_POLLING_PERIOD_USEC microseconds). */
4821 #define SELECT_POLLING_PERIOD_USEC 20000
4822 #ifdef SELECT_USE_CFSOCKET
4823 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4824 #define EVENT_CLASS_SOCK 'Sock'
4827 socket_callback (s
, type
, address
, data
, info
)
4829 CFSocketCallBackType type
;
4836 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4837 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4838 ReleaseEvent (event
);
4840 #endif /* SELECT_USE_CFSOCKET */
4843 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4848 struct timeval
*timeout
;
4853 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4857 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4858 kEventLeaveInQueue
, NULL
);
4869 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
4870 #undef SELECT_INVALIDATE_CFSOCKET
4874 sys_select (n
, rfds
, wfds
, efds
, timeout
)
4879 struct timeval
*timeout
;
4883 EMACS_TIME select_timeout
;
4885 if (inhibit_window_system
|| noninteractive
4886 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
4887 return select (n
, rfds
, wfds
, efds
, timeout
);
4891 if (wfds
== NULL
&& efds
== NULL
)
4894 SELECT_TYPE orfds
= *rfds
;
4896 EventTimeout timeout_sec
=
4898 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4899 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4900 : kEventDurationForever
);
4902 for (i
= 1; i
< n
; i
++)
4903 if (FD_ISSET (i
, rfds
))
4909 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
4910 kEventLeaveInQueue
, NULL
);
4922 mac_prepare_for_quickdraw (NULL
);
4924 /* Avoid initial overhead of RunLoop setup for the case that
4925 some input is already available. */
4926 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4927 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4928 if (r
!= 0 || timeout_sec
== 0.0)
4933 #ifdef SELECT_USE_CFSOCKET
4934 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
4935 goto poll_periodically
;
4938 CFRunLoopRef runloop
=
4939 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4940 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
4941 #ifdef SELECT_INVALIDATE_CFSOCKET
4942 CFSocketRef
*shead
, *s
;
4944 CFRunLoopSourceRef
*shead
, *s
;
4949 #ifdef SELECT_INVALIDATE_CFSOCKET
4950 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
4952 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
4955 for (i
= 1; i
< n
; i
++)
4956 if (FD_ISSET (i
, rfds
))
4958 CFSocketRef socket
=
4959 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
4960 socket_callback
, NULL
);
4961 CFRunLoopSourceRef source
=
4962 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
4964 #ifdef SELECT_INVALIDATE_CFSOCKET
4965 CFSocketSetSocketFlags (socket
, 0);
4967 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
4968 #ifdef SELECT_INVALIDATE_CFSOCKET
4978 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
4983 #ifdef SELECT_INVALIDATE_CFSOCKET
4984 CFSocketInvalidate (*s
);
4986 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
5001 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
5002 GetEventTypeCount (specs
),
5004 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5005 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
5012 #endif /* SELECT_USE_CFSOCKET */
5017 EMACS_TIME end_time
, now
, remaining_time
;
5018 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
5026 remaining_time
= *timeout
;
5027 EMACS_GET_TIME (now
);
5028 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5033 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5034 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5035 select_timeout
= remaining_time
;
5036 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
5048 EMACS_GET_TIME (now
);
5049 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5052 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5063 /* Set up environment variables so that Emacs can correctly find its
5064 support files when packaged as an application bundle. Directories
5065 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5066 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5067 by `make install' by default can instead be placed in
5068 .../Emacs.app/Contents/Resources/ and
5069 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5070 is changed only if it is not already set. Presumably if the user
5071 sets an environment variable, he will want to use files in his path
5072 instead of ones in the application bundle. */
5074 init_mac_osx_environment ()
5078 CFStringRef cf_app_bundle_pathname
;
5079 int app_bundle_pathname_len
;
5080 char *app_bundle_pathname
;
5084 /* Initialize locale related variables. */
5085 mac_system_script_code
=
5086 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5087 Vmac_system_locale
= mac_get_system_locale ();
5089 /* Fetch the pathname of the application bundle as a C string into
5090 app_bundle_pathname. */
5092 bundle
= CFBundleGetMainBundle ();
5093 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5095 /* We could not find the bundle identifier. For now, prevent
5096 the fatal error by bringing it up in the terminal. */
5097 inhibit_window_system
= 1;
5101 bundleURL
= CFBundleCopyBundleURL (bundle
);
5105 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5106 kCFURLPOSIXPathStyle
);
5107 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5108 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5110 if (!CFStringGetCString (cf_app_bundle_pathname
,
5111 app_bundle_pathname
,
5112 app_bundle_pathname_len
+ 1,
5113 kCFStringEncodingISOLatin1
))
5115 CFRelease (cf_app_bundle_pathname
);
5119 CFRelease (cf_app_bundle_pathname
);
5121 /* P should have sufficient room for the pathname of the bundle plus
5122 the subpath in it leading to the respective directories. Q
5123 should have three times that much room because EMACSLOADPATH can
5124 have the value "<path to lisp dir>:<path to leim dir>:<path to
5126 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5127 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5128 if (!getenv ("EMACSLOADPATH"))
5132 strcpy (p
, app_bundle_pathname
);
5133 strcat (p
, "/Contents/Resources/lisp");
5134 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5137 strcpy (p
, app_bundle_pathname
);
5138 strcat (p
, "/Contents/Resources/leim");
5139 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5146 strcpy (p
, app_bundle_pathname
);
5147 strcat (p
, "/Contents/Resources/site-lisp");
5148 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5156 setenv ("EMACSLOADPATH", q
, 1);
5159 if (!getenv ("EMACSPATH"))
5163 strcpy (p
, app_bundle_pathname
);
5164 strcat (p
, "/Contents/MacOS/libexec");
5165 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5168 strcpy (p
, app_bundle_pathname
);
5169 strcat (p
, "/Contents/MacOS/bin");
5170 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5178 setenv ("EMACSPATH", q
, 1);
5181 if (!getenv ("EMACSDATA"))
5183 strcpy (p
, app_bundle_pathname
);
5184 strcat (p
, "/Contents/Resources/etc");
5185 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5186 setenv ("EMACSDATA", p
, 1);
5189 if (!getenv ("EMACSDOC"))
5191 strcpy (p
, app_bundle_pathname
);
5192 strcat (p
, "/Contents/Resources/etc");
5193 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5194 setenv ("EMACSDOC", p
, 1);
5197 if (!getenv ("INFOPATH"))
5199 strcpy (p
, app_bundle_pathname
);
5200 strcat (p
, "/Contents/Resources/info");
5201 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5202 setenv ("INFOPATH", p
, 1);
5205 #endif /* MAC_OSX */
5211 Qundecoded_file_name
= intern ("undecoded-file-name");
5212 staticpro (&Qundecoded_file_name
);
5214 #if TARGET_API_MAC_CARBON
5215 Qstring
= intern ("string"); staticpro (&Qstring
);
5216 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5217 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5218 Qdate
= intern ("date"); staticpro (&Qdate
);
5219 Qdata
= intern ("data"); staticpro (&Qdata
);
5220 Qarray
= intern ("array"); staticpro (&Qarray
);
5221 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5223 Qxml
= intern ("xml");
5226 Qmime_charset
= intern ("mime-charset");
5227 staticpro (&Qmime_charset
);
5229 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5230 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5231 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5232 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5233 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5234 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5237 defsubr (&Smac_coerce_ae_data
);
5238 #if TARGET_API_MAC_CARBON
5239 defsubr (&Smac_get_preference
);
5240 defsubr (&Smac_code_convert_string
);
5243 defsubr (&Smac_set_file_creator
);
5244 defsubr (&Smac_set_file_type
);
5245 defsubr (&Smac_get_file_creator
);
5246 defsubr (&Smac_get_file_type
);
5247 defsubr (&Sdo_applescript
);
5248 defsubr (&Smac_file_name_to_posix
);
5249 defsubr (&Sposix_file_name_to_mac
);
5251 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5252 doc
: /* The system script code. */);
5253 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5255 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5256 doc
: /* The system locale identifier string.
5257 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5258 information is not included. */);
5259 Vmac_system_locale
= mac_get_system_locale ();
5262 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5263 (do not change this comment) */