1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
3 2008 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 3 of the License, or
10 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
20 /* Contributed by Andrew Choi (akochoi@mac.com). */
33 #include "sysselect.h"
34 #include "blockinput.h"
40 #if !TARGET_API_MAC_CARBON
43 #include <TextUtils.h>
45 #include <Resources.h>
49 #include <AppleScript.h>
51 #include <Processes.h>
53 #include <MacLocales.h>
55 #endif /* not TARGET_API_MAC_CARBON */
59 #include <sys/types.h>
63 #include <sys/param.h>
69 /* The system script code. */
70 static int mac_system_script_code
;
72 /* The system locale identifier string. */
73 static Lisp_Object Vmac_system_locale
;
75 /* An instance of the AppleScript component. */
76 static ComponentInstance as_scripting_component
;
77 /* The single script context used for all script executions. */
78 static OSAID as_script_context
;
81 #if TARGET_API_MAC_CARBON
82 static int wakeup_from_rne_enabled_p
= 0;
83 #define ENABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 1)
84 #define DISABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 0)
86 #define ENABLE_WAKEUP_FROM_RNE 0
87 #define DISABLE_WAKEUP_FROM_RNE 0
92 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
93 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
96 /* When converting from Mac to Unix pathnames, /'s in folder names are
97 converted to :'s. This function, used in copying folder names,
98 performs a strncat and converts all character a to b in the copy of
99 the string s2 appended to the end of s1. */
102 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
104 int l1
= strlen (s1
);
105 int l2
= strlen (s2
);
110 for (i
= 0; i
< l2
; i
++)
119 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
120 that does not begin with a ':' and contains at least one ':'. A Mac
121 full pathname causes a '/' to be prepended to the Posix pathname.
122 The algorithm for the rest of the pathname is as follows:
123 For each segment between two ':',
124 if it is non-null, copy as is and then add a '/' at the end,
125 otherwise, insert a "../" into the Posix pathname.
126 Returns 1 if successful; 0 if fails. */
129 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
131 const char *p
, *q
, *pe
;
138 p
= strchr (mfn
, ':');
139 if (p
!= 0 && p
!= mfn
) /* full pathname */
146 pe
= mfn
+ strlen (mfn
);
153 { /* two consecutive ':' */
154 if (strlen (ufn
) + 3 >= ufnbuflen
)
160 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
162 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
169 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
171 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
172 /* no separator for last one */
181 extern char *get_temp_dir_name ();
184 /* Convert a Posix pathname to Mac form. Approximately reverse of the
185 above in algorithm. */
188 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
190 const char *p
, *q
, *pe
;
191 char expanded_pathname
[MAXPATHLEN
+1];
200 /* Check for and handle volume names. Last comparison: strangely
201 somewhere "/.emacs" is passed. A temporary fix for now. */
202 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
204 if (strlen (p
) + 1 > mfnbuflen
)
211 /* expand to emacs dir found by init_emacs_passwd_dir */
212 if (strncmp (p
, "~emacs/", 7) == 0)
214 struct passwd
*pw
= getpwnam ("emacs");
216 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
218 strcpy (expanded_pathname
, pw
->pw_dir
);
219 strcat (expanded_pathname
, p
);
220 p
= expanded_pathname
;
221 /* now p points to the pathname with emacs dir prefix */
223 else if (strncmp (p
, "/tmp/", 5) == 0)
225 char *t
= get_temp_dir_name ();
227 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
229 strcpy (expanded_pathname
, t
);
230 strcat (expanded_pathname
, p
);
231 p
= expanded_pathname
;
232 /* now p points to the pathname with emacs dir prefix */
234 else if (*p
!= '/') /* relative pathname */
246 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
248 if (strlen (mfn
) + 1 >= mfnbuflen
)
254 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
256 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
263 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
265 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
274 /***********************************************************************
275 Conversions on Apple event objects
276 ***********************************************************************/
278 static Lisp_Object Qundecoded_file_name
;
285 {{keyTransactionIDAttr
, "transaction-id"},
286 {keyReturnIDAttr
, "return-id"},
287 {keyEventClassAttr
, "event-class"},
288 {keyEventIDAttr
, "event-id"},
289 {keyAddressAttr
, "address"},
290 {keyOptionalKeywordAttr
, "optional-keyword"},
291 {keyTimeoutAttr
, "timeout"},
292 {keyInteractLevelAttr
, "interact-level"},
293 {keyEventSourceAttr
, "event-source"},
294 /* {keyMissedKeywordAttr, "missed-keyword"}, */
295 {keyOriginalAddressAttr
, "original-address"},
296 {keyReplyRequestedAttr
, "reply-requested"},
297 {KEY_EMACS_SUSPENSION_ID_ATTR
, "emacs-suspension-id"}
301 mac_aelist_to_lisp (desc_list
)
302 const AEDescList
*desc_list
;
306 Lisp_Object result
, elem
;
313 err
= AECountItems (desc_list
, &count
);
323 keyword
= ae_attr_table
[count
- 1].keyword
;
324 err
= AESizeOfAttribute (desc_list
, keyword
, &desc_type
, &size
);
327 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
336 err
= AEGetAttributeDesc (desc_list
, keyword
, typeWildCard
,
339 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
343 elem
= mac_aelist_to_lisp (&desc
);
344 AEDisposeDesc (&desc
);
348 if (desc_type
== typeNull
)
352 elem
= make_uninit_string (size
);
354 err
= AEGetAttributePtr (desc_list
, keyword
, typeWildCard
,
355 &desc_type
, SDATA (elem
),
358 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
359 &desc_type
, SDATA (elem
), size
, &size
);
363 desc_type
= EndianU32_NtoB (desc_type
);
364 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
368 if (err
== noErr
|| desc_list
->descriptorType
== typeAEList
)
371 elem
= Qnil
; /* Don't skip elements in AEList. */
372 else if (desc_list
->descriptorType
!= typeAEList
)
375 elem
= Fcons (ae_attr_table
[count
-1].symbol
, elem
);
378 keyword
= EndianU32_NtoB (keyword
);
379 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4),
384 result
= Fcons (elem
, result
);
390 if (desc_list
->descriptorType
== typeAppleEvent
&& !attribute_p
)
393 count
= sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]);
397 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
398 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
402 mac_aedesc_to_lisp (desc
)
406 DescType desc_type
= desc
->descriptorType
;
418 return mac_aelist_to_lisp (desc
);
420 /* The following one is much simpler, but creates and disposes
421 of Apple event descriptors many times. */
428 err
= AECountItems (desc
, &count
);
434 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
437 elem
= mac_aedesc_to_lisp (&desc1
);
438 AEDisposeDesc (&desc1
);
439 if (desc_type
!= typeAEList
)
441 keyword
= EndianU32_NtoB (keyword
);
442 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
444 result
= Fcons (elem
, result
);
452 #if TARGET_API_MAC_CARBON
453 result
= make_uninit_string (AEGetDescDataSize (desc
));
454 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
456 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
457 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
465 desc_type
= EndianU32_NtoB (desc_type
);
466 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
470 mac_ae_put_lisp (desc
, keyword_or_index
, obj
)
472 UInt32 keyword_or_index
;
477 if (!(desc
->descriptorType
== typeAppleEvent
478 || desc
->descriptorType
== typeAERecord
479 || desc
->descriptorType
== typeAEList
))
480 return errAEWrongDataType
;
482 if (CONSP (obj
) && STRINGP (XCAR (obj
)) && SBYTES (XCAR (obj
)) == 4)
484 DescType desc_type1
= EndianU32_BtoN (*((UInt32
*) SDATA (XCAR (obj
))));
485 Lisp_Object data
= XCDR (obj
), rest
;
496 err
= AECreateList (NULL
, 0, desc_type1
== typeAERecord
, &desc1
);
499 for (rest
= data
; CONSP (rest
); rest
= XCDR (rest
))
501 UInt32 keyword_or_index1
= 0;
502 Lisp_Object elem
= XCAR (rest
);
504 if (desc_type1
== typeAERecord
)
506 if (CONSP (elem
) && STRINGP (XCAR (elem
))
507 && SBYTES (XCAR (elem
)) == 4)
510 EndianU32_BtoN (*((UInt32
*)
511 SDATA (XCAR (elem
))));
518 err
= mac_ae_put_lisp (&desc1
, keyword_or_index1
, elem
);
525 if (desc
->descriptorType
== typeAEList
)
526 err
= AEPutDesc (desc
, keyword_or_index
, &desc1
);
528 err
= AEPutParamDesc (desc
, keyword_or_index
, &desc1
);
531 AEDisposeDesc (&desc1
);
538 if (desc
->descriptorType
== typeAEList
)
539 err
= AEPutPtr (desc
, keyword_or_index
, desc_type1
,
540 SDATA (data
), SBYTES (data
));
542 err
= AEPutParamPtr (desc
, keyword_or_index
, desc_type1
,
543 SDATA (data
), SBYTES (data
));
548 if (desc
->descriptorType
== typeAEList
)
549 err
= AEPutPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
551 err
= AEPutParamPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
557 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
558 to_type
, handler_refcon
, result
)
560 const void *data_ptr
;
568 if (type_code
== typeNull
)
569 err
= errAECoercionFail
;
570 else if (type_code
== to_type
|| to_type
== typeWildCard
)
571 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
572 else if (type_code
== TYPE_FILE_NAME
)
573 /* Coercion from undecoded file name. */
578 CFDataRef data
= NULL
;
580 str
= CFStringCreateWithBytes (NULL
, data_ptr
, data_size
,
581 kCFStringEncodingUTF8
, false);
584 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
585 kCFURLPOSIXPathStyle
, false);
590 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
595 err
= AECoercePtr (typeFileURL
, CFDataGetBytePtr (data
),
596 CFDataGetLength (data
), to_type
, result
);
604 /* Just to be paranoid ... */
608 buf
= xmalloc (data_size
+ 1);
609 memcpy (buf
, data_ptr
, data_size
);
610 buf
[data_size
] = '\0';
611 err
= FSPathMakeRef (buf
, &fref
, NULL
);
614 err
= AECoercePtr (typeFSRef
, &fref
, sizeof (FSRef
),
621 buf
= xmalloc (data_size
+ 1);
622 memcpy (buf
, data_ptr
, data_size
);
623 buf
[data_size
] = '\0';
624 err
= posix_pathname_to_fsspec (buf
, &fs
);
627 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
630 else if (to_type
== TYPE_FILE_NAME
)
631 /* Coercion to undecoded file name. */
635 CFStringRef str
= NULL
;
636 CFDataRef data
= NULL
;
638 if (type_code
== typeFileURL
)
639 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
640 kCFStringEncodingUTF8
, NULL
);
647 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
651 size
= AEGetDescDataSize (&desc
);
652 buf
= xmalloc (size
);
653 err
= AEGetDescData (&desc
, buf
, size
);
655 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
656 kCFStringEncodingUTF8
, NULL
);
658 AEDisposeDesc (&desc
);
663 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
668 data
= CFStringCreateExternalRepresentation (NULL
, str
,
669 kCFStringEncodingUTF8
,
675 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
676 CFDataGetLength (data
), result
);
682 /* Coercion from typeAlias to typeFileURL fails on Mac OS X
683 10.2. In such cases, try typeFSRef as a target type. */
684 char file_name
[MAXPATHLEN
];
686 if (type_code
== typeFSRef
&& data_size
== sizeof (FSRef
))
687 err
= FSRefMakePath (data_ptr
, file_name
, sizeof (file_name
));
693 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
697 err
= AEGetDescData (&desc
, &fref
, sizeof (FSRef
));
698 AEDisposeDesc (&desc
);
701 err
= FSRefMakePath (&fref
, file_name
, sizeof (file_name
));
704 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
705 strlen (file_name
), result
);
708 char file_name
[MAXPATHLEN
];
710 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
711 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
712 sizeof (file_name
) - 1);
718 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
721 #if TARGET_API_MAC_CARBON
722 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
724 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
726 AEDisposeDesc (&desc
);
729 err
= fsspec_to_posix_pathname (&fs
, file_name
,
730 sizeof (file_name
) - 1);
733 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
734 strlen (file_name
), result
);
741 return errAECoercionFail
;
746 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
747 const AEDesc
*from_desc
;
753 DescType from_type
= from_desc
->descriptorType
;
755 if (from_type
== typeNull
)
756 err
= errAECoercionFail
;
757 else if (from_type
== to_type
|| to_type
== typeWildCard
)
758 err
= AEDuplicateDesc (from_desc
, result
);
764 #if TARGET_API_MAC_CARBON
765 data_size
= AEGetDescDataSize (from_desc
);
767 data_size
= GetHandleSize (from_desc
->dataHandle
);
769 data_ptr
= xmalloc (data_size
);
770 #if TARGET_API_MAC_CARBON
771 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
773 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
776 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
778 handler_refcon
, result
);
783 return errAECoercionFail
;
788 init_coercion_handler ()
792 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
793 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
795 if (coerce_file_name_ptrUPP
== NULL
)
797 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
798 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
801 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
802 (AECoercionHandlerUPP
)
803 coerce_file_name_ptrUPP
, 0, false, false);
805 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
806 (AECoercionHandlerUPP
)
807 coerce_file_name_ptrUPP
, 0, false, false);
809 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
810 coerce_file_name_descUPP
, 0, true, false);
812 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
813 coerce_file_name_descUPP
, 0, true, false);
817 #if TARGET_API_MAC_CARBON
819 create_apple_event (class, id
, result
)
825 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
826 AEAddressDesc address_desc
;
828 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
829 sizeof (ProcessSerialNumber
), &address_desc
);
832 err
= AECreateAppleEvent (class, id
,
833 &address_desc
, /* NULL is not allowed
834 on Mac OS Classic. */
835 kAutoGenerateReturnID
,
836 kAnyTransactionID
, result
);
837 AEDisposeDesc (&address_desc
);
844 mac_event_parameters_to_lisp (event
, num_params
, names
, types
)
847 const EventParamName
*names
;
848 const EventParamType
*types
;
851 Lisp_Object result
= Qnil
;
860 for (i
= 0; i
< num_params
; i
++)
862 EventParamName name
= names
[i
];
863 EventParamType type
= types
[i
];
868 case typeCFStringRef
:
869 err
= GetEventParameter (event
, name
, typeCFStringRef
, NULL
,
870 sizeof (CFStringRef
), NULL
, &string
);
873 data
= CFStringCreateExternalRepresentation (NULL
, string
,
874 kCFStringEncodingUTF8
,
878 name
= EndianU32_NtoB (name
);
879 type
= EndianU32_NtoB (typeUTF8Text
);
881 Fcons (Fcons (make_unibyte_string ((char *) &name
, 4),
882 Fcons (make_unibyte_string ((char *) &type
, 4),
883 make_unibyte_string (CFDataGetBytePtr (data
),
884 CFDataGetLength (data
)))),
891 err
= GetEventParameter (event
, name
, type
, NULL
, 0, &size
, NULL
);
894 buf
= xrealloc (buf
, size
);
895 err
= GetEventParameter (event
, name
, type
, NULL
, size
, NULL
, buf
);
898 name
= EndianU32_NtoB (name
);
899 type
= EndianU32_NtoB (type
);
901 Fcons (Fcons (make_unibyte_string ((char *) &name
, 4),
902 Fcons (make_unibyte_string ((char *) &type
, 4),
903 make_unibyte_string (buf
, size
))),
914 #endif /* TARGET_API_MAC_CARBON */
916 /***********************************************************************
917 Conversion between Lisp and Core Foundation objects
918 ***********************************************************************/
920 #if TARGET_API_MAC_CARBON
921 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
922 static Lisp_Object Qarray
, Qdictionary
;
924 struct cfdict_context
927 int with_tag
, hash_bound
;
930 /* C string to CFString. */
933 cfstring_create_with_utf8_cstring (c_str
)
938 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
940 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
941 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
947 /* Lisp string to CFString. */
950 cfstring_create_with_string (s
)
953 CFStringRef string
= NULL
;
955 if (STRING_MULTIBYTE (s
))
957 char *p
, *end
= SDATA (s
) + SBYTES (s
);
959 for (p
= SDATA (s
); p
< end
; p
++)
962 s
= ENCODE_UTF_8 (s
);
965 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
966 kCFStringEncodingUTF8
, false);
970 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
971 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
972 kCFStringEncodingMacRoman
, false);
978 /* From CFData to a lisp string. Always returns a unibyte string. */
981 cfdata_to_lisp (data
)
984 CFIndex len
= CFDataGetLength (data
);
985 Lisp_Object result
= make_uninit_string (len
);
987 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
993 /* From CFString to a lisp string. Returns a unibyte string
994 containing a UTF-8 byte sequence. */
997 cfstring_to_lisp_nodecode (string
)
1000 Lisp_Object result
= Qnil
;
1001 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
1004 result
= make_unibyte_string (s
, strlen (s
));
1008 CFStringCreateExternalRepresentation (NULL
, string
,
1009 kCFStringEncodingUTF8
, '?');
1013 result
= cfdata_to_lisp (data
);
1022 /* From CFString to a lisp string. Never returns a unibyte string
1023 (even if it only contains ASCII characters).
1024 This may cause GC during code conversion. */
1027 cfstring_to_lisp (string
)
1030 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
1034 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
1035 /* This may be superfluous. Just to make sure that the result
1036 is a multibyte string. */
1037 result
= string_to_multibyte (result
);
1044 /* CFNumber to a lisp integer or a lisp float. */
1047 cfnumber_to_lisp (number
)
1050 Lisp_Object result
= Qnil
;
1051 #if BITS_PER_EMACS_INT > 32
1053 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
1056 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
1060 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
1061 && !FIXNUM_OVERFLOW_P (int_val
))
1062 result
= make_number (int_val
);
1064 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
1065 result
= make_float (float_val
);
1070 /* CFDate to a list of three integers as in a return value of
1074 cfdate_to_lisp (date
)
1078 int high
, low
, microsec
;
1080 sec
= CFDateGetAbsoluteTime (date
) + kCFAbsoluteTimeIntervalSince1970
;
1081 high
= sec
/ 65536.0;
1082 low
= sec
- high
* 65536.0;
1083 microsec
= (sec
- floor (sec
)) * 1000000.0;
1085 return list3 (make_number (high
), make_number (low
), make_number (microsec
));
1089 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1092 cfboolean_to_lisp (boolean
)
1093 CFBooleanRef boolean
;
1095 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
1099 /* Any Core Foundation object to a (lengthy) lisp string. */
1102 cfobject_desc_to_lisp (object
)
1105 Lisp_Object result
= Qnil
;
1106 CFStringRef desc
= CFCopyDescription (object
);
1110 result
= cfstring_to_lisp (desc
);
1118 /* Callback functions for cfproperty_list_to_lisp. */
1121 cfdictionary_add_to_list (key
, value
, context
)
1126 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1129 Fcons (Fcons (cfstring_to_lisp (key
),
1130 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
1136 cfdictionary_puthash (key
, value
, context
)
1141 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
1142 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1143 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
1146 hash_lookup (h
, lisp_key
, &hash_code
);
1147 hash_put (h
, lisp_key
,
1148 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
1153 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1154 non-zero, a symbol that represents the type of the original Core
1155 Foundation object is prepended. HASH_BOUND specifies which kinds
1156 of the lisp objects, alists or hash tables, are used as the targets
1157 of the conversion from CFDictionary. If HASH_BOUND is negative,
1158 always generate alists. If HASH_BOUND >= 0, generate an alist if
1159 the number of keys in the dictionary is smaller than HASH_BOUND,
1160 and a hash table otherwise. */
1163 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
1164 CFPropertyListRef plist
;
1165 int with_tag
, hash_bound
;
1167 CFTypeID type_id
= CFGetTypeID (plist
);
1168 Lisp_Object tag
= Qnil
, result
= Qnil
;
1169 struct gcpro gcpro1
, gcpro2
;
1171 GCPRO2 (tag
, result
);
1173 if (type_id
== CFStringGetTypeID ())
1176 result
= cfstring_to_lisp (plist
);
1178 else if (type_id
== CFNumberGetTypeID ())
1181 result
= cfnumber_to_lisp (plist
);
1183 else if (type_id
== CFBooleanGetTypeID ())
1186 result
= cfboolean_to_lisp (plist
);
1188 else if (type_id
== CFDateGetTypeID ())
1191 result
= cfdate_to_lisp (plist
);
1193 else if (type_id
== CFDataGetTypeID ())
1196 result
= cfdata_to_lisp (plist
);
1198 else if (type_id
== CFArrayGetTypeID ())
1200 CFIndex index
, count
= CFArrayGetCount (plist
);
1203 result
= Fmake_vector (make_number (count
), Qnil
);
1204 for (index
= 0; index
< count
; index
++)
1205 XVECTOR (result
)->contents
[index
] =
1206 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1207 with_tag
, hash_bound
);
1209 else if (type_id
== CFDictionaryGetTypeID ())
1211 struct cfdict_context context
;
1212 CFIndex count
= CFDictionaryGetCount (plist
);
1215 context
.result
= &result
;
1216 context
.with_tag
= with_tag
;
1217 context
.hash_bound
= hash_bound
;
1218 if (hash_bound
< 0 || count
< hash_bound
)
1221 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1226 result
= make_hash_table (Qequal
,
1227 make_number (count
),
1228 make_float (DEFAULT_REHASH_SIZE
),
1229 make_float (DEFAULT_REHASH_THRESHOLD
),
1231 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1241 result
= Fcons (tag
, result
);
1248 /***********************************************************************
1249 Emulation of the X Resource Manager
1250 ***********************************************************************/
1252 /* Parser functions for resource lines. Each function takes an
1253 address of a variable whose value points to the head of a string.
1254 The value will be advanced so that it points to the next character
1255 of the parsed part when the function returns.
1257 A resource name such as "Emacs*font" is parsed into a non-empty
1258 list called `quarks'. Each element is either a Lisp string that
1259 represents a concrete component, a Lisp symbol LOOSE_BINDING
1260 (actually Qlambda) that represents any number (>=0) of intervening
1261 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1262 that represents as any single component. */
1266 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1267 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1270 skip_white_space (p
)
1273 /* WhiteSpace = {<space> | <horizontal tab>} */
1274 while (*P
== ' ' || *P
== '\t')
1282 /* Comment = "!" {<any character except null or newline>} */
1295 /* Don't interpret filename. Just skip until the newline. */
1297 parse_include_file (p
)
1300 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1317 /* Binding = "." | "*" */
1318 if (*P
== '.' || *P
== '*')
1320 char binding
= *P
++;
1322 while (*P
== '.' || *P
== '*')
1335 /* Component = "?" | ComponentName
1336 ComponentName = NameChar {NameChar}
1337 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1341 return SINGLE_COMPONENT
;
1343 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1345 const char *start
= P
++;
1347 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1350 return make_unibyte_string (start
, P
- start
);
1357 parse_resource_name (p
)
1360 Lisp_Object result
= Qnil
, component
;
1363 /* ResourceName = [Binding] {Component Binding} ComponentName */
1364 if (parse_binding (p
) == '*')
1365 result
= Fcons (LOOSE_BINDING
, result
);
1367 component
= parse_component (p
);
1368 if (NILP (component
))
1371 result
= Fcons (component
, result
);
1372 while ((binding
= parse_binding (p
)) != '\0')
1375 result
= Fcons (LOOSE_BINDING
, result
);
1376 component
= parse_component (p
);
1377 if (NILP (component
))
1380 result
= Fcons (component
, result
);
1383 /* The final component should not be '?'. */
1384 if (EQ (component
, SINGLE_COMPONENT
))
1387 return Fnreverse (result
);
1395 Lisp_Object seq
= Qnil
, result
;
1396 int buf_len
, total_len
= 0, len
, continue_p
;
1398 q
= strchr (P
, '\n');
1399 buf_len
= q
? q
- P
: strlen (P
);
1400 buf
= xmalloc (buf_len
);
1413 else if (*P
== '\\')
1418 else if (*P
== '\n')
1429 else if ('0' <= P
[0] && P
[0] <= '7'
1430 && '0' <= P
[1] && P
[1] <= '7'
1431 && '0' <= P
[2] && P
[2] <= '7')
1433 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1443 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1448 q
= strchr (P
, '\n');
1449 len
= q
? q
- P
: strlen (P
);
1454 buf
= xmalloc (buf_len
);
1462 if (SBYTES (XCAR (seq
)) == total_len
)
1463 return make_string (SDATA (XCAR (seq
)), total_len
);
1466 buf
= xmalloc (total_len
);
1467 q
= buf
+ total_len
;
1468 for (; CONSP (seq
); seq
= XCDR (seq
))
1470 len
= SBYTES (XCAR (seq
));
1472 memcpy (q
, SDATA (XCAR (seq
)), len
);
1474 result
= make_string (buf
, total_len
);
1481 parse_resource_line (p
)
1484 Lisp_Object quarks
, value
;
1486 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1487 if (parse_comment (p
) || parse_include_file (p
))
1490 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1491 skip_white_space (p
);
1492 quarks
= parse_resource_name (p
);
1495 skip_white_space (p
);
1499 skip_white_space (p
);
1500 value
= parse_value (p
);
1501 return Fcons (quarks
, value
);
1504 /* Skip the remaining data as a dummy value. */
1511 /* Equivalents of X Resource Manager functions.
1513 An X Resource Database acts as a collection of resource names and
1514 associated values. It is implemented as a trie on quarks. Namely,
1515 each edge is labeled by either a string, LOOSE_BINDING, or
1516 SINGLE_COMPONENT. Each node has a node id, which is a unique
1517 nonnegative integer, and the root node id is 0. A database is
1518 implemented as a hash table that maps a pair (SRC-NODE-ID .
1519 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1520 in the table as a value for HASHKEY_MAX_NID. A value associated to
1521 a node is recorded as a value for the node id.
1523 A database also has a cache for past queries as a value for
1524 HASHKEY_QUERY_CACHE. It is another hash table that maps
1525 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1527 #define HASHKEY_MAX_NID (make_number (0))
1528 #define HASHKEY_QUERY_CACHE (make_number (-1))
1531 xrm_create_database ()
1533 XrmDatabase database
;
1535 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1536 make_float (DEFAULT_REHASH_SIZE
),
1537 make_float (DEFAULT_REHASH_THRESHOLD
),
1539 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1540 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1546 xrm_q_put_resource (database
, quarks
, value
)
1547 XrmDatabase database
;
1548 Lisp_Object quarks
, value
;
1550 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1553 Lisp_Object node_id
, key
;
1555 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1557 XSETINT (node_id
, 0);
1558 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1560 key
= Fcons (node_id
, XCAR (quarks
));
1561 i
= hash_lookup (h
, key
, &hash_code
);
1565 XSETINT (node_id
, max_nid
);
1566 hash_put (h
, key
, node_id
, hash_code
);
1569 node_id
= HASH_VALUE (h
, i
);
1571 Fputhash (node_id
, value
, database
);
1573 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1574 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1577 /* Merge multiple resource entries specified by DATA into a resource
1578 database DATABASE. DATA points to the head of a null-terminated
1579 string consisting of multiple resource lines. It's like a
1580 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1583 xrm_merge_string_database (database
, data
)
1584 XrmDatabase database
;
1587 Lisp_Object quarks_value
;
1591 quarks_value
= parse_resource_line (&data
);
1592 if (!NILP (quarks_value
))
1593 xrm_q_put_resource (database
,
1594 XCAR (quarks_value
), XCDR (quarks_value
));
1599 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1600 XrmDatabase database
;
1601 Lisp_Object node_id
, quark_name
, quark_class
;
1603 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1604 Lisp_Object key
, labels
[3], value
;
1607 if (!CONSP (quark_name
))
1608 return Fgethash (node_id
, database
, Qnil
);
1610 /* First, try tight bindings */
1611 labels
[0] = XCAR (quark_name
);
1612 labels
[1] = XCAR (quark_class
);
1613 labels
[2] = SINGLE_COMPONENT
;
1615 key
= Fcons (node_id
, Qnil
);
1616 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1618 XSETCDR (key
, labels
[k
]);
1619 i
= hash_lookup (h
, key
, NULL
);
1622 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1623 XCDR (quark_name
), XCDR (quark_class
));
1629 /* Then, try loose bindings */
1630 XSETCDR (key
, LOOSE_BINDING
);
1631 i
= hash_lookup (h
, key
, NULL
);
1634 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1635 quark_name
, quark_class
);
1639 return xrm_q_get_resource_1 (database
, node_id
,
1640 XCDR (quark_name
), XCDR (quark_class
));
1647 xrm_q_get_resource (database
, quark_name
, quark_class
)
1648 XrmDatabase database
;
1649 Lisp_Object quark_name
, quark_class
;
1651 return xrm_q_get_resource_1 (database
, make_number (0),
1652 quark_name
, quark_class
);
1655 /* Retrieve a resource value for the specified NAME and CLASS from the
1656 resource database DATABASE. It corresponds to XrmGetResource. */
1659 xrm_get_resource (database
, name
, class)
1660 XrmDatabase database
;
1661 const char *name
, *class;
1663 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1665 struct Lisp_Hash_Table
*h
;
1669 nc
= strlen (class);
1670 key
= make_uninit_string (nn
+ nc
+ 1);
1671 strcpy (SDATA (key
), name
);
1672 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1674 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1675 if (NILP (query_cache
))
1677 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1678 make_float (DEFAULT_REHASH_SIZE
),
1679 make_float (DEFAULT_REHASH_THRESHOLD
),
1681 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1683 h
= XHASH_TABLE (query_cache
);
1684 i
= hash_lookup (h
, key
, &hash_code
);
1686 return HASH_VALUE (h
, i
);
1688 quark_name
= parse_resource_name (&name
);
1691 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1692 if (!STRINGP (XCAR (tmp
)))
1695 quark_class
= parse_resource_name (&class);
1698 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1699 if (!STRINGP (XCAR (tmp
)))
1706 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1707 hash_put (h
, key
, tmp
, hash_code
);
1712 #if TARGET_API_MAC_CARBON
1714 xrm_cfproperty_list_to_value (plist
)
1715 CFPropertyListRef plist
;
1717 CFTypeID type_id
= CFGetTypeID (plist
);
1719 if (type_id
== CFStringGetTypeID ())
1720 return cfstring_to_lisp (plist
);
1721 else if (type_id
== CFNumberGetTypeID ())
1724 Lisp_Object result
= Qnil
;
1726 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1729 result
= cfstring_to_lisp (string
);
1734 else if (type_id
== CFBooleanGetTypeID ())
1735 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1736 else if (type_id
== CFDataGetTypeID ())
1737 return cfdata_to_lisp (plist
);
1743 /* Create a new resource database from the preferences for the
1744 application APPLICATION. APPLICATION is either a string that
1745 specifies an application ID, or NULL that represents the current
1749 xrm_get_preference_database (application
)
1750 const char *application
;
1752 #if TARGET_API_MAC_CARBON
1753 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1754 CFMutableSetRef key_set
= NULL
;
1755 CFArrayRef key_array
;
1756 CFIndex index
, count
;
1758 XrmDatabase database
;
1759 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1760 CFPropertyListRef plist
;
1762 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1764 user_doms
[0] = kCFPreferencesCurrentUser
;
1765 user_doms
[1] = kCFPreferencesAnyUser
;
1766 host_doms
[0] = kCFPreferencesCurrentHost
;
1767 host_doms
[1] = kCFPreferencesAnyHost
;
1769 database
= xrm_create_database ();
1771 GCPRO3 (database
, quarks
, value
);
1773 app_id
= kCFPreferencesCurrentApplication
;
1776 app_id
= cfstring_create_with_utf8_cstring (application
);
1780 if (!CFPreferencesAppSynchronize (app_id
))
1783 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1784 if (key_set
== NULL
)
1786 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1787 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1789 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1793 count
= CFArrayGetCount (key_array
);
1794 for (index
= 0; index
< count
; index
++)
1795 CFSetAddValue (key_set
,
1796 CFArrayGetValueAtIndex (key_array
, index
));
1797 CFRelease (key_array
);
1801 count
= CFSetGetCount (key_set
);
1802 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1803 CFSetGetValues (key_set
, (const void **)keys
);
1804 for (index
= 0; index
< count
; index
++)
1806 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1807 quarks
= parse_resource_name (&res_name
);
1808 if (!(NILP (quarks
) || *res_name
))
1810 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1811 value
= xrm_cfproperty_list_to_value (plist
);
1814 xrm_q_put_resource (database
, quarks
, value
);
1821 CFRelease (key_set
);
1828 return xrm_create_database ();
1835 /* The following functions with "sys_" prefix are stubs to Unix
1836 functions that have already been implemented by CW or MPW. The
1837 calls to them in Emacs source course are #define'd to call the sys_
1838 versions by the header files s-mac.h. In these stubs pathnames are
1839 converted between their Unix and Mac forms. */
1842 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1843 + 17 leap days. These are for adjusting time values returned by
1844 MacOS Toolbox functions. */
1846 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1849 #if __MSL__ < 0x6000
1850 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1851 a leap year! This is for adjusting time_t values returned by MSL
1853 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1854 #else /* __MSL__ >= 0x6000 */
1855 /* CW changes Pro 6 to follow Unix! */
1856 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1857 #endif /* __MSL__ >= 0x6000 */
1859 /* MPW library functions follow Unix (confused?). */
1860 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1861 #else /* not __MRC__ */
1863 #endif /* not __MRC__ */
1866 /* Define our own stat function for both MrC and CW. The reason for
1867 doing this: "stat" is both the name of a struct and function name:
1868 can't use the same trick like that for sys_open, sys_close, etc. to
1869 redirect Emacs's calls to our own version that converts Unix style
1870 filenames to Mac style filename because all sorts of compilation
1871 errors will be generated if stat is #define'd to be sys_stat. */
1874 stat_noalias (const char *path
, struct stat
*buf
)
1876 char mac_pathname
[MAXPATHLEN
+1];
1879 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1882 c2pstr (mac_pathname
);
1883 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1884 cipb
.hFileInfo
.ioVRefNum
= 0;
1885 cipb
.hFileInfo
.ioDirID
= 0;
1886 cipb
.hFileInfo
.ioFDirIndex
= 0;
1887 /* set to 0 to get information about specific dir or file */
1889 errno
= PBGetCatInfo (&cipb
, false);
1890 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1895 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1897 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1899 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1900 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1901 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1902 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1903 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1904 /* size of dir = number of files and dirs */
1907 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1908 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1912 buf
->st_mode
= S_IFREG
| S_IREAD
;
1913 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1914 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1915 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1916 buf
->st_mode
|= S_IEXEC
;
1917 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1918 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1919 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1922 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1923 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1926 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1928 /* identify alias files as symlinks */
1929 buf
->st_mode
&= ~S_IFREG
;
1930 buf
->st_mode
|= S_IFLNK
;
1934 buf
->st_uid
= getuid ();
1935 buf
->st_gid
= getgid ();
1943 lstat (const char *path
, struct stat
*buf
)
1946 char true_pathname
[MAXPATHLEN
+1];
1948 /* Try looking for the file without resolving aliases first. */
1949 if ((result
= stat_noalias (path
, buf
)) >= 0)
1952 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1955 return stat_noalias (true_pathname
, buf
);
1960 stat (const char *path
, struct stat
*sb
)
1963 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1966 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1967 ! (sb
->st_mode
& S_IFLNK
))
1970 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1973 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1976 fully_resolved_name
[len
] = '\0';
1977 /* in fact our readlink terminates strings */
1978 return lstat (fully_resolved_name
, sb
);
1981 return lstat (true_pathname
, sb
);
1986 /* CW defines fstat in stat.mac.c while MPW does not provide this
1987 function. Without the information of how to get from a file
1988 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1989 to implement this function. Fortunately, there is only one place
1990 where this function is called in our configuration: in fileio.c,
1991 where only the st_dev and st_ino fields are used to determine
1992 whether two fildes point to different i-nodes to prevent copying
1993 a file onto itself equal. What we have here probably needs
1997 fstat (int fildes
, struct stat
*buf
)
2000 buf
->st_ino
= fildes
;
2001 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
2002 return 0; /* success */
2004 #endif /* __MRC__ */
2008 mkdir (const char *dirname
, int mode
)
2010 #pragma unused(mode)
2013 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
2015 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
2018 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2021 c2pstr (mac_pathname
);
2022 hfpb
.ioNamePtr
= mac_pathname
;
2023 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2024 hfpb
.ioDirID
= 0; /* parent is the root */
2026 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
2027 /* just return the Mac OSErr code for now */
2028 return errno
== noErr
? 0 : -1;
2033 sys_rmdir (const char *dirname
)
2036 char mac_pathname
[MAXPATHLEN
+1];
2038 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2041 c2pstr (mac_pathname
);
2042 hfpb
.ioNamePtr
= mac_pathname
;
2043 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2044 hfpb
.ioDirID
= 0; /* parent is the root */
2046 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
2047 return errno
== noErr
? 0 : -1;
2052 /* No implementation yet. */
2054 execvp (const char *path
, ...)
2058 #endif /* __MRC__ */
2062 utime (const char *path
, const struct utimbuf
*times
)
2064 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2066 char mac_pathname
[MAXPATHLEN
+1];
2069 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2072 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2074 fully_resolved_name
[len
] = '\0';
2076 strcpy (fully_resolved_name
, true_pathname
);
2078 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2081 c2pstr (mac_pathname
);
2082 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2083 cipb
.hFileInfo
.ioVRefNum
= 0;
2084 cipb
.hFileInfo
.ioDirID
= 0;
2085 cipb
.hFileInfo
.ioFDirIndex
= 0;
2086 /* set to 0 to get information about specific dir or file */
2088 errno
= PBGetCatInfo (&cipb
, false);
2092 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
2095 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2097 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
2102 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2104 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
2107 errno
= PBSetCatInfo (&cipb
, false);
2108 return errno
== noErr
? 0 : -1;
2122 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2124 access (const char *path
, int mode
)
2126 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2128 char mac_pathname
[MAXPATHLEN
+1];
2131 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2134 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2136 fully_resolved_name
[len
] = '\0';
2138 strcpy (fully_resolved_name
, true_pathname
);
2140 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2143 c2pstr (mac_pathname
);
2144 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2145 cipb
.hFileInfo
.ioVRefNum
= 0;
2146 cipb
.hFileInfo
.ioDirID
= 0;
2147 cipb
.hFileInfo
.ioFDirIndex
= 0;
2148 /* set to 0 to get information about specific dir or file */
2150 errno
= PBGetCatInfo (&cipb
, false);
2154 if (mode
== F_OK
) /* got this far, file exists */
2158 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
2162 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2169 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2170 /* don't allow if lock bit is on */
2176 #define DEV_NULL_FD 0x10000
2180 sys_open (const char *path
, int oflag
)
2182 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2184 char mac_pathname
[MAXPATHLEN
+1];
2186 if (strcmp (path
, "/dev/null") == 0)
2187 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2189 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2192 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2194 fully_resolved_name
[len
] = '\0';
2196 strcpy (fully_resolved_name
, true_pathname
);
2198 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2203 int res
= open (mac_pathname
, oflag
);
2204 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2205 if (oflag
& O_CREAT
)
2206 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2208 #else /* not __MRC__ */
2209 return open (mac_pathname
, oflag
);
2210 #endif /* not __MRC__ */
2217 sys_creat (const char *path
, mode_t mode
)
2219 char true_pathname
[MAXPATHLEN
+1];
2221 char mac_pathname
[MAXPATHLEN
+1];
2223 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2226 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2231 int result
= creat (mac_pathname
);
2232 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2234 #else /* not __MRC__ */
2235 return creat (mac_pathname
, mode
);
2236 #endif /* not __MRC__ */
2243 sys_unlink (const char *path
)
2245 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2247 char mac_pathname
[MAXPATHLEN
+1];
2249 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2252 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2254 fully_resolved_name
[len
] = '\0';
2256 strcpy (fully_resolved_name
, true_pathname
);
2258 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2261 return unlink (mac_pathname
);
2267 sys_read (int fildes
, char *buf
, int count
)
2269 if (fildes
== 0) /* this should not be used for console input */
2272 #if __MSL__ >= 0x6000
2273 return _read (fildes
, buf
, count
);
2275 return read (fildes
, buf
, count
);
2282 sys_write (int fildes
, const char *buf
, int count
)
2284 if (fildes
== DEV_NULL_FD
)
2287 #if __MSL__ >= 0x6000
2288 return _write (fildes
, buf
, count
);
2290 return write (fildes
, buf
, count
);
2297 sys_rename (const char * old_name
, const char * new_name
)
2299 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2300 char fully_resolved_old_name
[MAXPATHLEN
+1];
2302 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2304 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2307 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2309 fully_resolved_old_name
[len
] = '\0';
2311 strcpy (fully_resolved_old_name
, true_old_pathname
);
2313 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2316 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2319 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2324 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2327 /* If a file with new_name already exists, rename deletes the old
2328 file in Unix. CW version fails in these situation. So we add a
2329 call to unlink here. */
2330 (void) unlink (mac_new_name
);
2332 return rename (mac_old_name
, mac_new_name
);
2337 extern FILE *fopen (const char *name
, const char *mode
);
2339 sys_fopen (const char *name
, const char *mode
)
2341 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2343 char mac_pathname
[MAXPATHLEN
+1];
2345 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2348 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2350 fully_resolved_name
[len
] = '\0';
2352 strcpy (fully_resolved_name
, true_pathname
);
2354 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2359 if (mode
[0] == 'w' || mode
[0] == 'a')
2360 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2361 #endif /* not __MRC__ */
2362 return fopen (mac_pathname
, mode
);
2367 extern Boolean mac_wait_next_event
P_ ((EventRecord
*, UInt32
, Boolean
));
2370 select (nfds
, rfds
, wfds
, efds
, timeout
)
2372 SELECT_TYPE
*rfds
, *wfds
, *efds
;
2373 EMACS_TIME
*timeout
;
2375 OSStatus err
= noErr
;
2377 /* Can only handle wait for keyboard input. */
2378 if (nfds
> 1 || wfds
|| efds
)
2381 /* Try detect_input_pending before ReceiveNextEvent in the same
2382 BLOCK_INPUT block, in case that some input has already been read
2385 ENABLE_WAKEUP_FROM_RNE
;
2386 if (!detect_input_pending ())
2388 #if TARGET_API_MAC_CARBON
2389 EventTimeout timeoutval
=
2391 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2392 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2393 : kEventDurationForever
);
2395 if (timeoutval
== 0.0)
2396 err
= eventLoopTimedOutErr
;
2398 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
2399 kEventLeaveInQueue
, NULL
);
2400 #else /* not TARGET_API_MAC_CARBON */
2402 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2403 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2405 if (sleep_time
== 0)
2406 err
= -9875; /* eventLoopTimedOutErr */
2409 if (mac_wait_next_event (&e
, sleep_time
, false))
2412 err
= -9875; /* eventLoopTimedOutErr */
2414 #endif /* not TARGET_API_MAC_CARBON */
2416 DISABLE_WAKEUP_FROM_RNE
;
2421 /* Pretend that `select' is interrupted by a signal. */
2422 detect_input_pending ();
2435 /* Simulation of SIGALRM. The stub for function signal stores the
2436 signal handler function in alarm_signal_func if a SIGALRM is
2440 #include "syssignal.h"
2442 static TMTask mac_atimer_task
;
2444 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2446 static int signal_mask
= 0;
2449 __sigfun alarm_signal_func
= (__sigfun
) 0;
2451 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2452 #else /* not __MRC__ and not __MWERKS__ */
2454 #endif /* not __MRC__ and not __MWERKS__ */
2458 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2460 sys_signal (int signal_num
, __sigfun signal_func
)
2462 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2464 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2465 #else /* not __MRC__ and not __MWERKS__ */
2467 #endif /* not __MRC__ and not __MWERKS__ */
2469 if (signal_num
!= SIGALRM
)
2470 return signal (signal_num
, signal_func
);
2474 __sigfun old_signal_func
;
2476 __signal_func_ptr old_signal_func
;
2480 old_signal_func
= alarm_signal_func
;
2481 alarm_signal_func
= signal_func
;
2482 return old_signal_func
;
2488 mac_atimer_handler (qlink
)
2491 if (alarm_signal_func
)
2492 (alarm_signal_func
) (SIGALRM
);
2497 set_mac_atimer (count
)
2500 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2502 if (mac_atimer_handlerUPP
== NULL
)
2503 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2504 mac_atimer_task
.tmCount
= 0;
2505 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2506 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2507 InsTime (mac_atimer_qlink
);
2509 PrimeTime (mac_atimer_qlink
, count
);
2514 remove_mac_atimer (remaining_count
)
2515 long *remaining_count
;
2517 if (mac_atimer_qlink
)
2519 RmvTime (mac_atimer_qlink
);
2520 if (remaining_count
)
2521 *remaining_count
= mac_atimer_task
.tmCount
;
2522 mac_atimer_qlink
= NULL
;
2534 int old_mask
= signal_mask
;
2536 signal_mask
|= mask
;
2538 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2539 remove_mac_atimer (NULL
);
2546 sigsetmask (int mask
)
2548 int old_mask
= signal_mask
;
2552 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2553 if (signal_mask
& sigmask (SIGALRM
))
2554 remove_mac_atimer (NULL
);
2556 set_mac_atimer (mac_atimer_task
.tmCount
);
2565 long remaining_count
;
2567 if (remove_mac_atimer (&remaining_count
) == 0)
2569 set_mac_atimer (seconds
* 1000);
2571 return remaining_count
/ 1000;
2575 mac_atimer_task
.tmCount
= seconds
* 1000;
2583 setitimer (which
, value
, ovalue
)
2585 const struct itimerval
*value
;
2586 struct itimerval
*ovalue
;
2588 long remaining_count
;
2589 long count
= (EMACS_SECS (value
->it_value
) * 1000
2590 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2592 if (remove_mac_atimer (&remaining_count
) == 0)
2596 bzero (ovalue
, sizeof (*ovalue
));
2597 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2598 (remaining_count
% 1000) * 1000);
2600 set_mac_atimer (count
);
2603 mac_atimer_task
.tmCount
= count
;
2609 /* gettimeofday should return the amount of time (in a timeval
2610 structure) since midnight today. The toolbox function Microseconds
2611 returns the number of microseconds (in a UnsignedWide value) since
2612 the machine was booted. Also making this complicated is WideAdd,
2613 WideSubtract, etc. take wide values. */
2620 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2621 UnsignedWide uw_microseconds
;
2622 wide w_microseconds
;
2623 time_t sys_time (time_t *);
2625 /* If this function is called for the first time, record the number
2626 of seconds since midnight and the number of microseconds since
2627 boot at the time of this first call. */
2632 systime
= sys_time (NULL
);
2633 /* Store microseconds since midnight in wall_clock_at_epoch. */
2634 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2635 Microseconds (&uw_microseconds
);
2636 /* Store microseconds since boot in clicks_at_epoch. */
2637 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2638 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2641 /* Get time since boot */
2642 Microseconds (&uw_microseconds
);
2644 /* Convert to time since midnight*/
2645 w_microseconds
.hi
= uw_microseconds
.hi
;
2646 w_microseconds
.lo
= uw_microseconds
.lo
;
2647 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2648 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2649 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2657 sleep (unsigned int seconds
)
2659 unsigned long time_up
;
2662 time_up
= TickCount () + seconds
* 60;
2663 while (TickCount () < time_up
)
2665 /* Accept no event; just wait. by T.I. */
2666 WaitNextEvent (0, &e
, 30, NULL
);
2671 #endif /* __MRC__ */
2674 /* The time functions adjust time values according to the difference
2675 between the Unix and CW epoches. */
2678 extern struct tm
*gmtime (const time_t *);
2680 sys_gmtime (const time_t *timer
)
2682 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2684 return gmtime (&unix_time
);
2689 extern struct tm
*localtime (const time_t *);
2691 sys_localtime (const time_t *timer
)
2693 #if __MSL__ >= 0x6000
2694 time_t unix_time
= *timer
;
2696 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2699 return localtime (&unix_time
);
2704 extern char *ctime (const time_t *);
2706 sys_ctime (const time_t *timer
)
2708 #if __MSL__ >= 0x6000
2709 time_t unix_time
= *timer
;
2711 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2714 return ctime (&unix_time
);
2719 extern time_t time (time_t *);
2721 sys_time (time_t *timer
)
2723 #if __MSL__ >= 0x6000
2724 time_t mac_time
= time (NULL
);
2726 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2736 /* no subprocesses, empty wait */
2746 croak (char *badfunc
)
2748 printf ("%s not yet implemented\r\n", badfunc
);
2754 mktemp (char *template)
2759 len
= strlen (template);
2761 while (k
>= 0 && template[k
] == 'X')
2764 k
++; /* make k index of first 'X' */
2768 /* Zero filled, number of digits equal to the number of X's. */
2769 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2778 /* Emulate getpwuid, getpwnam and others. */
2780 #define PASSWD_FIELD_SIZE 256
2782 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2783 static char my_passwd_dir
[MAXPATHLEN
+1];
2785 static struct passwd my_passwd
=
2791 static struct group my_group
=
2793 /* There are no groups on the mac, so we just return "root" as the
2799 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2801 char emacs_passwd_dir
[MAXPATHLEN
+1];
2807 init_emacs_passwd_dir ()
2811 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2813 /* Need pathname of first ancestor that begins with "emacs"
2814 since Mac emacs application is somewhere in the emacs-*
2816 int len
= strlen (emacs_passwd_dir
);
2818 /* j points to the "/" following the directory name being
2821 while (i
>= 0 && !found
)
2823 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2825 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2826 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2828 emacs_passwd_dir
[j
+1] = '\0';
2839 /* Setting to "/" probably won't work but set it to something
2841 strcpy (emacs_passwd_dir
, "/");
2842 strcpy (my_passwd_dir
, "/");
2847 static struct passwd emacs_passwd
=
2853 static int my_passwd_inited
= 0;
2861 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2862 directory where Emacs was started. */
2864 owner_name
= (char **) GetResource ('STR ',-16096);
2868 BlockMove ((unsigned char *) *owner_name
,
2869 (unsigned char *) my_passwd_name
,
2871 HUnlock (owner_name
);
2872 p2cstr ((unsigned char *) my_passwd_name
);
2875 my_passwd_name
[0] = 0;
2880 getpwuid (uid_t uid
)
2882 if (!my_passwd_inited
)
2885 my_passwd_inited
= 1;
2893 getgrgid (gid_t gid
)
2900 getpwnam (const char *name
)
2902 if (strcmp (name
, "emacs") == 0)
2903 return &emacs_passwd
;
2905 if (!my_passwd_inited
)
2908 my_passwd_inited
= 1;
2915 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2916 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2937 error ("Can't spawn subshell");
2942 request_sigio (void)
2948 unrequest_sigio (void)
2963 pipe (int _fildes
[2])
2970 /* Hard and symbolic links. */
2973 symlink (const char *name1
, const char *name2
)
2981 link (const char *name1
, const char *name2
)
2987 #endif /* ! MAC_OSX */
2989 /* Determine the path name of the file specified by VREFNUM, DIRID,
2990 and NAME and place that in the buffer PATH of length
2993 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2994 long dir_id
, ConstStr255Param name
)
3000 if (strlen (name
) > man_path_len
)
3003 memcpy (dir_name
, name
, name
[0]+1);
3004 memcpy (path
, name
, name
[0]+1);
3007 cipb
.dirInfo
.ioDrParID
= dir_id
;
3008 cipb
.dirInfo
.ioNamePtr
= dir_name
;
3012 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
3013 cipb
.dirInfo
.ioFDirIndex
= -1;
3014 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
3015 /* go up to parent each time */
3017 err
= PBGetCatInfo (&cipb
, false);
3022 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
3025 strcat (dir_name
, ":");
3026 strcat (dir_name
, path
);
3027 /* attach to front since we're going up directory tree */
3028 strcpy (path
, dir_name
);
3030 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
3031 /* stop when we see the volume's root directory */
3033 return 1; /* success */
3040 posix_pathname_to_fsspec (ufn
, fs
)
3044 Str255 mac_pathname
;
3046 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
3050 c2pstr (mac_pathname
);
3051 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
3056 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
3061 char mac_pathname
[MAXPATHLEN
];
3063 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
3064 fs
->vRefNum
, fs
->parID
, fs
->name
)
3065 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
3072 readlink (const char *path
, char *buf
, int bufsiz
)
3074 char mac_sym_link_name
[MAXPATHLEN
+1];
3077 Boolean target_is_folder
, was_aliased
;
3078 Str255 directory_name
, mac_pathname
;
3081 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
3084 c2pstr (mac_sym_link_name
);
3085 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
3092 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
3093 if (err
!= noErr
|| !was_aliased
)
3099 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
3106 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
3112 return strlen (buf
);
3116 /* Convert a path to one with aliases fully expanded. */
3119 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
3121 char *q
, temp
[MAXPATHLEN
+1];
3125 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
3132 q
= strchr (p
+ 1, '/');
3134 q
= strchr (p
, '/');
3135 len
= 0; /* loop may not be entered, e.g., for "/" */
3140 strncat (temp
, p
, q
- p
);
3141 len
= readlink (temp
, buf
, bufsiz
);
3144 if (strlen (temp
) + 1 > bufsiz
)
3154 if (len
+ strlen (p
) + 1 >= bufsiz
)
3158 return len
+ strlen (p
);
3163 umask (mode_t numask
)
3165 static mode_t mask
= 022;
3166 mode_t oldmask
= mask
;
3173 chmod (const char *path
, mode_t mode
)
3175 /* say it always succeed for now */
3181 fchmod (int fd
, mode_t mode
)
3183 /* say it always succeed for now */
3189 fchown (int fd
, uid_t owner
, gid_t group
)
3191 /* say it always succeed for now */
3200 return fcntl (oldd
, F_DUPFD
, 0);
3202 /* current implementation of fcntl in fcntl.mac.c simply returns old
3204 return fcntl (oldd
, F_DUPFD
);
3211 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3212 newd if it already exists. Then, attempt to dup oldd. If not
3213 successful, call dup2 recursively until we are, then close the
3214 unsuccessful ones. */
3217 dup2 (int oldd
, int newd
)
3228 ret
= dup2 (oldd
, newd
);
3234 /* let it fail for now */
3251 ioctl (int d
, int request
, void *argp
)
3261 if (fildes
>=0 && fildes
<= 2)
3294 #endif /* __MRC__ */
3298 #if __MSL__ < 0x6000
3306 #endif /* __MWERKS__ */
3308 #endif /* ! MAC_OSX */
3311 /* Return the path to the directory in which Emacs can create
3312 temporary files. The MacOS "temporary items" directory cannot be
3313 used because it removes the file written by a process when it
3314 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3315 again not exactly). And of course Emacs needs to read back the
3316 files written by its subprocesses. So here we write the files to a
3317 directory "Emacs" in the Preferences Folder. This directory is
3318 created if it does not exist. */
3321 get_temp_dir_name ()
3323 static char *temp_dir_name
= NULL
;
3328 char unix_dir_name
[MAXPATHLEN
+1];
3331 /* Cache directory name with pointer temp_dir_name.
3332 Look for it only the first time. */
3335 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3336 &vol_ref_num
, &dir_id
);
3340 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3343 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3344 strcat (full_path
, "Emacs:");
3348 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3351 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3354 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3357 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3358 strcpy (temp_dir_name
, unix_dir_name
);
3361 return temp_dir_name
;
3366 /* Allocate and construct an array of pointers to strings from a list
3367 of strings stored in a 'STR#' resource. The returned pointer array
3368 is stored in the style of argv and environ: if the 'STR#' resource
3369 contains numString strings, a pointer array with numString+1
3370 elements is returned in which the last entry contains a null
3371 pointer. The pointer to the pointer array is passed by pointer in
3372 parameter t. The resource ID of the 'STR#' resource is passed in
3373 parameter StringListID.
3377 get_string_list (char ***t
, short string_list_id
)
3383 h
= GetResource ('STR#', string_list_id
);
3388 num_strings
= * (short *) p
;
3390 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3391 for (i
= 0; i
< num_strings
; i
++)
3393 short length
= *p
++;
3394 (*t
)[i
] = (char *) malloc (length
+ 1);
3395 strncpy ((*t
)[i
], p
, length
);
3396 (*t
)[i
][length
] = '\0';
3399 (*t
)[num_strings
] = 0;
3404 /* Return no string in case GetResource fails. Bug fixed by
3405 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3406 option (no sym -on implies -opt local). */
3407 *t
= (char **) malloc (sizeof (char *));
3414 get_path_to_system_folder ()
3420 static char system_folder_unix_name
[MAXPATHLEN
+1];
3423 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3424 &vol_ref_num
, &dir_id
);
3428 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3431 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3435 return system_folder_unix_name
;
3441 #define ENVIRON_STRING_LIST_ID 128
3443 /* Get environment variable definitions from STR# resource. */
3450 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3456 /* Make HOME directory the one Emacs starts up in if not specified
3458 if (getenv ("HOME") == NULL
)
3460 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3463 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3466 strcpy (environ
[i
], "HOME=");
3467 strcat (environ
[i
], my_passwd_dir
);
3474 /* Make HOME directory the one Emacs starts up in if not specified
3476 if (getenv ("MAIL") == NULL
)
3478 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3481 char * path_to_system_folder
= get_path_to_system_folder ();
3482 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3485 strcpy (environ
[i
], "MAIL=");
3486 strcat (environ
[i
], path_to_system_folder
);
3487 strcat (environ
[i
], "Eudora Folder/In");
3495 /* Return the value of the environment variable NAME. */
3498 getenv (const char *name
)
3500 int length
= strlen(name
);
3503 for (e
= environ
; *e
!= 0; e
++)
3504 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3505 return &(*e
)[length
+ 1];
3507 if (strcmp (name
, "TMPDIR") == 0)
3508 return get_temp_dir_name ();
3515 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3516 char *sys_siglist
[] =
3518 "Zero is not a signal!!!",
3520 "Interactive user interrupt", /* 2 */ "?",
3521 "Floating point exception", /* 4 */ "?", "?", "?",
3522 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3523 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3524 "?", "?", "?", "?", "?", "?", "?", "?",
3528 char *sys_siglist
[] =
3530 "Zero is not a signal!!!",
3532 "Floating point exception",
3533 "Illegal instruction",
3534 "Interactive user interrupt",
3535 "Segment violation",
3538 #else /* not __MRC__ and not __MWERKS__ */
3540 #endif /* not __MRC__ and not __MWERKS__ */
3543 #include <utsname.h>
3546 uname (struct utsname
*name
)
3549 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3552 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3553 p2cstr (name
->nodename
);
3561 /* Event class of HLE sent to subprocess. */
3562 const OSType kEmacsSubprocessSend
= 'ESND';
3564 /* Event class of HLE sent back from subprocess. */
3565 const OSType kEmacsSubprocessReply
= 'ERPY';
3569 mystrchr (char *s
, char c
)
3571 while (*s
&& *s
!= c
)
3599 mystrcpy (char *to
, char *from
)
3611 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3612 terminated). The process should run with the default directory
3613 "workdir", read input from "infn", and write output and error to
3614 "outfn" and "errfn", resp. The Process Manager call
3615 LaunchApplication is used to start the subprocess. We use high
3616 level events as the mechanism to pass arguments to the subprocess
3617 and to make Emacs wait for the subprocess to terminate and pass
3618 back a result code. The bulk of the code here packs the arguments
3619 into one message to be passed together with the high level event.
3620 Emacs also sometimes starts a subprocess using a shell to perform
3621 wildcard filename expansion. Since we don't really have a shell on
3622 the Mac, this case is detected and the starting of the shell is
3623 by-passed. We really need to add code here to do filename
3624 expansion to support such functionality.
3626 We can't use this strategy in Carbon because the High Level Event
3627 APIs are not available. */
3630 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3631 unsigned char **argv
;
3632 const char *workdir
;
3633 const char *infn
, *outfn
, *errfn
;
3635 #if TARGET_API_MAC_CARBON
3637 #else /* not TARGET_API_MAC_CARBON */
3638 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3639 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3640 int paramlen
, argc
, newargc
, j
, retries
;
3641 char **newargv
, *param
, *p
;
3644 LaunchParamBlockRec lpbr
;
3645 EventRecord send_event
, reply_event
;
3646 RgnHandle cursor_region_handle
;
3648 unsigned long ref_con
, len
;
3650 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3652 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3654 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3656 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3659 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3660 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3669 /* If a subprocess is invoked with a shell, we receive 3 arguments
3670 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3671 bins>/<command> <command args>" */
3672 j
= strlen (argv
[0]);
3673 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3674 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3676 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3678 /* The arguments for the command in argv[2] are separated by
3679 spaces. Count them and put the count in newargc. */
3680 command
= (char *) alloca (strlen (argv
[2])+2);
3681 strcpy (command
, argv
[2]);
3682 if (command
[strlen (command
) - 1] != ' ')
3683 strcat (command
, " ");
3687 t
= mystrchr (t
, ' ');
3691 t
= mystrchr (t
+1, ' ');
3694 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3697 for (j
= 0; j
< newargc
; j
++)
3699 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3700 mystrcpy (newargv
[j
], t
);
3703 paramlen
+= strlen (newargv
[j
]) + 1;
3706 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3708 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3713 { /* sometimes Emacs call "sh" without a path for the command */
3715 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3716 strcpy (t
, "~emacs/");
3717 strcat (t
, newargv
[0]);
3720 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3721 make_number (X_OK
));
3725 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3729 strcpy (macappname
, tempmacpathname
);
3733 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3736 newargv
= (char **) alloca (sizeof (char *) * argc
);
3738 for (j
= 1; j
< argc
; j
++)
3740 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3742 char *t
= strchr (argv
[j
], ' ');
3745 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3746 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3747 tempcmdname
[t
-argv
[j
]] = '\0';
3748 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3751 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3753 strcpy (newargv
[j
], tempmaccmdname
);
3754 strcat (newargv
[j
], t
);
3758 char tempmaccmdname
[MAXPATHLEN
+1];
3759 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3762 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3763 strcpy (newargv
[j
], tempmaccmdname
);
3767 newargv
[j
] = argv
[j
];
3768 paramlen
+= strlen (newargv
[j
]) + 1;
3772 /* After expanding all the arguments, we now know the length of the
3773 parameter block to be sent to the subprocess as a message
3774 attached to the HLE. */
3775 param
= (char *) malloc (paramlen
+ 1);
3781 /* first byte of message contains number of arguments for command */
3782 strcpy (p
, macworkdir
);
3783 p
+= strlen (macworkdir
);
3785 /* null terminate strings sent so it's possible to use strcpy over there */
3786 strcpy (p
, macinfn
);
3787 p
+= strlen (macinfn
);
3789 strcpy (p
, macoutfn
);
3790 p
+= strlen (macoutfn
);
3792 strcpy (p
, macerrfn
);
3793 p
+= strlen (macerrfn
);
3795 for (j
= 1; j
< newargc
; j
++)
3797 strcpy (p
, newargv
[j
]);
3798 p
+= strlen (newargv
[j
]);
3802 c2pstr (macappname
);
3804 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3812 lpbr
.launchBlockID
= extendedBlock
;
3813 lpbr
.launchEPBLength
= extendedBlockLen
;
3814 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3815 lpbr
.launchAppSpec
= &spec
;
3816 lpbr
.launchAppParameters
= NULL
;
3818 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3825 send_event
.what
= kHighLevelEvent
;
3826 send_event
.message
= kEmacsSubprocessSend
;
3827 /* Event ID stored in "where" unused */
3830 /* OS may think current subprocess has terminated if previous one
3831 terminated recently. */
3834 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3835 paramlen
+ 1, receiverIDisPSN
);
3837 while (iErr
== sessClosedErr
&& retries
-- > 0);
3845 cursor_region_handle
= NewRgn ();
3847 /* Wait for the subprocess to finish, when it will send us a ERPY
3848 high level event. */
3850 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3851 cursor_region_handle
)
3852 && reply_event
.message
== kEmacsSubprocessReply
)
3855 /* The return code is sent through the refCon */
3856 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3859 DisposeHandle ((Handle
) cursor_region_handle
);
3864 DisposeHandle ((Handle
) cursor_region_handle
);
3868 #endif /* not TARGET_API_MAC_CARBON */
3873 opendir (const char *dirname
)
3875 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3876 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3880 int len
, vol_name_len
;
3882 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3885 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3887 fully_resolved_name
[len
] = '\0';
3889 strcpy (fully_resolved_name
, true_pathname
);
3891 dirp
= (DIR *) malloc (sizeof(DIR));
3895 /* Handle special case when dirname is "/": sets up for readir to
3896 get all mount volumes. */
3897 if (strcmp (fully_resolved_name
, "/") == 0)
3899 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3900 dirp
->current_index
= 1; /* index for first volume */
3904 /* Handle typical cases: not accessing all mounted volumes. */
3905 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3908 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3909 len
= strlen (mac_pathname
);
3910 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3911 strcat (mac_pathname
, ":");
3913 /* Extract volume name */
3914 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3915 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3916 vol_name
[vol_name_len
] = '\0';
3917 strcat (vol_name
, ":");
3919 c2pstr (mac_pathname
);
3920 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3921 /* using full pathname so vRefNum and DirID ignored */
3922 cipb
.hFileInfo
.ioVRefNum
= 0;
3923 cipb
.hFileInfo
.ioDirID
= 0;
3924 cipb
.hFileInfo
.ioFDirIndex
= 0;
3925 /* set to 0 to get information about specific dir or file */
3927 errno
= PBGetCatInfo (&cipb
, false);
3934 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3935 return 0; /* not a directory */
3937 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3938 dirp
->getting_volumes
= 0;
3939 dirp
->current_index
= 1; /* index for first file/directory */
3942 vpb
.ioNamePtr
= vol_name
;
3943 /* using full pathname so vRefNum and DirID ignored */
3945 vpb
.ioVolIndex
= -1;
3946 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3953 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3970 HParamBlockRec hpblock
;
3972 static struct dirent s_dirent
;
3973 static Str255 s_name
;
3977 /* Handle the root directory containing the mounted volumes. Call
3978 PBHGetVInfo specifying an index to obtain the info for a volume.
3979 PBHGetVInfo returns an error when it receives an index beyond the
3980 last volume, at which time we should return a nil dirent struct
3982 if (dp
->getting_volumes
)
3984 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3985 hpblock
.volumeParam
.ioVRefNum
= 0;
3986 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3988 errno
= PBHGetVInfo (&hpblock
, false);
3996 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3998 dp
->current_index
++;
4000 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
4001 s_dirent
.d_name
= s_name
;
4007 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
4008 cipb
.hFileInfo
.ioNamePtr
= s_name
;
4009 /* location to receive filename returned */
4011 /* return only visible files */
4015 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
4016 /* directory ID found by opendir */
4017 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
4019 errno
= PBGetCatInfo (&cipb
, false);
4026 /* insist on a visible entry */
4027 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
4028 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
4030 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
4032 dp
->current_index
++;
4045 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
4046 /* value unimportant: non-zero for valid file */
4047 s_dirent
.d_name
= s_name
;
4057 char mac_pathname
[MAXPATHLEN
+1];
4058 Str255 directory_name
;
4062 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
4065 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
4071 #endif /* ! MAC_OSX */
4075 initialize_applescript ()
4080 /* if open fails, as_scripting_component is set to NULL. Its
4081 subsequent use in OSA calls will fail with badComponentInstance
4083 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
4084 kAppleScriptSubtype
);
4086 null_desc
.descriptorType
= typeNull
;
4087 null_desc
.dataHandle
= 0;
4088 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
4089 kOSANullScript
, &as_script_context
);
4091 as_script_context
= kOSANullScript
;
4092 /* use default context if create fails */
4097 terminate_applescript()
4099 OSADispose (as_scripting_component
, as_script_context
);
4100 CloseComponent (as_scripting_component
);
4103 /* Convert a lisp string to the 4 byte character code. */
4106 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
4115 /* check type string */
4117 if (SBYTES (arg
) != 4)
4119 error ("Wrong argument: need string of length 4 for code");
4121 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
4126 /* Convert the 4 byte character code into a 4 byte string. */
4129 mac_get_object_from_code(OSType defCode
)
4131 UInt32 code
= EndianU32_NtoB (defCode
);
4133 return make_unibyte_string ((char *)&code
, 4);
4137 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
4138 doc
: /* Get the creator code of FILENAME as a four character string. */)
4140 Lisp_Object filename
;
4148 Lisp_Object result
= Qnil
;
4149 CHECK_STRING (filename
);
4151 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4154 filename
= Fexpand_file_name (filename
, Qnil
);
4158 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4160 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4163 if (status
== noErr
)
4166 FSCatalogInfo catalogInfo
;
4168 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4169 &catalogInfo
, NULL
, NULL
, NULL
);
4173 status
= FSpGetFInfo (&fss
, &finder_info
);
4175 if (status
== noErr
)
4178 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4180 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4185 if (status
!= noErr
) {
4186 error ("Error while getting file information.");
4191 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4192 doc
: /* Get the type code of FILENAME as a four character string. */)
4194 Lisp_Object filename
;
4202 Lisp_Object result
= Qnil
;
4203 CHECK_STRING (filename
);
4205 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4208 filename
= Fexpand_file_name (filename
, Qnil
);
4212 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4214 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4217 if (status
== noErr
)
4220 FSCatalogInfo catalogInfo
;
4222 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4223 &catalogInfo
, NULL
, NULL
, NULL
);
4227 status
= FSpGetFInfo (&fss
, &finder_info
);
4229 if (status
== noErr
)
4232 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4234 result
= mac_get_object_from_code (finder_info
.fdType
);
4239 if (status
!= noErr
) {
4240 error ("Error while getting file information.");
4245 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4246 doc
: /* Set creator code of file FILENAME to CODE.
4247 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4248 assumed. Return non-nil if successful. */)
4250 Lisp_Object filename
, code
;
4259 CHECK_STRING (filename
);
4261 cCode
= mac_get_code_from_arg(code
, MAC_EMACS_CREATOR_CODE
);
4263 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4266 filename
= Fexpand_file_name (filename
, Qnil
);
4270 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4272 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4275 if (status
== noErr
)
4278 FSCatalogInfo catalogInfo
;
4280 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4281 &catalogInfo
, NULL
, NULL
, &parentDir
);
4285 status
= FSpGetFInfo (&fss
, &finder_info
);
4287 if (status
== noErr
)
4290 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4291 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4292 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4294 finder_info
.fdCreator
= cCode
;
4295 status
= FSpSetFInfo (&fss
, &finder_info
);
4300 if (status
!= noErr
) {
4301 error ("Error while setting creator information.");
4306 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4307 doc
: /* Set file code of file FILENAME to CODE.
4308 CODE must be a 4-character string. Return non-nil if successful. */)
4310 Lisp_Object filename
, code
;
4319 CHECK_STRING (filename
);
4321 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4323 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4326 filename
= Fexpand_file_name (filename
, Qnil
);
4330 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4332 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4335 if (status
== noErr
)
4338 FSCatalogInfo catalogInfo
;
4340 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4341 &catalogInfo
, NULL
, NULL
, &parentDir
);
4345 status
= FSpGetFInfo (&fss
, &finder_info
);
4347 if (status
== noErr
)
4350 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4351 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4352 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4354 finder_info
.fdType
= cCode
;
4355 status
= FSpSetFInfo (&fss
, &finder_info
);
4360 if (status
!= noErr
) {
4361 error ("Error while setting creator information.");
4367 /* Compile and execute the AppleScript SCRIPT and return the error
4368 status as function value. A zero is returned if compilation and
4369 execution is successful, in which case *RESULT is set to a Lisp
4370 string containing the resulting script value. Otherwise, the Mac
4371 error code is returned and *RESULT is set to an error Lisp string.
4372 For documentation on the MacOS scripting architecture, see Inside
4373 Macintosh - Interapplication Communications: Scripting
4377 do_applescript (script
, result
)
4378 Lisp_Object script
, *result
;
4380 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4386 if (!as_scripting_component
)
4387 initialize_applescript();
4389 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4394 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4395 typeChar
, kOSAModeNull
, &result_desc
);
4397 if (osaerror
== noErr
)
4398 /* success: retrieve resulting script value */
4399 desc
= &result_desc
;
4400 else if (osaerror
== errOSAScriptError
)
4401 /* error executing AppleScript: retrieve error message */
4402 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4408 #if TARGET_API_MAC_CARBON
4409 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4410 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4411 #else /* not TARGET_API_MAC_CARBON */
4412 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4413 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4414 #endif /* not TARGET_API_MAC_CARBON */
4415 AEDisposeDesc (desc
);
4418 AEDisposeDesc (&script_desc
);
4424 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4425 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4426 If compilation and execution are successful, the resulting script
4427 value is returned as a string. Otherwise the function aborts and
4428 displays the error message returned by the AppleScript scripting
4436 CHECK_STRING (script
);
4439 status
= do_applescript (script
, &result
);
4443 else if (!STRINGP (result
))
4444 error ("AppleScript error %d", status
);
4446 error ("%s", SDATA (result
));
4450 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4451 Smac_file_name_to_posix
, 1, 1, 0,
4452 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4454 Lisp_Object filename
;
4456 char posix_filename
[MAXPATHLEN
+1];
4458 CHECK_STRING (filename
);
4460 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4461 return build_string (posix_filename
);
4467 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4468 Sposix_file_name_to_mac
, 1, 1, 0,
4469 doc
: /* Convert Posix FILENAME to Mac form. */)
4471 Lisp_Object filename
;
4473 char mac_filename
[MAXPATHLEN
+1];
4475 CHECK_STRING (filename
);
4477 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4478 return build_string (mac_filename
);
4484 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4485 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4486 Each type should be a string of length 4 or the symbol
4487 `undecoded-file-name'. */)
4488 (src_type
, src_data
, dst_type
)
4489 Lisp_Object src_type
, src_data
, dst_type
;
4492 Lisp_Object result
= Qnil
;
4493 DescType src_desc_type
, dst_desc_type
;
4496 CHECK_STRING (src_data
);
4497 if (EQ (src_type
, Qundecoded_file_name
))
4498 src_desc_type
= TYPE_FILE_NAME
;
4500 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4502 if (EQ (dst_type
, Qundecoded_file_name
))
4503 dst_desc_type
= TYPE_FILE_NAME
;
4505 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4508 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4509 dst_desc_type
, &dst_desc
);
4512 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4513 AEDisposeDesc (&dst_desc
);
4521 #if TARGET_API_MAC_CARBON
4522 static Lisp_Object Qxml
, Qmime_charset
;
4523 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4525 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4526 doc
: /* Return the application preference value for KEY.
4527 KEY is either a string specifying a preference key, or a list of key
4528 strings. If it is a list, the (i+1)-th element is used as a key for
4529 the CFDictionary value obtained by the i-th element. Return nil if
4530 lookup is failed at some stage.
4532 Optional arg APPLICATION is an application ID string. If omitted or
4533 nil, that stands for the current application.
4535 Optional arg FORMAT specifies the data format of the return value. If
4536 omitted or nil, each Core Foundation object is converted into a
4537 corresponding Lisp object as follows:
4539 Core Foundation Lisp Tag
4540 ------------------------------------------------------------
4541 CFString Multibyte string string
4542 CFNumber Integer or float number
4543 CFBoolean Symbol (t or nil) boolean
4544 CFDate List of three integers date
4545 (cf. `current-time')
4546 CFData Unibyte string data
4547 CFArray Vector array
4548 CFDictionary Alist or hash table dictionary
4549 (depending on HASH-BOUND)
4551 If it is t, a symbol that represents the type of the original Core
4552 Foundation object is prepended. If it is `xml', the value is returned
4553 as an XML representation.
4555 Optional arg HASH-BOUND specifies which kinds of the list objects,
4556 alists or hash tables, are used as the targets of the conversion from
4557 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4558 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4559 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4561 (key
, application
, format
, hash_bound
)
4562 Lisp_Object key
, application
, format
, hash_bound
;
4564 CFStringRef app_id
, key_str
;
4565 CFPropertyListRef app_plist
= NULL
, plist
;
4566 Lisp_Object result
= Qnil
, tmp
;
4567 struct gcpro gcpro1
, gcpro2
;
4570 key
= Fcons (key
, Qnil
);
4574 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4575 CHECK_STRING_CAR (tmp
);
4576 CHECK_LIST_END (tmp
, key
);
4578 if (!NILP (application
))
4579 CHECK_STRING (application
);
4580 CHECK_SYMBOL (format
);
4581 if (!NILP (hash_bound
))
4582 CHECK_NUMBER (hash_bound
);
4584 GCPRO2 (key
, format
);
4588 app_id
= kCFPreferencesCurrentApplication
;
4589 if (!NILP (application
))
4591 app_id
= cfstring_create_with_string (application
);
4595 if (!CFPreferencesAppSynchronize (app_id
))
4598 key_str
= cfstring_create_with_string (XCAR (key
));
4599 if (key_str
== NULL
)
4601 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4602 CFRelease (key_str
);
4603 if (app_plist
== NULL
)
4607 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4609 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4611 key_str
= cfstring_create_with_string (XCAR (key
));
4612 if (key_str
== NULL
)
4614 plist
= CFDictionaryGetValue (plist
, key_str
);
4615 CFRelease (key_str
);
4622 if (EQ (format
, Qxml
))
4624 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4627 result
= cfdata_to_lisp (data
);
4632 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4633 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4638 CFRelease (app_plist
);
4649 static CFStringEncoding
4650 get_cfstring_encoding_from_lisp (obj
)
4653 CFStringRef iana_name
;
4654 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4657 return kCFStringEncodingUnicode
;
4662 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4664 Lisp_Object coding_spec
, plist
;
4666 coding_spec
= Fget (obj
, Qcoding_system
);
4667 plist
= XVECTOR (coding_spec
)->contents
[3];
4668 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4672 obj
= SYMBOL_NAME (obj
);
4676 iana_name
= cfstring_create_with_string (obj
);
4679 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4680 CFRelease (iana_name
);
4687 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4689 cfstring_create_normalized (str
, symbol
)
4694 TextEncodingVariant variant
;
4695 float initial_mag
= 0.0;
4696 CFStringRef result
= NULL
;
4698 if (EQ (symbol
, QNFD
))
4699 form
= kCFStringNormalizationFormD
;
4700 else if (EQ (symbol
, QNFKD
))
4701 form
= kCFStringNormalizationFormKD
;
4702 else if (EQ (symbol
, QNFC
))
4703 form
= kCFStringNormalizationFormC
;
4704 else if (EQ (symbol
, QNFKC
))
4705 form
= kCFStringNormalizationFormKC
;
4706 else if (EQ (symbol
, QHFS_plus_D
))
4708 variant
= kUnicodeHFSPlusDecompVariant
;
4711 else if (EQ (symbol
, QHFS_plus_C
))
4713 variant
= kUnicodeHFSPlusCompVariant
;
4719 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4723 CFStringNormalize (mut_str
, form
);
4727 else if (initial_mag
> 0.0)
4729 UnicodeToTextInfo uni
= NULL
;
4732 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4733 OSStatus err
= noErr
;
4734 ByteCount out_read
, out_size
, out_len
;
4736 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4738 kTextEncodingDefaultFormat
);
4739 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4741 kTextEncodingDefaultFormat
);
4742 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4744 length
= CFStringGetLength (str
);
4745 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4749 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4750 if (in_text
== NULL
)
4752 buffer
= xmalloc (sizeof (UniChar
) * length
);
4753 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4758 err
= CreateUnicodeToTextInfo (&map
, &uni
);
4759 while (err
== noErr
)
4761 out_buf
= xmalloc (out_size
);
4762 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4764 kUnicodeDefaultDirectionMask
,
4765 0, NULL
, NULL
, NULL
,
4766 out_size
, &out_read
, &out_len
,
4768 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4777 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4778 out_len
/ sizeof (UniChar
));
4780 DisposeUnicodeToTextInfo (&uni
);
4796 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4797 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4798 The conversion is performed using the converter provided by the system.
4799 Each encoding is specified by either a coding system symbol, a mime
4800 charset string, or an integer as a CFStringEncoding value. An encoding
4801 of nil means UTF-16 in native byte order, no byte order mark.
4802 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4803 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4804 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4805 On successful conversion, return the result string, else return nil. */)
4806 (string
, source
, target
, normalization_form
)
4807 Lisp_Object string
, source
, target
, normalization_form
;
4809 Lisp_Object result
= Qnil
;
4810 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4811 CFStringEncoding src_encoding
, tgt_encoding
;
4812 CFStringRef str
= NULL
;
4814 CHECK_STRING (string
);
4815 if (!INTEGERP (source
) && !STRINGP (source
))
4816 CHECK_SYMBOL (source
);
4817 if (!INTEGERP (target
) && !STRINGP (target
))
4818 CHECK_SYMBOL (target
);
4819 CHECK_SYMBOL (normalization_form
);
4821 GCPRO4 (string
, source
, target
, normalization_form
);
4825 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4826 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4828 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4829 use string_as_unibyte which works as well, except for the fact that
4830 it's too permissive (it doesn't check that the multibyte string only
4831 contain single-byte chars). */
4832 string
= Fstring_as_unibyte (string
);
4833 if (src_encoding
!= kCFStringEncodingInvalidId
4834 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4835 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4836 src_encoding
, !NILP (source
));
4837 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4840 CFStringRef saved_str
= str
;
4842 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4843 CFRelease (saved_str
);
4848 CFIndex str_len
, buf_len
;
4850 str_len
= CFStringGetLength (str
);
4851 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4852 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4854 result
= make_uninit_string (buf_len
);
4855 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4856 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4868 DEFUN ("mac-process-hi-command", Fmac_process_hi_command
, Smac_process_hi_command
, 1, 1, 0,
4869 doc
: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4870 COMMAND-ID must be a 4-character string. Some common command IDs are
4871 defined in the Carbon Event Manager. */)
4873 Lisp_Object command_id
;
4878 bzero (&command
, sizeof (HICommand
));
4879 command
.commandID
= mac_get_code_from_arg (command_id
, 0);
4882 err
= ProcessHICommand (&command
);
4886 error ("HI command (command ID: '%s') not handled.", SDATA (command_id
));
4891 #endif /* TARGET_API_MAC_CARBON */
4895 mac_get_system_locale ()
4903 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4904 region
= GetScriptManagerVariable (smRegionCode
);
4905 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4907 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4910 return build_string (str
);
4918 extern int inhibit_window_system
;
4919 extern int noninteractive
;
4921 /* Unlike in X11, window events in Carbon do not come from sockets.
4922 So we cannot simply use `select' to monitor two kinds of inputs:
4923 window events and process outputs. We emulate such functionality
4924 by regarding fd 0 as the window event channel and simultaneously
4925 monitoring both kinds of input channels. It is implemented by
4926 dividing into some cases:
4927 1. The window event channel is not involved.
4929 2. Sockets are not involved.
4930 -> Use ReceiveNextEvent.
4931 3. [If SELECT_USE_CFSOCKET is set]
4932 Only the window event channel and socket read/write channels are
4933 involved, and timeout is not too short (greater than
4934 SELECT_TIMEOUT_THRESHOLD_RUNLOOP seconds).
4935 -> Create CFSocket for each socket and add it into the current
4936 event RunLoop so that the current event loop gets quit when
4937 the socket becomes ready. Then mac_run_loop_run_once can
4938 wait for both kinds of inputs.
4940 -> Periodically poll the window input channel while repeatedly
4941 executing `select' with a short timeout
4942 (SELECT_POLLING_PERIOD_USEC microseconds). */
4944 #ifndef SELECT_USE_CFSOCKET
4945 #define SELECT_USE_CFSOCKET 1
4948 #define SELECT_POLLING_PERIOD_USEC 100000
4949 #if SELECT_USE_CFSOCKET
4950 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4952 /* Dictionary of file descriptors vs CFSocketRef's allocated in
4954 static CFMutableDictionaryRef cfsockets_for_select
;
4956 /* Process ID of Emacs. */
4957 static pid_t mac_emacs_pid
;
4960 socket_callback (s
, type
, address
, data
, info
)
4962 CFSocketCallBackType type
;
4968 #endif /* SELECT_USE_CFSOCKET */
4971 select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
)
4973 SELECT_TYPE
*rfds
, *wfds
, *efds
;
4974 EMACS_TIME
*timeout
;
4978 EMACS_TIME select_timeout
;
4979 EventTimeout timeoutval
=
4981 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4982 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4983 : kEventDurationForever
);
4984 SELECT_TYPE orfds
, owfds
, oefds
;
4986 if (timeout
== NULL
)
4988 if (rfds
) orfds
= *rfds
;
4989 if (wfds
) owfds
= *wfds
;
4990 if (efds
) oefds
= *efds
;
4993 /* Try detect_input_pending before mac_run_loop_run_once in the same
4994 BLOCK_INPUT block, in case that some input has already been read
4999 if (detect_input_pending ())
5002 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5003 r
= select (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5007 if (timeoutval
== 0.0)
5010 timedout_p
= mac_run_loop_run_once (timeoutval
);
5012 if (timeout
== NULL
&& timedout_p
)
5014 if (rfds
) *rfds
= orfds
;
5015 if (wfds
) *wfds
= owfds
;
5016 if (efds
) *efds
= oefds
;
5025 else if (!timedout_p
)
5027 /* Pretend that `select' is interrupted by a signal. */
5028 detect_input_pending ();
5036 /* Clean up the CFSocket associated with the file descriptor FD in
5037 case the same descriptor is used in other threads later. If no
5038 CFSocket is associated with FD, then return 0 without closing FD.
5039 Otherwise, return 1 with closing FD. */
5042 mac_try_close_socket (fd
)
5045 #if SELECT_USE_CFSOCKET
5046 if (getpid () == mac_emacs_pid
&& cfsockets_for_select
)
5048 void *key
= (void *) fd
;
5049 CFSocketRef socket
=
5050 (CFSocketRef
) CFDictionaryGetValue (cfsockets_for_select
, key
);
5054 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
5055 CFOptionFlags flags
= CFSocketGetSocketFlags (socket
);
5057 if (!(flags
& kCFSocketCloseOnInvalidate
))
5058 CFSocketSetSocketFlags (socket
, flags
| kCFSocketCloseOnInvalidate
);
5061 CFSocketInvalidate (socket
);
5062 CFDictionaryRemoveValue (cfsockets_for_select
, key
);
5074 sys_select (nfds
, rfds
, wfds
, efds
, timeout
)
5076 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5077 EMACS_TIME
*timeout
;
5081 EMACS_TIME select_timeout
;
5082 SELECT_TYPE orfds
, owfds
, oefds
;
5084 if (inhibit_window_system
|| noninteractive
5085 || nfds
< 1 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
5086 return select (nfds
, rfds
, wfds
, efds
, timeout
);
5100 EventTimeout timeoutval
=
5102 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5103 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5104 : kEventDurationForever
);
5106 FD_SET (0, rfds
); /* sentinel */
5111 while (!(FD_ISSET (nfds
, rfds
) || (wfds
&& FD_ISSET (nfds
, wfds
))));
5116 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
);
5118 /* Avoid initial overhead of RunLoop setup for the case that
5119 some input is already available. */
5120 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5121 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5122 if (r
!= 0 || timeoutval
== 0.0)
5129 #if SELECT_USE_CFSOCKET
5130 if (timeoutval
> 0 && timeoutval
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
5131 goto poll_periodically
;
5133 /* Try detect_input_pending before mac_run_loop_run_once in the
5134 same BLOCK_INPUT block, in case that some input has already
5135 been read asynchronously. */
5137 if (!detect_input_pending ())
5140 CFRunLoopRef runloop
=
5141 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5142 static CFMutableDictionaryRef sources
;
5144 if (sources
== NULL
)
5146 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5147 &kCFTypeDictionaryValueCallBacks
);
5149 if (cfsockets_for_select
== NULL
)
5150 cfsockets_for_select
=
5151 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5152 &kCFTypeDictionaryValueCallBacks
);
5154 for (minfd
= 1; ; minfd
++) /* nfds-1 works as a sentinel. */
5155 if (FD_ISSET (minfd
, rfds
) || (wfds
&& FD_ISSET (minfd
, wfds
)))
5158 for (fd
= minfd
; fd
< nfds
; fd
++)
5159 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5161 void *key
= (void *) fd
;
5162 CFRunLoopSourceRef source
=
5163 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5165 if (source
== NULL
|| !CFRunLoopSourceIsValid (source
))
5167 CFSocketRef socket
=
5168 CFSocketCreateWithNative (NULL
, fd
,
5169 (kCFSocketReadCallBack
5170 | kCFSocketConnectCallBack
),
5171 socket_callback
, NULL
);
5175 CFDictionarySetValue (cfsockets_for_select
, key
, socket
);
5176 source
= CFSocketCreateRunLoopSource (NULL
, socket
, 0);
5180 CFDictionarySetValue (sources
, key
, source
);
5183 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
5186 timedout_p
= mac_run_loop_run_once (timeoutval
);
5188 for (fd
= minfd
; fd
< nfds
; fd
++)
5189 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5191 void *key
= (void *) fd
;
5192 CFRunLoopSourceRef source
=
5193 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5195 CFRunLoopRemoveSource (runloop
, source
, kCFRunLoopDefaultMode
);
5202 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5203 return select_and_poll_event (nfds
, rfds
, wfds
, efds
,
5213 #endif /* SELECT_USE_CFSOCKET */
5218 EMACS_TIME end_time
, now
, remaining_time
;
5222 remaining_time
= *timeout
;
5223 EMACS_GET_TIME (now
);
5224 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5229 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5230 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5231 select_timeout
= remaining_time
;
5232 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5244 EMACS_GET_TIME (now
);
5245 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5248 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5250 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5251 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5255 /* Set up environment variables so that Emacs can correctly find its
5256 support files when packaged as an application bundle. Directories
5257 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5258 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5259 by `make install' by default can instead be placed in
5260 .../Emacs.app/Contents/Resources/ and
5261 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5262 is changed only if it is not already set. Presumably if the user
5263 sets an environment variable, he will want to use files in his path
5264 instead of ones in the application bundle. */
5266 init_mac_osx_environment ()
5270 CFStringRef cf_app_bundle_pathname
;
5271 int app_bundle_pathname_len
;
5272 char *app_bundle_pathname
;
5276 mac_emacs_pid
= getpid ();
5278 /* Initialize locale related variables. */
5279 mac_system_script_code
=
5280 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5281 Vmac_system_locale
= mac_get_system_locale ();
5283 /* Fetch the pathname of the application bundle as a C string into
5284 app_bundle_pathname. */
5286 bundle
= CFBundleGetMainBundle ();
5287 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5289 /* We could not find the bundle identifier. For now, prevent
5290 the fatal error by bringing it up in the terminal. */
5291 inhibit_window_system
= 1;
5295 bundleURL
= CFBundleCopyBundleURL (bundle
);
5299 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5300 kCFURLPOSIXPathStyle
);
5301 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5302 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5304 if (!CFStringGetCString (cf_app_bundle_pathname
,
5305 app_bundle_pathname
,
5306 app_bundle_pathname_len
+ 1,
5307 kCFStringEncodingISOLatin1
))
5309 CFRelease (cf_app_bundle_pathname
);
5313 CFRelease (cf_app_bundle_pathname
);
5315 /* P should have sufficient room for the pathname of the bundle plus
5316 the subpath in it leading to the respective directories. Q
5317 should have three times that much room because EMACSLOADPATH can
5318 have the value "<path to site-lisp dir>:<path to lisp dir>:<path
5320 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5321 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5322 if (!getenv ("EMACSLOADPATH"))
5326 strcpy (p
, app_bundle_pathname
);
5327 strcat (p
, "/Contents/Resources/site-lisp");
5328 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5331 strcpy (p
, app_bundle_pathname
);
5332 strcat (p
, "/Contents/Resources/lisp");
5333 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5340 strcpy (p
, app_bundle_pathname
);
5341 strcat (p
, "/Contents/Resources/leim");
5342 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5350 setenv ("EMACSLOADPATH", q
, 1);
5353 if (!getenv ("EMACSPATH"))
5357 strcpy (p
, app_bundle_pathname
);
5358 strcat (p
, "/Contents/MacOS/libexec");
5359 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5362 strcpy (p
, app_bundle_pathname
);
5363 strcat (p
, "/Contents/MacOS/bin");
5364 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5372 setenv ("EMACSPATH", q
, 1);
5375 if (!getenv ("EMACSDATA"))
5377 strcpy (p
, app_bundle_pathname
);
5378 strcat (p
, "/Contents/Resources/etc");
5379 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5380 setenv ("EMACSDATA", p
, 1);
5383 if (!getenv ("EMACSDOC"))
5385 strcpy (p
, app_bundle_pathname
);
5386 strcat (p
, "/Contents/Resources/etc");
5387 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5388 setenv ("EMACSDOC", p
, 1);
5391 if (!getenv ("INFOPATH"))
5393 strcpy (p
, app_bundle_pathname
);
5394 strcat (p
, "/Contents/Resources/info");
5395 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5396 setenv ("INFOPATH", p
, 1);
5399 #endif /* MAC_OSX */
5401 #if TARGET_API_MAC_CARBON
5403 mac_wakeup_from_rne ()
5406 if (wakeup_from_rne_enabled_p
)
5407 /* Post a harmless event so as to wake up from
5408 ReceiveNextEvent. */
5409 mac_post_mouse_moved_event ();
5417 Qundecoded_file_name
= intern ("undecoded-file-name");
5418 staticpro (&Qundecoded_file_name
);
5420 #if TARGET_API_MAC_CARBON
5421 Qstring
= intern ("string"); staticpro (&Qstring
);
5422 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5423 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5424 Qdate
= intern ("date"); staticpro (&Qdate
);
5425 Qdata
= intern ("data"); staticpro (&Qdata
);
5426 Qarray
= intern ("array"); staticpro (&Qarray
);
5427 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5429 Qxml
= intern ("xml");
5432 Qmime_charset
= intern ("mime-charset");
5433 staticpro (&Qmime_charset
);
5435 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5436 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5437 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5438 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5439 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5440 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5446 for (i
= 0; i
< sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]); i
++)
5448 ae_attr_table
[i
].symbol
= intern (ae_attr_table
[i
].name
);
5449 staticpro (&ae_attr_table
[i
].symbol
);
5453 defsubr (&Smac_coerce_ae_data
);
5454 #if TARGET_API_MAC_CARBON
5455 defsubr (&Smac_get_preference
);
5456 defsubr (&Smac_code_convert_string
);
5457 defsubr (&Smac_process_hi_command
);
5460 defsubr (&Smac_set_file_creator
);
5461 defsubr (&Smac_set_file_type
);
5462 defsubr (&Smac_get_file_creator
);
5463 defsubr (&Smac_get_file_type
);
5464 defsubr (&Sdo_applescript
);
5465 defsubr (&Smac_file_name_to_posix
);
5466 defsubr (&Sposix_file_name_to_mac
);
5468 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5469 doc
: /* The system script code. */);
5470 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5472 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5473 doc
: /* The system locale identifier string.
5474 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5475 information is not included. */);
5476 Vmac_system_locale
= mac_get_system_locale ();
5479 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5480 (do not change this comment) */