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
))),
913 #endif /* TARGET_API_MAC_CARBON */
915 /***********************************************************************
916 Conversion between Lisp and Core Foundation objects
917 ***********************************************************************/
919 #if TARGET_API_MAC_CARBON
920 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
921 static Lisp_Object Qarray
, Qdictionary
;
923 struct cfdict_context
926 int with_tag
, hash_bound
;
929 /* C string to CFString. */
932 cfstring_create_with_utf8_cstring (c_str
)
937 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
939 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
940 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
946 /* Lisp string to CFString. */
949 cfstring_create_with_string (s
)
952 CFStringRef string
= NULL
;
954 if (STRING_MULTIBYTE (s
))
956 char *p
, *end
= SDATA (s
) + SBYTES (s
);
958 for (p
= SDATA (s
); p
< end
; p
++)
961 s
= ENCODE_UTF_8 (s
);
964 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
965 kCFStringEncodingUTF8
, false);
969 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
970 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
971 kCFStringEncodingMacRoman
, false);
977 /* From CFData to a lisp string. Always returns a unibyte string. */
980 cfdata_to_lisp (data
)
983 CFIndex len
= CFDataGetLength (data
);
984 Lisp_Object result
= make_uninit_string (len
);
986 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
992 /* From CFString to a lisp string. Returns a unibyte string
993 containing a UTF-8 byte sequence. */
996 cfstring_to_lisp_nodecode (string
)
999 Lisp_Object result
= Qnil
;
1000 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
1003 result
= make_unibyte_string (s
, strlen (s
));
1007 CFStringCreateExternalRepresentation (NULL
, string
,
1008 kCFStringEncodingUTF8
, '?');
1012 result
= cfdata_to_lisp (data
);
1021 /* From CFString to a lisp string. Never returns a unibyte string
1022 (even if it only contains ASCII characters).
1023 This may cause GC during code conversion. */
1026 cfstring_to_lisp (string
)
1029 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
1033 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
1034 /* This may be superfluous. Just to make sure that the result
1035 is a multibyte string. */
1036 result
= string_to_multibyte (result
);
1043 /* CFNumber to a lisp integer or a lisp float. */
1046 cfnumber_to_lisp (number
)
1049 Lisp_Object result
= Qnil
;
1050 #if BITS_PER_EMACS_INT > 32
1052 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
1055 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
1059 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
1060 && !FIXNUM_OVERFLOW_P (int_val
))
1061 result
= make_number (int_val
);
1063 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
1064 result
= make_float (float_val
);
1069 /* CFDate to a list of three integers as in a return value of
1073 cfdate_to_lisp (date
)
1077 int high
, low
, microsec
;
1079 sec
= CFDateGetAbsoluteTime (date
) + kCFAbsoluteTimeIntervalSince1970
;
1080 high
= sec
/ 65536.0;
1081 low
= sec
- high
* 65536.0;
1082 microsec
= (sec
- floor (sec
)) * 1000000.0;
1084 return list3 (make_number (high
), make_number (low
), make_number (microsec
));
1088 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1091 cfboolean_to_lisp (boolean
)
1092 CFBooleanRef boolean
;
1094 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
1098 /* Any Core Foundation object to a (lengthy) lisp string. */
1101 cfobject_desc_to_lisp (object
)
1104 Lisp_Object result
= Qnil
;
1105 CFStringRef desc
= CFCopyDescription (object
);
1109 result
= cfstring_to_lisp (desc
);
1117 /* Callback functions for cfproperty_list_to_lisp. */
1120 cfdictionary_add_to_list (key
, value
, context
)
1125 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1128 Fcons (Fcons (cfstring_to_lisp (key
),
1129 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
1135 cfdictionary_puthash (key
, value
, context
)
1140 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
1141 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1142 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
1145 hash_lookup (h
, lisp_key
, &hash_code
);
1146 hash_put (h
, lisp_key
,
1147 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
1152 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1153 non-zero, a symbol that represents the type of the original Core
1154 Foundation object is prepended. HASH_BOUND specifies which kinds
1155 of the lisp objects, alists or hash tables, are used as the targets
1156 of the conversion from CFDictionary. If HASH_BOUND is negative,
1157 always generate alists. If HASH_BOUND >= 0, generate an alist if
1158 the number of keys in the dictionary is smaller than HASH_BOUND,
1159 and a hash table otherwise. */
1162 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
1163 CFPropertyListRef plist
;
1164 int with_tag
, hash_bound
;
1166 CFTypeID type_id
= CFGetTypeID (plist
);
1167 Lisp_Object tag
= Qnil
, result
= Qnil
;
1168 struct gcpro gcpro1
, gcpro2
;
1170 GCPRO2 (tag
, result
);
1172 if (type_id
== CFStringGetTypeID ())
1175 result
= cfstring_to_lisp (plist
);
1177 else if (type_id
== CFNumberGetTypeID ())
1180 result
= cfnumber_to_lisp (plist
);
1182 else if (type_id
== CFBooleanGetTypeID ())
1185 result
= cfboolean_to_lisp (plist
);
1187 else if (type_id
== CFDateGetTypeID ())
1190 result
= cfdate_to_lisp (plist
);
1192 else if (type_id
== CFDataGetTypeID ())
1195 result
= cfdata_to_lisp (plist
);
1197 else if (type_id
== CFArrayGetTypeID ())
1199 CFIndex index
, count
= CFArrayGetCount (plist
);
1202 result
= Fmake_vector (make_number (count
), Qnil
);
1203 for (index
= 0; index
< count
; index
++)
1204 XVECTOR (result
)->contents
[index
] =
1205 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1206 with_tag
, hash_bound
);
1208 else if (type_id
== CFDictionaryGetTypeID ())
1210 struct cfdict_context context
;
1211 CFIndex count
= CFDictionaryGetCount (plist
);
1214 context
.result
= &result
;
1215 context
.with_tag
= with_tag
;
1216 context
.hash_bound
= hash_bound
;
1217 if (hash_bound
< 0 || count
< hash_bound
)
1220 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1225 result
= make_hash_table (Qequal
,
1226 make_number (count
),
1227 make_float (DEFAULT_REHASH_SIZE
),
1228 make_float (DEFAULT_REHASH_THRESHOLD
),
1230 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1240 result
= Fcons (tag
, result
);
1247 /***********************************************************************
1248 Emulation of the X Resource Manager
1249 ***********************************************************************/
1251 /* Parser functions for resource lines. Each function takes an
1252 address of a variable whose value points to the head of a string.
1253 The value will be advanced so that it points to the next character
1254 of the parsed part when the function returns.
1256 A resource name such as "Emacs*font" is parsed into a non-empty
1257 list called `quarks'. Each element is either a Lisp string that
1258 represents a concrete component, a Lisp symbol LOOSE_BINDING
1259 (actually Qlambda) that represents any number (>=0) of intervening
1260 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1261 that represents as any single component. */
1265 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1266 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1269 skip_white_space (p
)
1272 /* WhiteSpace = {<space> | <horizontal tab>} */
1273 while (*P
== ' ' || *P
== '\t')
1281 /* Comment = "!" {<any character except null or newline>} */
1294 /* Don't interpret filename. Just skip until the newline. */
1296 parse_include_file (p
)
1299 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1316 /* Binding = "." | "*" */
1317 if (*P
== '.' || *P
== '*')
1319 char binding
= *P
++;
1321 while (*P
== '.' || *P
== '*')
1334 /* Component = "?" | ComponentName
1335 ComponentName = NameChar {NameChar}
1336 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1340 return SINGLE_COMPONENT
;
1342 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1344 const char *start
= P
++;
1346 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1349 return make_unibyte_string (start
, P
- start
);
1356 parse_resource_name (p
)
1359 Lisp_Object result
= Qnil
, component
;
1362 /* ResourceName = [Binding] {Component Binding} ComponentName */
1363 if (parse_binding (p
) == '*')
1364 result
= Fcons (LOOSE_BINDING
, result
);
1366 component
= parse_component (p
);
1367 if (NILP (component
))
1370 result
= Fcons (component
, result
);
1371 while ((binding
= parse_binding (p
)) != '\0')
1374 result
= Fcons (LOOSE_BINDING
, result
);
1375 component
= parse_component (p
);
1376 if (NILP (component
))
1379 result
= Fcons (component
, result
);
1382 /* The final component should not be '?'. */
1383 if (EQ (component
, SINGLE_COMPONENT
))
1386 return Fnreverse (result
);
1394 Lisp_Object seq
= Qnil
, result
;
1395 int buf_len
, total_len
= 0, len
, continue_p
;
1397 q
= strchr (P
, '\n');
1398 buf_len
= q
? q
- P
: strlen (P
);
1399 buf
= xmalloc (buf_len
);
1412 else if (*P
== '\\')
1417 else if (*P
== '\n')
1428 else if ('0' <= P
[0] && P
[0] <= '7'
1429 && '0' <= P
[1] && P
[1] <= '7'
1430 && '0' <= P
[2] && P
[2] <= '7')
1432 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1442 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1447 q
= strchr (P
, '\n');
1448 len
= q
? q
- P
: strlen (P
);
1453 buf
= xmalloc (buf_len
);
1461 if (SBYTES (XCAR (seq
)) == total_len
)
1462 return make_string (SDATA (XCAR (seq
)), total_len
);
1465 buf
= xmalloc (total_len
);
1466 q
= buf
+ total_len
;
1467 for (; CONSP (seq
); seq
= XCDR (seq
))
1469 len
= SBYTES (XCAR (seq
));
1471 memcpy (q
, SDATA (XCAR (seq
)), len
);
1473 result
= make_string (buf
, total_len
);
1480 parse_resource_line (p
)
1483 Lisp_Object quarks
, value
;
1485 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1486 if (parse_comment (p
) || parse_include_file (p
))
1489 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1490 skip_white_space (p
);
1491 quarks
= parse_resource_name (p
);
1494 skip_white_space (p
);
1498 skip_white_space (p
);
1499 value
= parse_value (p
);
1500 return Fcons (quarks
, value
);
1503 /* Skip the remaining data as a dummy value. */
1510 /* Equivalents of X Resource Manager functions.
1512 An X Resource Database acts as a collection of resource names and
1513 associated values. It is implemented as a trie on quarks. Namely,
1514 each edge is labeled by either a string, LOOSE_BINDING, or
1515 SINGLE_COMPONENT. Each node has a node id, which is a unique
1516 nonnegative integer, and the root node id is 0. A database is
1517 implemented as a hash table that maps a pair (SRC-NODE-ID .
1518 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1519 in the table as a value for HASHKEY_MAX_NID. A value associated to
1520 a node is recorded as a value for the node id.
1522 A database also has a cache for past queries as a value for
1523 HASHKEY_QUERY_CACHE. It is another hash table that maps
1524 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1526 #define HASHKEY_MAX_NID (make_number (0))
1527 #define HASHKEY_QUERY_CACHE (make_number (-1))
1530 xrm_create_database ()
1532 XrmDatabase database
;
1534 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1535 make_float (DEFAULT_REHASH_SIZE
),
1536 make_float (DEFAULT_REHASH_THRESHOLD
),
1538 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1539 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1545 xrm_q_put_resource (database
, quarks
, value
)
1546 XrmDatabase database
;
1547 Lisp_Object quarks
, value
;
1549 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1552 Lisp_Object node_id
, key
;
1554 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1556 XSETINT (node_id
, 0);
1557 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1559 key
= Fcons (node_id
, XCAR (quarks
));
1560 i
= hash_lookup (h
, key
, &hash_code
);
1564 XSETINT (node_id
, max_nid
);
1565 hash_put (h
, key
, node_id
, hash_code
);
1568 node_id
= HASH_VALUE (h
, i
);
1570 Fputhash (node_id
, value
, database
);
1572 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1573 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1576 /* Merge multiple resource entries specified by DATA into a resource
1577 database DATABASE. DATA points to the head of a null-terminated
1578 string consisting of multiple resource lines. It's like a
1579 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1582 xrm_merge_string_database (database
, data
)
1583 XrmDatabase database
;
1586 Lisp_Object quarks_value
;
1590 quarks_value
= parse_resource_line (&data
);
1591 if (!NILP (quarks_value
))
1592 xrm_q_put_resource (database
,
1593 XCAR (quarks_value
), XCDR (quarks_value
));
1598 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1599 XrmDatabase database
;
1600 Lisp_Object node_id
, quark_name
, quark_class
;
1602 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1603 Lisp_Object key
, labels
[3], value
;
1606 if (!CONSP (quark_name
))
1607 return Fgethash (node_id
, database
, Qnil
);
1609 /* First, try tight bindings */
1610 labels
[0] = XCAR (quark_name
);
1611 labels
[1] = XCAR (quark_class
);
1612 labels
[2] = SINGLE_COMPONENT
;
1614 key
= Fcons (node_id
, Qnil
);
1615 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1617 XSETCDR (key
, labels
[k
]);
1618 i
= hash_lookup (h
, key
, NULL
);
1621 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1622 XCDR (quark_name
), XCDR (quark_class
));
1628 /* Then, try loose bindings */
1629 XSETCDR (key
, LOOSE_BINDING
);
1630 i
= hash_lookup (h
, key
, NULL
);
1633 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1634 quark_name
, quark_class
);
1638 return xrm_q_get_resource_1 (database
, node_id
,
1639 XCDR (quark_name
), XCDR (quark_class
));
1646 xrm_q_get_resource (database
, quark_name
, quark_class
)
1647 XrmDatabase database
;
1648 Lisp_Object quark_name
, quark_class
;
1650 return xrm_q_get_resource_1 (database
, make_number (0),
1651 quark_name
, quark_class
);
1654 /* Retrieve a resource value for the specified NAME and CLASS from the
1655 resource database DATABASE. It corresponds to XrmGetResource. */
1658 xrm_get_resource (database
, name
, class)
1659 XrmDatabase database
;
1660 const char *name
, *class;
1662 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1664 struct Lisp_Hash_Table
*h
;
1668 nc
= strlen (class);
1669 key
= make_uninit_string (nn
+ nc
+ 1);
1670 strcpy (SDATA (key
), name
);
1671 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1673 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1674 if (NILP (query_cache
))
1676 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1677 make_float (DEFAULT_REHASH_SIZE
),
1678 make_float (DEFAULT_REHASH_THRESHOLD
),
1680 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1682 h
= XHASH_TABLE (query_cache
);
1683 i
= hash_lookup (h
, key
, &hash_code
);
1685 return HASH_VALUE (h
, i
);
1687 quark_name
= parse_resource_name (&name
);
1690 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1691 if (!STRINGP (XCAR (tmp
)))
1694 quark_class
= parse_resource_name (&class);
1697 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1698 if (!STRINGP (XCAR (tmp
)))
1705 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1706 hash_put (h
, key
, tmp
, hash_code
);
1711 #if TARGET_API_MAC_CARBON
1713 xrm_cfproperty_list_to_value (plist
)
1714 CFPropertyListRef plist
;
1716 CFTypeID type_id
= CFGetTypeID (plist
);
1718 if (type_id
== CFStringGetTypeID ())
1719 return cfstring_to_lisp (plist
);
1720 else if (type_id
== CFNumberGetTypeID ())
1723 Lisp_Object result
= Qnil
;
1725 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1728 result
= cfstring_to_lisp (string
);
1733 else if (type_id
== CFBooleanGetTypeID ())
1734 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1735 else if (type_id
== CFDataGetTypeID ())
1736 return cfdata_to_lisp (plist
);
1742 /* Create a new resource database from the preferences for the
1743 application APPLICATION. APPLICATION is either a string that
1744 specifies an application ID, or NULL that represents the current
1748 xrm_get_preference_database (application
)
1749 const char *application
;
1751 #if TARGET_API_MAC_CARBON
1752 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1753 CFMutableSetRef key_set
= NULL
;
1754 CFArrayRef key_array
;
1755 CFIndex index
, count
;
1757 XrmDatabase database
;
1758 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1759 CFPropertyListRef plist
;
1761 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1763 user_doms
[0] = kCFPreferencesCurrentUser
;
1764 user_doms
[1] = kCFPreferencesAnyUser
;
1765 host_doms
[0] = kCFPreferencesCurrentHost
;
1766 host_doms
[1] = kCFPreferencesAnyHost
;
1768 database
= xrm_create_database ();
1770 GCPRO3 (database
, quarks
, value
);
1772 app_id
= kCFPreferencesCurrentApplication
;
1775 app_id
= cfstring_create_with_utf8_cstring (application
);
1779 if (!CFPreferencesAppSynchronize (app_id
))
1782 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1783 if (key_set
== NULL
)
1785 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1786 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1788 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1792 count
= CFArrayGetCount (key_array
);
1793 for (index
= 0; index
< count
; index
++)
1794 CFSetAddValue (key_set
,
1795 CFArrayGetValueAtIndex (key_array
, index
));
1796 CFRelease (key_array
);
1800 count
= CFSetGetCount (key_set
);
1801 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1802 CFSetGetValues (key_set
, (const void **)keys
);
1803 for (index
= 0; index
< count
; index
++)
1805 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1806 quarks
= parse_resource_name (&res_name
);
1807 if (!(NILP (quarks
) || *res_name
))
1809 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1810 value
= xrm_cfproperty_list_to_value (plist
);
1813 xrm_q_put_resource (database
, quarks
, value
);
1820 CFRelease (key_set
);
1827 return xrm_create_database ();
1834 /* The following functions with "sys_" prefix are stubs to Unix
1835 functions that have already been implemented by CW or MPW. The
1836 calls to them in Emacs source course are #define'd to call the sys_
1837 versions by the header files s-mac.h. In these stubs pathnames are
1838 converted between their Unix and Mac forms. */
1841 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1842 + 17 leap days. These are for adjusting time values returned by
1843 MacOS Toolbox functions. */
1845 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1848 #if __MSL__ < 0x6000
1849 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1850 a leap year! This is for adjusting time_t values returned by MSL
1852 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1853 #else /* __MSL__ >= 0x6000 */
1854 /* CW changes Pro 6 to follow Unix! */
1855 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1856 #endif /* __MSL__ >= 0x6000 */
1858 /* MPW library functions follow Unix (confused?). */
1859 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1860 #else /* not __MRC__ */
1862 #endif /* not __MRC__ */
1865 /* Define our own stat function for both MrC and CW. The reason for
1866 doing this: "stat" is both the name of a struct and function name:
1867 can't use the same trick like that for sys_open, sys_close, etc. to
1868 redirect Emacs's calls to our own version that converts Unix style
1869 filenames to Mac style filename because all sorts of compilation
1870 errors will be generated if stat is #define'd to be sys_stat. */
1873 stat_noalias (const char *path
, struct stat
*buf
)
1875 char mac_pathname
[MAXPATHLEN
+1];
1878 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1881 c2pstr (mac_pathname
);
1882 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1883 cipb
.hFileInfo
.ioVRefNum
= 0;
1884 cipb
.hFileInfo
.ioDirID
= 0;
1885 cipb
.hFileInfo
.ioFDirIndex
= 0;
1886 /* set to 0 to get information about specific dir or file */
1888 errno
= PBGetCatInfo (&cipb
, false);
1889 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1894 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1896 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1898 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1899 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1900 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1901 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1902 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1903 /* size of dir = number of files and dirs */
1906 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1907 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1911 buf
->st_mode
= S_IFREG
| S_IREAD
;
1912 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1913 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1914 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1915 buf
->st_mode
|= S_IEXEC
;
1916 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1917 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1918 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1921 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1922 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1925 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1927 /* identify alias files as symlinks */
1928 buf
->st_mode
&= ~S_IFREG
;
1929 buf
->st_mode
|= S_IFLNK
;
1933 buf
->st_uid
= getuid ();
1934 buf
->st_gid
= getgid ();
1942 lstat (const char *path
, struct stat
*buf
)
1945 char true_pathname
[MAXPATHLEN
+1];
1947 /* Try looking for the file without resolving aliases first. */
1948 if ((result
= stat_noalias (path
, buf
)) >= 0)
1951 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1954 return stat_noalias (true_pathname
, buf
);
1959 stat (const char *path
, struct stat
*sb
)
1962 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1965 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1966 ! (sb
->st_mode
& S_IFLNK
))
1969 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1972 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1975 fully_resolved_name
[len
] = '\0';
1976 /* in fact our readlink terminates strings */
1977 return lstat (fully_resolved_name
, sb
);
1980 return lstat (true_pathname
, sb
);
1985 /* CW defines fstat in stat.mac.c while MPW does not provide this
1986 function. Without the information of how to get from a file
1987 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1988 to implement this function. Fortunately, there is only one place
1989 where this function is called in our configuration: in fileio.c,
1990 where only the st_dev and st_ino fields are used to determine
1991 whether two fildes point to different i-nodes to prevent copying
1992 a file onto itself equal. What we have here probably needs
1996 fstat (int fildes
, struct stat
*buf
)
1999 buf
->st_ino
= fildes
;
2000 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
2001 return 0; /* success */
2003 #endif /* __MRC__ */
2007 mkdir (const char *dirname
, int mode
)
2009 #pragma unused(mode)
2012 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
2014 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
2017 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2020 c2pstr (mac_pathname
);
2021 hfpb
.ioNamePtr
= mac_pathname
;
2022 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2023 hfpb
.ioDirID
= 0; /* parent is the root */
2025 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
2026 /* just return the Mac OSErr code for now */
2027 return errno
== noErr
? 0 : -1;
2032 sys_rmdir (const char *dirname
)
2035 char mac_pathname
[MAXPATHLEN
+1];
2037 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2040 c2pstr (mac_pathname
);
2041 hfpb
.ioNamePtr
= mac_pathname
;
2042 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2043 hfpb
.ioDirID
= 0; /* parent is the root */
2045 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
2046 return errno
== noErr
? 0 : -1;
2051 /* No implementation yet. */
2053 execvp (const char *path
, ...)
2057 #endif /* __MRC__ */
2061 utime (const char *path
, const struct utimbuf
*times
)
2063 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2065 char mac_pathname
[MAXPATHLEN
+1];
2068 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2071 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2073 fully_resolved_name
[len
] = '\0';
2075 strcpy (fully_resolved_name
, true_pathname
);
2077 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2080 c2pstr (mac_pathname
);
2081 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2082 cipb
.hFileInfo
.ioVRefNum
= 0;
2083 cipb
.hFileInfo
.ioDirID
= 0;
2084 cipb
.hFileInfo
.ioFDirIndex
= 0;
2085 /* set to 0 to get information about specific dir or file */
2087 errno
= PBGetCatInfo (&cipb
, false);
2091 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
2094 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2096 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
2101 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2103 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
2106 errno
= PBSetCatInfo (&cipb
, false);
2107 return errno
== noErr
? 0 : -1;
2121 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2123 access (const char *path
, int mode
)
2125 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2127 char mac_pathname
[MAXPATHLEN
+1];
2130 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2133 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2135 fully_resolved_name
[len
] = '\0';
2137 strcpy (fully_resolved_name
, true_pathname
);
2139 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2142 c2pstr (mac_pathname
);
2143 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2144 cipb
.hFileInfo
.ioVRefNum
= 0;
2145 cipb
.hFileInfo
.ioDirID
= 0;
2146 cipb
.hFileInfo
.ioFDirIndex
= 0;
2147 /* set to 0 to get information about specific dir or file */
2149 errno
= PBGetCatInfo (&cipb
, false);
2153 if (mode
== F_OK
) /* got this far, file exists */
2157 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
2161 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2168 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2169 /* don't allow if lock bit is on */
2175 #define DEV_NULL_FD 0x10000
2179 sys_open (const char *path
, int oflag
)
2181 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2183 char mac_pathname
[MAXPATHLEN
+1];
2185 if (strcmp (path
, "/dev/null") == 0)
2186 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2188 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2191 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2193 fully_resolved_name
[len
] = '\0';
2195 strcpy (fully_resolved_name
, true_pathname
);
2197 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2202 int res
= open (mac_pathname
, oflag
);
2203 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2204 if (oflag
& O_CREAT
)
2205 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2207 #else /* not __MRC__ */
2208 return open (mac_pathname
, oflag
);
2209 #endif /* not __MRC__ */
2216 sys_creat (const char *path
, mode_t mode
)
2218 char true_pathname
[MAXPATHLEN
+1];
2220 char mac_pathname
[MAXPATHLEN
+1];
2222 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2225 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2230 int result
= creat (mac_pathname
);
2231 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2233 #else /* not __MRC__ */
2234 return creat (mac_pathname
, mode
);
2235 #endif /* not __MRC__ */
2242 sys_unlink (const char *path
)
2244 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2246 char mac_pathname
[MAXPATHLEN
+1];
2248 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2251 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2253 fully_resolved_name
[len
] = '\0';
2255 strcpy (fully_resolved_name
, true_pathname
);
2257 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2260 return unlink (mac_pathname
);
2266 sys_read (int fildes
, char *buf
, int count
)
2268 if (fildes
== 0) /* this should not be used for console input */
2271 #if __MSL__ >= 0x6000
2272 return _read (fildes
, buf
, count
);
2274 return read (fildes
, buf
, count
);
2281 sys_write (int fildes
, const char *buf
, int count
)
2283 if (fildes
== DEV_NULL_FD
)
2286 #if __MSL__ >= 0x6000
2287 return _write (fildes
, buf
, count
);
2289 return write (fildes
, buf
, count
);
2296 sys_rename (const char * old_name
, const char * new_name
)
2298 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2299 char fully_resolved_old_name
[MAXPATHLEN
+1];
2301 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2303 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2306 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2308 fully_resolved_old_name
[len
] = '\0';
2310 strcpy (fully_resolved_old_name
, true_old_pathname
);
2312 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2315 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2318 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2323 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2326 /* If a file with new_name already exists, rename deletes the old
2327 file in Unix. CW version fails in these situation. So we add a
2328 call to unlink here. */
2329 (void) unlink (mac_new_name
);
2331 return rename (mac_old_name
, mac_new_name
);
2336 extern FILE *fopen (const char *name
, const char *mode
);
2338 sys_fopen (const char *name
, const char *mode
)
2340 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2342 char mac_pathname
[MAXPATHLEN
+1];
2344 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2347 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2349 fully_resolved_name
[len
] = '\0';
2351 strcpy (fully_resolved_name
, true_pathname
);
2353 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2358 if (mode
[0] == 'w' || mode
[0] == 'a')
2359 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2360 #endif /* not __MRC__ */
2361 return fopen (mac_pathname
, mode
);
2366 extern Boolean mac_wait_next_event
P_ ((EventRecord
*, UInt32
, Boolean
));
2369 select (nfds
, rfds
, wfds
, efds
, timeout
)
2371 SELECT_TYPE
*rfds
, *wfds
, *efds
;
2372 EMACS_TIME
*timeout
;
2374 OSStatus err
= noErr
;
2376 /* Can only handle wait for keyboard input. */
2377 if (nfds
> 1 || wfds
|| efds
)
2380 /* Try detect_input_pending before ReceiveNextEvent in the same
2381 BLOCK_INPUT block, in case that some input has already been read
2384 ENABLE_WAKEUP_FROM_RNE
;
2385 if (!detect_input_pending ())
2387 #if TARGET_API_MAC_CARBON
2388 EventTimeout timeoutval
=
2390 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2391 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2392 : kEventDurationForever
);
2394 if (timeoutval
== 0.0)
2395 err
= eventLoopTimedOutErr
;
2397 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
2398 kEventLeaveInQueue
, NULL
);
2399 #else /* not TARGET_API_MAC_CARBON */
2401 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2402 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2404 if (sleep_time
== 0)
2405 err
= -9875; /* eventLoopTimedOutErr */
2408 if (mac_wait_next_event (&e
, sleep_time
, false))
2411 err
= -9875; /* eventLoopTimedOutErr */
2413 #endif /* not TARGET_API_MAC_CARBON */
2415 DISABLE_WAKEUP_FROM_RNE
;
2420 /* Pretend that `select' is interrupted by a signal. */
2421 detect_input_pending ();
2434 /* Simulation of SIGALRM. The stub for function signal stores the
2435 signal handler function in alarm_signal_func if a SIGALRM is
2439 #include "syssignal.h"
2441 static TMTask mac_atimer_task
;
2443 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2445 static int signal_mask
= 0;
2448 __sigfun alarm_signal_func
= (__sigfun
) 0;
2450 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2451 #else /* not __MRC__ and not __MWERKS__ */
2453 #endif /* not __MRC__ and not __MWERKS__ */
2457 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2459 sys_signal (int signal_num
, __sigfun signal_func
)
2461 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2463 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2464 #else /* not __MRC__ and not __MWERKS__ */
2466 #endif /* not __MRC__ and not __MWERKS__ */
2468 if (signal_num
!= SIGALRM
)
2469 return signal (signal_num
, signal_func
);
2473 __sigfun old_signal_func
;
2475 __signal_func_ptr old_signal_func
;
2479 old_signal_func
= alarm_signal_func
;
2480 alarm_signal_func
= signal_func
;
2481 return old_signal_func
;
2487 mac_atimer_handler (qlink
)
2490 if (alarm_signal_func
)
2491 (alarm_signal_func
) (SIGALRM
);
2496 set_mac_atimer (count
)
2499 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2501 if (mac_atimer_handlerUPP
== NULL
)
2502 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2503 mac_atimer_task
.tmCount
= 0;
2504 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2505 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2506 InsTime (mac_atimer_qlink
);
2508 PrimeTime (mac_atimer_qlink
, count
);
2513 remove_mac_atimer (remaining_count
)
2514 long *remaining_count
;
2516 if (mac_atimer_qlink
)
2518 RmvTime (mac_atimer_qlink
);
2519 if (remaining_count
)
2520 *remaining_count
= mac_atimer_task
.tmCount
;
2521 mac_atimer_qlink
= NULL
;
2533 int old_mask
= signal_mask
;
2535 signal_mask
|= mask
;
2537 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2538 remove_mac_atimer (NULL
);
2545 sigsetmask (int mask
)
2547 int old_mask
= signal_mask
;
2551 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2552 if (signal_mask
& sigmask (SIGALRM
))
2553 remove_mac_atimer (NULL
);
2555 set_mac_atimer (mac_atimer_task
.tmCount
);
2564 long remaining_count
;
2566 if (remove_mac_atimer (&remaining_count
) == 0)
2568 set_mac_atimer (seconds
* 1000);
2570 return remaining_count
/ 1000;
2574 mac_atimer_task
.tmCount
= seconds
* 1000;
2582 setitimer (which
, value
, ovalue
)
2584 const struct itimerval
*value
;
2585 struct itimerval
*ovalue
;
2587 long remaining_count
;
2588 long count
= (EMACS_SECS (value
->it_value
) * 1000
2589 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2591 if (remove_mac_atimer (&remaining_count
) == 0)
2595 bzero (ovalue
, sizeof (*ovalue
));
2596 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2597 (remaining_count
% 1000) * 1000);
2599 set_mac_atimer (count
);
2602 mac_atimer_task
.tmCount
= count
;
2608 /* gettimeofday should return the amount of time (in a timeval
2609 structure) since midnight today. The toolbox function Microseconds
2610 returns the number of microseconds (in a UnsignedWide value) since
2611 the machine was booted. Also making this complicated is WideAdd,
2612 WideSubtract, etc. take wide values. */
2619 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2620 UnsignedWide uw_microseconds
;
2621 wide w_microseconds
;
2622 time_t sys_time (time_t *);
2624 /* If this function is called for the first time, record the number
2625 of seconds since midnight and the number of microseconds since
2626 boot at the time of this first call. */
2631 systime
= sys_time (NULL
);
2632 /* Store microseconds since midnight in wall_clock_at_epoch. */
2633 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2634 Microseconds (&uw_microseconds
);
2635 /* Store microseconds since boot in clicks_at_epoch. */
2636 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2637 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2640 /* Get time since boot */
2641 Microseconds (&uw_microseconds
);
2643 /* Convert to time since midnight*/
2644 w_microseconds
.hi
= uw_microseconds
.hi
;
2645 w_microseconds
.lo
= uw_microseconds
.lo
;
2646 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2647 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2648 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2656 sleep (unsigned int seconds
)
2658 unsigned long time_up
;
2661 time_up
= TickCount () + seconds
* 60;
2662 while (TickCount () < time_up
)
2664 /* Accept no event; just wait. by T.I. */
2665 WaitNextEvent (0, &e
, 30, NULL
);
2670 #endif /* __MRC__ */
2673 /* The time functions adjust time values according to the difference
2674 between the Unix and CW epoches. */
2677 extern struct tm
*gmtime (const time_t *);
2679 sys_gmtime (const time_t *timer
)
2681 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2683 return gmtime (&unix_time
);
2688 extern struct tm
*localtime (const time_t *);
2690 sys_localtime (const time_t *timer
)
2692 #if __MSL__ >= 0x6000
2693 time_t unix_time
= *timer
;
2695 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2698 return localtime (&unix_time
);
2703 extern char *ctime (const time_t *);
2705 sys_ctime (const time_t *timer
)
2707 #if __MSL__ >= 0x6000
2708 time_t unix_time
= *timer
;
2710 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2713 return ctime (&unix_time
);
2718 extern time_t time (time_t *);
2720 sys_time (time_t *timer
)
2722 #if __MSL__ >= 0x6000
2723 time_t mac_time
= time (NULL
);
2725 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2735 /* no subprocesses, empty wait */
2745 croak (char *badfunc
)
2747 printf ("%s not yet implemented\r\n", badfunc
);
2753 mktemp (char *template)
2758 len
= strlen (template);
2760 while (k
>= 0 && template[k
] == 'X')
2763 k
++; /* make k index of first 'X' */
2767 /* Zero filled, number of digits equal to the number of X's. */
2768 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2777 /* Emulate getpwuid, getpwnam and others. */
2779 #define PASSWD_FIELD_SIZE 256
2781 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2782 static char my_passwd_dir
[MAXPATHLEN
+1];
2784 static struct passwd my_passwd
=
2790 static struct group my_group
=
2792 /* There are no groups on the mac, so we just return "root" as the
2798 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2800 char emacs_passwd_dir
[MAXPATHLEN
+1];
2806 init_emacs_passwd_dir ()
2810 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2812 /* Need pathname of first ancestor that begins with "emacs"
2813 since Mac emacs application is somewhere in the emacs-*
2815 int len
= strlen (emacs_passwd_dir
);
2817 /* j points to the "/" following the directory name being
2820 while (i
>= 0 && !found
)
2822 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2824 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2825 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2827 emacs_passwd_dir
[j
+1] = '\0';
2838 /* Setting to "/" probably won't work but set it to something
2840 strcpy (emacs_passwd_dir
, "/");
2841 strcpy (my_passwd_dir
, "/");
2846 static struct passwd emacs_passwd
=
2852 static int my_passwd_inited
= 0;
2860 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2861 directory where Emacs was started. */
2863 owner_name
= (char **) GetResource ('STR ',-16096);
2867 BlockMove ((unsigned char *) *owner_name
,
2868 (unsigned char *) my_passwd_name
,
2870 HUnlock (owner_name
);
2871 p2cstr ((unsigned char *) my_passwd_name
);
2874 my_passwd_name
[0] = 0;
2879 getpwuid (uid_t uid
)
2881 if (!my_passwd_inited
)
2884 my_passwd_inited
= 1;
2892 getgrgid (gid_t gid
)
2899 getpwnam (const char *name
)
2901 if (strcmp (name
, "emacs") == 0)
2902 return &emacs_passwd
;
2904 if (!my_passwd_inited
)
2907 my_passwd_inited
= 1;
2914 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2915 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2936 error ("Can't spawn subshell");
2941 request_sigio (void)
2947 unrequest_sigio (void)
2962 pipe (int _fildes
[2])
2969 /* Hard and symbolic links. */
2972 symlink (const char *name1
, const char *name2
)
2980 link (const char *name1
, const char *name2
)
2986 #endif /* ! MAC_OSX */
2988 /* Determine the path name of the file specified by VREFNUM, DIRID,
2989 and NAME and place that in the buffer PATH of length
2992 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2993 long dir_id
, ConstStr255Param name
)
2999 if (strlen (name
) > man_path_len
)
3002 memcpy (dir_name
, name
, name
[0]+1);
3003 memcpy (path
, name
, name
[0]+1);
3006 cipb
.dirInfo
.ioDrParID
= dir_id
;
3007 cipb
.dirInfo
.ioNamePtr
= dir_name
;
3011 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
3012 cipb
.dirInfo
.ioFDirIndex
= -1;
3013 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
3014 /* go up to parent each time */
3016 err
= PBGetCatInfo (&cipb
, false);
3021 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
3024 strcat (dir_name
, ":");
3025 strcat (dir_name
, path
);
3026 /* attach to front since we're going up directory tree */
3027 strcpy (path
, dir_name
);
3029 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
3030 /* stop when we see the volume's root directory */
3032 return 1; /* success */
3039 posix_pathname_to_fsspec (ufn
, fs
)
3043 Str255 mac_pathname
;
3045 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
3049 c2pstr (mac_pathname
);
3050 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
3055 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
3060 char mac_pathname
[MAXPATHLEN
];
3062 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
3063 fs
->vRefNum
, fs
->parID
, fs
->name
)
3064 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
3071 readlink (const char *path
, char *buf
, int bufsiz
)
3073 char mac_sym_link_name
[MAXPATHLEN
+1];
3076 Boolean target_is_folder
, was_aliased
;
3077 Str255 directory_name
, mac_pathname
;
3080 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
3083 c2pstr (mac_sym_link_name
);
3084 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
3091 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
3092 if (err
!= noErr
|| !was_aliased
)
3098 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
3105 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
3111 return strlen (buf
);
3115 /* Convert a path to one with aliases fully expanded. */
3118 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
3120 char *q
, temp
[MAXPATHLEN
+1];
3124 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
3131 q
= strchr (p
+ 1, '/');
3133 q
= strchr (p
, '/');
3134 len
= 0; /* loop may not be entered, e.g., for "/" */
3139 strncat (temp
, p
, q
- p
);
3140 len
= readlink (temp
, buf
, bufsiz
);
3143 if (strlen (temp
) + 1 > bufsiz
)
3153 if (len
+ strlen (p
) + 1 >= bufsiz
)
3157 return len
+ strlen (p
);
3162 umask (mode_t numask
)
3164 static mode_t mask
= 022;
3165 mode_t oldmask
= mask
;
3172 chmod (const char *path
, mode_t mode
)
3174 /* say it always succeed for now */
3180 fchmod (int fd
, mode_t mode
)
3182 /* say it always succeed for now */
3188 fchown (int fd
, uid_t owner
, gid_t group
)
3190 /* say it always succeed for now */
3199 return fcntl (oldd
, F_DUPFD
, 0);
3201 /* current implementation of fcntl in fcntl.mac.c simply returns old
3203 return fcntl (oldd
, F_DUPFD
);
3210 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3211 newd if it already exists. Then, attempt to dup oldd. If not
3212 successful, call dup2 recursively until we are, then close the
3213 unsuccessful ones. */
3216 dup2 (int oldd
, int newd
)
3227 ret
= dup2 (oldd
, newd
);
3233 /* let it fail for now */
3250 ioctl (int d
, int request
, void *argp
)
3260 if (fildes
>=0 && fildes
<= 2)
3293 #endif /* __MRC__ */
3297 #if __MSL__ < 0x6000
3305 #endif /* __MWERKS__ */
3307 #endif /* ! MAC_OSX */
3310 /* Return the path to the directory in which Emacs can create
3311 temporary files. The MacOS "temporary items" directory cannot be
3312 used because it removes the file written by a process when it
3313 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3314 again not exactly). And of course Emacs needs to read back the
3315 files written by its subprocesses. So here we write the files to a
3316 directory "Emacs" in the Preferences Folder. This directory is
3317 created if it does not exist. */
3320 get_temp_dir_name ()
3322 static char *temp_dir_name
= NULL
;
3327 char unix_dir_name
[MAXPATHLEN
+1];
3330 /* Cache directory name with pointer temp_dir_name.
3331 Look for it only the first time. */
3334 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3335 &vol_ref_num
, &dir_id
);
3339 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3342 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3343 strcat (full_path
, "Emacs:");
3347 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3350 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3353 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3356 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3357 strcpy (temp_dir_name
, unix_dir_name
);
3360 return temp_dir_name
;
3365 /* Allocate and construct an array of pointers to strings from a list
3366 of strings stored in a 'STR#' resource. The returned pointer array
3367 is stored in the style of argv and environ: if the 'STR#' resource
3368 contains numString strings, a pointer array with numString+1
3369 elements is returned in which the last entry contains a null
3370 pointer. The pointer to the pointer array is passed by pointer in
3371 parameter t. The resource ID of the 'STR#' resource is passed in
3372 parameter StringListID.
3376 get_string_list (char ***t
, short string_list_id
)
3382 h
= GetResource ('STR#', string_list_id
);
3387 num_strings
= * (short *) p
;
3389 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3390 for (i
= 0; i
< num_strings
; i
++)
3392 short length
= *p
++;
3393 (*t
)[i
] = (char *) malloc (length
+ 1);
3394 strncpy ((*t
)[i
], p
, length
);
3395 (*t
)[i
][length
] = '\0';
3398 (*t
)[num_strings
] = 0;
3403 /* Return no string in case GetResource fails. Bug fixed by
3404 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3405 option (no sym -on implies -opt local). */
3406 *t
= (char **) malloc (sizeof (char *));
3413 get_path_to_system_folder ()
3419 static char system_folder_unix_name
[MAXPATHLEN
+1];
3422 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3423 &vol_ref_num
, &dir_id
);
3427 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3430 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3434 return system_folder_unix_name
;
3440 #define ENVIRON_STRING_LIST_ID 128
3442 /* Get environment variable definitions from STR# resource. */
3449 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3455 /* Make HOME directory the one Emacs starts up in if not specified
3457 if (getenv ("HOME") == NULL
)
3459 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3462 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3465 strcpy (environ
[i
], "HOME=");
3466 strcat (environ
[i
], my_passwd_dir
);
3473 /* Make HOME directory the one Emacs starts up in if not specified
3475 if (getenv ("MAIL") == NULL
)
3477 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3480 char * path_to_system_folder
= get_path_to_system_folder ();
3481 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3484 strcpy (environ
[i
], "MAIL=");
3485 strcat (environ
[i
], path_to_system_folder
);
3486 strcat (environ
[i
], "Eudora Folder/In");
3494 /* Return the value of the environment variable NAME. */
3497 getenv (const char *name
)
3499 int length
= strlen(name
);
3502 for (e
= environ
; *e
!= 0; e
++)
3503 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3504 return &(*e
)[length
+ 1];
3506 if (strcmp (name
, "TMPDIR") == 0)
3507 return get_temp_dir_name ();
3514 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3515 char *sys_siglist
[] =
3517 "Zero is not a signal!!!",
3519 "Interactive user interrupt", /* 2 */ "?",
3520 "Floating point exception", /* 4 */ "?", "?", "?",
3521 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3522 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3523 "?", "?", "?", "?", "?", "?", "?", "?",
3527 char *sys_siglist
[] =
3529 "Zero is not a signal!!!",
3531 "Floating point exception",
3532 "Illegal instruction",
3533 "Interactive user interrupt",
3534 "Segment violation",
3537 #else /* not __MRC__ and not __MWERKS__ */
3539 #endif /* not __MRC__ and not __MWERKS__ */
3542 #include <utsname.h>
3545 uname (struct utsname
*name
)
3548 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3551 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3552 p2cstr (name
->nodename
);
3560 /* Event class of HLE sent to subprocess. */
3561 const OSType kEmacsSubprocessSend
= 'ESND';
3563 /* Event class of HLE sent back from subprocess. */
3564 const OSType kEmacsSubprocessReply
= 'ERPY';
3568 mystrchr (char *s
, char c
)
3570 while (*s
&& *s
!= c
)
3598 mystrcpy (char *to
, char *from
)
3610 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3611 terminated). The process should run with the default directory
3612 "workdir", read input from "infn", and write output and error to
3613 "outfn" and "errfn", resp. The Process Manager call
3614 LaunchApplication is used to start the subprocess. We use high
3615 level events as the mechanism to pass arguments to the subprocess
3616 and to make Emacs wait for the subprocess to terminate and pass
3617 back a result code. The bulk of the code here packs the arguments
3618 into one message to be passed together with the high level event.
3619 Emacs also sometimes starts a subprocess using a shell to perform
3620 wildcard filename expansion. Since we don't really have a shell on
3621 the Mac, this case is detected and the starting of the shell is
3622 by-passed. We really need to add code here to do filename
3623 expansion to support such functionality.
3625 We can't use this strategy in Carbon because the High Level Event
3626 APIs are not available. */
3629 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3630 unsigned char **argv
;
3631 const char *workdir
;
3632 const char *infn
, *outfn
, *errfn
;
3634 #if TARGET_API_MAC_CARBON
3636 #else /* not TARGET_API_MAC_CARBON */
3637 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3638 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3639 int paramlen
, argc
, newargc
, j
, retries
;
3640 char **newargv
, *param
, *p
;
3643 LaunchParamBlockRec lpbr
;
3644 EventRecord send_event
, reply_event
;
3645 RgnHandle cursor_region_handle
;
3647 unsigned long ref_con
, len
;
3649 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3651 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3653 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3655 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3658 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3659 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3668 /* If a subprocess is invoked with a shell, we receive 3 arguments
3669 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3670 bins>/<command> <command args>" */
3671 j
= strlen (argv
[0]);
3672 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3673 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3675 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3677 /* The arguments for the command in argv[2] are separated by
3678 spaces. Count them and put the count in newargc. */
3679 command
= (char *) alloca (strlen (argv
[2])+2);
3680 strcpy (command
, argv
[2]);
3681 if (command
[strlen (command
) - 1] != ' ')
3682 strcat (command
, " ");
3686 t
= mystrchr (t
, ' ');
3690 t
= mystrchr (t
+1, ' ');
3693 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3696 for (j
= 0; j
< newargc
; j
++)
3698 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3699 mystrcpy (newargv
[j
], t
);
3702 paramlen
+= strlen (newargv
[j
]) + 1;
3705 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3707 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3712 { /* sometimes Emacs call "sh" without a path for the command */
3714 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3715 strcpy (t
, "~emacs/");
3716 strcat (t
, newargv
[0]);
3719 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3720 make_number (X_OK
));
3724 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3728 strcpy (macappname
, tempmacpathname
);
3732 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3735 newargv
= (char **) alloca (sizeof (char *) * argc
);
3737 for (j
= 1; j
< argc
; j
++)
3739 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3741 char *t
= strchr (argv
[j
], ' ');
3744 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3745 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3746 tempcmdname
[t
-argv
[j
]] = '\0';
3747 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3750 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3752 strcpy (newargv
[j
], tempmaccmdname
);
3753 strcat (newargv
[j
], t
);
3757 char tempmaccmdname
[MAXPATHLEN
+1];
3758 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3761 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3762 strcpy (newargv
[j
], tempmaccmdname
);
3766 newargv
[j
] = argv
[j
];
3767 paramlen
+= strlen (newargv
[j
]) + 1;
3771 /* After expanding all the arguments, we now know the length of the
3772 parameter block to be sent to the subprocess as a message
3773 attached to the HLE. */
3774 param
= (char *) malloc (paramlen
+ 1);
3780 /* first byte of message contains number of arguments for command */
3781 strcpy (p
, macworkdir
);
3782 p
+= strlen (macworkdir
);
3784 /* null terminate strings sent so it's possible to use strcpy over there */
3785 strcpy (p
, macinfn
);
3786 p
+= strlen (macinfn
);
3788 strcpy (p
, macoutfn
);
3789 p
+= strlen (macoutfn
);
3791 strcpy (p
, macerrfn
);
3792 p
+= strlen (macerrfn
);
3794 for (j
= 1; j
< newargc
; j
++)
3796 strcpy (p
, newargv
[j
]);
3797 p
+= strlen (newargv
[j
]);
3801 c2pstr (macappname
);
3803 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3811 lpbr
.launchBlockID
= extendedBlock
;
3812 lpbr
.launchEPBLength
= extendedBlockLen
;
3813 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3814 lpbr
.launchAppSpec
= &spec
;
3815 lpbr
.launchAppParameters
= NULL
;
3817 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3824 send_event
.what
= kHighLevelEvent
;
3825 send_event
.message
= kEmacsSubprocessSend
;
3826 /* Event ID stored in "where" unused */
3829 /* OS may think current subprocess has terminated if previous one
3830 terminated recently. */
3833 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3834 paramlen
+ 1, receiverIDisPSN
);
3836 while (iErr
== sessClosedErr
&& retries
-- > 0);
3844 cursor_region_handle
= NewRgn ();
3846 /* Wait for the subprocess to finish, when it will send us a ERPY
3847 high level event. */
3849 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3850 cursor_region_handle
)
3851 && reply_event
.message
== kEmacsSubprocessReply
)
3854 /* The return code is sent through the refCon */
3855 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3858 DisposeHandle ((Handle
) cursor_region_handle
);
3863 DisposeHandle ((Handle
) cursor_region_handle
);
3867 #endif /* not TARGET_API_MAC_CARBON */
3872 opendir (const char *dirname
)
3874 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3875 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3879 int len
, vol_name_len
;
3881 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3884 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3886 fully_resolved_name
[len
] = '\0';
3888 strcpy (fully_resolved_name
, true_pathname
);
3890 dirp
= (DIR *) malloc (sizeof(DIR));
3894 /* Handle special case when dirname is "/": sets up for readir to
3895 get all mount volumes. */
3896 if (strcmp (fully_resolved_name
, "/") == 0)
3898 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3899 dirp
->current_index
= 1; /* index for first volume */
3903 /* Handle typical cases: not accessing all mounted volumes. */
3904 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3907 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3908 len
= strlen (mac_pathname
);
3909 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3910 strcat (mac_pathname
, ":");
3912 /* Extract volume name */
3913 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3914 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3915 vol_name
[vol_name_len
] = '\0';
3916 strcat (vol_name
, ":");
3918 c2pstr (mac_pathname
);
3919 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3920 /* using full pathname so vRefNum and DirID ignored */
3921 cipb
.hFileInfo
.ioVRefNum
= 0;
3922 cipb
.hFileInfo
.ioDirID
= 0;
3923 cipb
.hFileInfo
.ioFDirIndex
= 0;
3924 /* set to 0 to get information about specific dir or file */
3926 errno
= PBGetCatInfo (&cipb
, false);
3933 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3934 return 0; /* not a directory */
3936 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3937 dirp
->getting_volumes
= 0;
3938 dirp
->current_index
= 1; /* index for first file/directory */
3941 vpb
.ioNamePtr
= vol_name
;
3942 /* using full pathname so vRefNum and DirID ignored */
3944 vpb
.ioVolIndex
= -1;
3945 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3952 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3969 HParamBlockRec hpblock
;
3971 static struct dirent s_dirent
;
3972 static Str255 s_name
;
3976 /* Handle the root directory containing the mounted volumes. Call
3977 PBHGetVInfo specifying an index to obtain the info for a volume.
3978 PBHGetVInfo returns an error when it receives an index beyond the
3979 last volume, at which time we should return a nil dirent struct
3981 if (dp
->getting_volumes
)
3983 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3984 hpblock
.volumeParam
.ioVRefNum
= 0;
3985 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3987 errno
= PBHGetVInfo (&hpblock
, false);
3995 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3997 dp
->current_index
++;
3999 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
4000 s_dirent
.d_name
= s_name
;
4006 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
4007 cipb
.hFileInfo
.ioNamePtr
= s_name
;
4008 /* location to receive filename returned */
4010 /* return only visible files */
4014 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
4015 /* directory ID found by opendir */
4016 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
4018 errno
= PBGetCatInfo (&cipb
, false);
4025 /* insist on a visible entry */
4026 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
4027 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
4029 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
4031 dp
->current_index
++;
4044 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
4045 /* value unimportant: non-zero for valid file */
4046 s_dirent
.d_name
= s_name
;
4056 char mac_pathname
[MAXPATHLEN
+1];
4057 Str255 directory_name
;
4061 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
4064 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
4070 #endif /* ! MAC_OSX */
4074 initialize_applescript ()
4079 /* if open fails, as_scripting_component is set to NULL. Its
4080 subsequent use in OSA calls will fail with badComponentInstance
4082 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
4083 kAppleScriptSubtype
);
4085 null_desc
.descriptorType
= typeNull
;
4086 null_desc
.dataHandle
= 0;
4087 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
4088 kOSANullScript
, &as_script_context
);
4090 as_script_context
= kOSANullScript
;
4091 /* use default context if create fails */
4096 terminate_applescript()
4098 OSADispose (as_scripting_component
, as_script_context
);
4099 CloseComponent (as_scripting_component
);
4102 /* Convert a lisp string to the 4 byte character code. */
4105 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
4114 /* check type string */
4116 if (SBYTES (arg
) != 4)
4118 error ("Wrong argument: need string of length 4 for code");
4120 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
4125 /* Convert the 4 byte character code into a 4 byte string. */
4128 mac_get_object_from_code(OSType defCode
)
4130 UInt32 code
= EndianU32_NtoB (defCode
);
4132 return make_unibyte_string ((char *)&code
, 4);
4136 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
4137 doc
: /* Get the creator code of FILENAME as a four character string. */)
4139 Lisp_Object filename
;
4147 Lisp_Object result
= Qnil
;
4148 CHECK_STRING (filename
);
4150 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4153 filename
= Fexpand_file_name (filename
, Qnil
);
4157 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4159 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4162 if (status
== noErr
)
4165 FSCatalogInfo catalogInfo
;
4167 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4168 &catalogInfo
, NULL
, NULL
, NULL
);
4172 status
= FSpGetFInfo (&fss
, &finder_info
);
4174 if (status
== noErr
)
4177 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4179 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4184 if (status
!= noErr
) {
4185 error ("Error while getting file information.");
4190 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4191 doc
: /* Get the type code of FILENAME as a four character string. */)
4193 Lisp_Object filename
;
4201 Lisp_Object result
= Qnil
;
4202 CHECK_STRING (filename
);
4204 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4207 filename
= Fexpand_file_name (filename
, Qnil
);
4211 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4213 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4216 if (status
== noErr
)
4219 FSCatalogInfo catalogInfo
;
4221 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4222 &catalogInfo
, NULL
, NULL
, NULL
);
4226 status
= FSpGetFInfo (&fss
, &finder_info
);
4228 if (status
== noErr
)
4231 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4233 result
= mac_get_object_from_code (finder_info
.fdType
);
4238 if (status
!= noErr
) {
4239 error ("Error while getting file information.");
4244 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4245 doc
: /* Set creator code of file FILENAME to CODE.
4246 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4247 assumed. Return non-nil if successful. */)
4249 Lisp_Object filename
, code
;
4258 CHECK_STRING (filename
);
4260 cCode
= mac_get_code_from_arg(code
, MAC_EMACS_CREATOR_CODE
);
4262 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4265 filename
= Fexpand_file_name (filename
, Qnil
);
4269 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4271 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4274 if (status
== noErr
)
4277 FSCatalogInfo catalogInfo
;
4279 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4280 &catalogInfo
, NULL
, NULL
, &parentDir
);
4284 status
= FSpGetFInfo (&fss
, &finder_info
);
4286 if (status
== noErr
)
4289 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4290 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4291 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4293 finder_info
.fdCreator
= cCode
;
4294 status
= FSpSetFInfo (&fss
, &finder_info
);
4299 if (status
!= noErr
) {
4300 error ("Error while setting creator information.");
4305 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4306 doc
: /* Set file code of file FILENAME to CODE.
4307 CODE must be a 4-character string. Return non-nil if successful. */)
4309 Lisp_Object filename
, code
;
4318 CHECK_STRING (filename
);
4320 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4322 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4325 filename
= Fexpand_file_name (filename
, Qnil
);
4329 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4331 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4334 if (status
== noErr
)
4337 FSCatalogInfo catalogInfo
;
4339 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4340 &catalogInfo
, NULL
, NULL
, &parentDir
);
4344 status
= FSpGetFInfo (&fss
, &finder_info
);
4346 if (status
== noErr
)
4349 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4350 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4351 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4353 finder_info
.fdType
= cCode
;
4354 status
= FSpSetFInfo (&fss
, &finder_info
);
4359 if (status
!= noErr
) {
4360 error ("Error while setting creator information.");
4366 /* Compile and execute the AppleScript SCRIPT and return the error
4367 status as function value. A zero is returned if compilation and
4368 execution is successful, in which case *RESULT is set to a Lisp
4369 string containing the resulting script value. Otherwise, the Mac
4370 error code is returned and *RESULT is set to an error Lisp string.
4371 For documentation on the MacOS scripting architecture, see Inside
4372 Macintosh - Interapplication Communications: Scripting
4376 do_applescript (script
, result
)
4377 Lisp_Object script
, *result
;
4379 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4385 if (!as_scripting_component
)
4386 initialize_applescript();
4388 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4393 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4394 typeChar
, kOSAModeNull
, &result_desc
);
4396 if (osaerror
== noErr
)
4397 /* success: retrieve resulting script value */
4398 desc
= &result_desc
;
4399 else if (osaerror
== errOSAScriptError
)
4400 /* error executing AppleScript: retrieve error message */
4401 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4407 #if TARGET_API_MAC_CARBON
4408 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4409 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4410 #else /* not TARGET_API_MAC_CARBON */
4411 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4412 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4413 #endif /* not TARGET_API_MAC_CARBON */
4414 AEDisposeDesc (desc
);
4417 AEDisposeDesc (&script_desc
);
4423 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4424 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4425 If compilation and execution are successful, the resulting script
4426 value is returned as a string. Otherwise the function aborts and
4427 displays the error message returned by the AppleScript scripting
4435 CHECK_STRING (script
);
4438 status
= do_applescript (script
, &result
);
4442 else if (!STRINGP (result
))
4443 error ("AppleScript error %d", status
);
4445 error ("%s", SDATA (result
));
4449 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4450 Smac_file_name_to_posix
, 1, 1, 0,
4451 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4453 Lisp_Object filename
;
4455 char posix_filename
[MAXPATHLEN
+1];
4457 CHECK_STRING (filename
);
4459 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4460 return build_string (posix_filename
);
4466 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4467 Sposix_file_name_to_mac
, 1, 1, 0,
4468 doc
: /* Convert Posix FILENAME to Mac form. */)
4470 Lisp_Object filename
;
4472 char mac_filename
[MAXPATHLEN
+1];
4474 CHECK_STRING (filename
);
4476 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4477 return build_string (mac_filename
);
4483 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4484 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4485 Each type should be a string of length 4 or the symbol
4486 `undecoded-file-name'. */)
4487 (src_type
, src_data
, dst_type
)
4488 Lisp_Object src_type
, src_data
, dst_type
;
4491 Lisp_Object result
= Qnil
;
4492 DescType src_desc_type
, dst_desc_type
;
4495 CHECK_STRING (src_data
);
4496 if (EQ (src_type
, Qundecoded_file_name
))
4497 src_desc_type
= TYPE_FILE_NAME
;
4499 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4501 if (EQ (dst_type
, Qundecoded_file_name
))
4502 dst_desc_type
= TYPE_FILE_NAME
;
4504 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4507 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4508 dst_desc_type
, &dst_desc
);
4511 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4512 AEDisposeDesc (&dst_desc
);
4520 #if TARGET_API_MAC_CARBON
4521 static Lisp_Object Qxml
, Qmime_charset
;
4522 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4524 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4525 doc
: /* Return the application preference value for KEY.
4526 KEY is either a string specifying a preference key, or a list of key
4527 strings. If it is a list, the (i+1)-th element is used as a key for
4528 the CFDictionary value obtained by the i-th element. Return nil if
4529 lookup is failed at some stage.
4531 Optional arg APPLICATION is an application ID string. If omitted or
4532 nil, that stands for the current application.
4534 Optional arg FORMAT specifies the data format of the return value. If
4535 omitted or nil, each Core Foundation object is converted into a
4536 corresponding Lisp object as follows:
4538 Core Foundation Lisp Tag
4539 ------------------------------------------------------------
4540 CFString Multibyte string string
4541 CFNumber Integer or float number
4542 CFBoolean Symbol (t or nil) boolean
4543 CFDate List of three integers date
4544 (cf. `current-time')
4545 CFData Unibyte string data
4546 CFArray Vector array
4547 CFDictionary Alist or hash table dictionary
4548 (depending on HASH-BOUND)
4550 If it is t, a symbol that represents the type of the original Core
4551 Foundation object is prepended. If it is `xml', the value is returned
4552 as an XML representation.
4554 Optional arg HASH-BOUND specifies which kinds of the list objects,
4555 alists or hash tables, are used as the targets of the conversion from
4556 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4557 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4558 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4560 (key
, application
, format
, hash_bound
)
4561 Lisp_Object key
, application
, format
, hash_bound
;
4563 CFStringRef app_id
, key_str
;
4564 CFPropertyListRef app_plist
= NULL
, plist
;
4565 Lisp_Object result
= Qnil
, tmp
;
4566 struct gcpro gcpro1
, gcpro2
;
4569 key
= Fcons (key
, Qnil
);
4573 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4574 CHECK_STRING_CAR (tmp
);
4575 CHECK_LIST_END (tmp
, key
);
4577 if (!NILP (application
))
4578 CHECK_STRING (application
);
4579 CHECK_SYMBOL (format
);
4580 if (!NILP (hash_bound
))
4581 CHECK_NUMBER (hash_bound
);
4583 GCPRO2 (key
, format
);
4587 app_id
= kCFPreferencesCurrentApplication
;
4588 if (!NILP (application
))
4590 app_id
= cfstring_create_with_string (application
);
4594 if (!CFPreferencesAppSynchronize (app_id
))
4597 key_str
= cfstring_create_with_string (XCAR (key
));
4598 if (key_str
== NULL
)
4600 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4601 CFRelease (key_str
);
4602 if (app_plist
== NULL
)
4606 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4608 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4610 key_str
= cfstring_create_with_string (XCAR (key
));
4611 if (key_str
== NULL
)
4613 plist
= CFDictionaryGetValue (plist
, key_str
);
4614 CFRelease (key_str
);
4621 if (EQ (format
, Qxml
))
4623 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4626 result
= cfdata_to_lisp (data
);
4631 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4632 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4637 CFRelease (app_plist
);
4648 static CFStringEncoding
4649 get_cfstring_encoding_from_lisp (obj
)
4652 CFStringRef iana_name
;
4653 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4656 return kCFStringEncodingUnicode
;
4661 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4663 Lisp_Object coding_spec
, plist
;
4665 coding_spec
= Fget (obj
, Qcoding_system
);
4666 plist
= XVECTOR (coding_spec
)->contents
[3];
4667 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4671 obj
= SYMBOL_NAME (obj
);
4675 iana_name
= cfstring_create_with_string (obj
);
4678 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4679 CFRelease (iana_name
);
4686 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4688 cfstring_create_normalized (str
, symbol
)
4693 TextEncodingVariant variant
;
4694 float initial_mag
= 0.0;
4695 CFStringRef result
= NULL
;
4697 if (EQ (symbol
, QNFD
))
4698 form
= kCFStringNormalizationFormD
;
4699 else if (EQ (symbol
, QNFKD
))
4700 form
= kCFStringNormalizationFormKD
;
4701 else if (EQ (symbol
, QNFC
))
4702 form
= kCFStringNormalizationFormC
;
4703 else if (EQ (symbol
, QNFKC
))
4704 form
= kCFStringNormalizationFormKC
;
4705 else if (EQ (symbol
, QHFS_plus_D
))
4707 variant
= kUnicodeHFSPlusDecompVariant
;
4710 else if (EQ (symbol
, QHFS_plus_C
))
4712 variant
= kUnicodeHFSPlusCompVariant
;
4718 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4722 CFStringNormalize (mut_str
, form
);
4726 else if (initial_mag
> 0.0)
4728 UnicodeToTextInfo uni
= NULL
;
4731 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4732 OSStatus err
= noErr
;
4733 ByteCount out_read
, out_size
, out_len
;
4735 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4737 kTextEncodingDefaultFormat
);
4738 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4740 kTextEncodingDefaultFormat
);
4741 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4743 length
= CFStringGetLength (str
);
4744 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4748 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4749 if (in_text
== NULL
)
4751 buffer
= xmalloc (sizeof (UniChar
) * length
);
4752 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4757 err
= CreateUnicodeToTextInfo (&map
, &uni
);
4758 while (err
== noErr
)
4760 out_buf
= xmalloc (out_size
);
4761 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4763 kUnicodeDefaultDirectionMask
,
4764 0, NULL
, NULL
, NULL
,
4765 out_size
, &out_read
, &out_len
,
4767 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4776 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4777 out_len
/ sizeof (UniChar
));
4779 DisposeUnicodeToTextInfo (&uni
);
4793 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4794 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4795 The conversion is performed using the converter provided by the system.
4796 Each encoding is specified by either a coding system symbol, a mime
4797 charset string, or an integer as a CFStringEncoding value. An encoding
4798 of nil means UTF-16 in native byte order, no byte order mark.
4799 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4800 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4801 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4802 On successful conversion, return the result string, else return nil. */)
4803 (string
, source
, target
, normalization_form
)
4804 Lisp_Object string
, source
, target
, normalization_form
;
4806 Lisp_Object result
= Qnil
;
4807 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4808 CFStringEncoding src_encoding
, tgt_encoding
;
4809 CFStringRef str
= NULL
;
4811 CHECK_STRING (string
);
4812 if (!INTEGERP (source
) && !STRINGP (source
))
4813 CHECK_SYMBOL (source
);
4814 if (!INTEGERP (target
) && !STRINGP (target
))
4815 CHECK_SYMBOL (target
);
4816 CHECK_SYMBOL (normalization_form
);
4818 GCPRO4 (string
, source
, target
, normalization_form
);
4822 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4823 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4825 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4826 use string_as_unibyte which works as well, except for the fact that
4827 it's too permissive (it doesn't check that the multibyte string only
4828 contain single-byte chars). */
4829 string
= Fstring_as_unibyte (string
);
4830 if (src_encoding
!= kCFStringEncodingInvalidId
4831 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4832 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4833 src_encoding
, !NILP (source
));
4834 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4837 CFStringRef saved_str
= str
;
4839 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4840 CFRelease (saved_str
);
4845 CFIndex str_len
, buf_len
;
4847 str_len
= CFStringGetLength (str
);
4848 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4849 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4851 result
= make_uninit_string (buf_len
);
4852 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4853 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4865 DEFUN ("mac-process-hi-command", Fmac_process_hi_command
, Smac_process_hi_command
, 1, 1, 0,
4866 doc
: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4867 COMMAND-ID must be a 4-character string. Some common command IDs are
4868 defined in the Carbon Event Manager. */)
4870 Lisp_Object command_id
;
4875 bzero (&command
, sizeof (HICommand
));
4876 command
.commandID
= mac_get_code_from_arg (command_id
, 0);
4879 err
= ProcessHICommand (&command
);
4883 error ("HI command (command ID: '%s') not handled.", SDATA (command_id
));
4888 #endif /* TARGET_API_MAC_CARBON */
4892 mac_get_system_locale ()
4900 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4901 region
= GetScriptManagerVariable (smRegionCode
);
4902 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4904 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4907 return build_string (str
);
4915 extern int inhibit_window_system
;
4916 extern int noninteractive
;
4918 /* Unlike in X11, window events in Carbon do not come from sockets.
4919 So we cannot simply use `select' to monitor two kinds of inputs:
4920 window events and process outputs. We emulate such functionality
4921 by regarding fd 0 as the window event channel and simultaneously
4922 monitoring both kinds of input channels. It is implemented by
4923 dividing into some cases:
4924 1. The window event channel is not involved.
4926 2. Sockets are not involved.
4927 -> Use ReceiveNextEvent.
4928 3. [If SELECT_USE_CFSOCKET is set]
4929 Only the window event channel and socket read/write channels are
4930 involved, and timeout is not too short (greater than
4931 SELECT_TIMEOUT_THRESHOLD_RUNLOOP seconds).
4932 -> Create CFSocket for each socket and add it into the current
4933 event RunLoop so that the current event loop gets quit when
4934 the socket becomes ready. Then mac_run_loop_run_once can
4935 wait for both kinds of inputs.
4937 -> Periodically poll the window input channel while repeatedly
4938 executing `select' with a short timeout
4939 (SELECT_POLLING_PERIOD_USEC microseconds). */
4941 #ifndef SELECT_USE_CFSOCKET
4942 #define SELECT_USE_CFSOCKET 1
4945 #define SELECT_POLLING_PERIOD_USEC 100000
4946 #if SELECT_USE_CFSOCKET
4947 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4949 /* Dictionary of file descriptors vs CFSocketRef's allocated in
4951 static CFMutableDictionaryRef cfsockets_for_select
;
4953 /* Process ID of Emacs. */
4954 static pid_t mac_emacs_pid
;
4957 socket_callback (s
, type
, address
, data
, info
)
4959 CFSocketCallBackType type
;
4965 #endif /* SELECT_USE_CFSOCKET */
4968 select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
)
4970 SELECT_TYPE
*rfds
, *wfds
, *efds
;
4971 EMACS_TIME
*timeout
;
4975 EMACS_TIME select_timeout
;
4976 EventTimeout timeoutval
=
4978 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
4979 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
4980 : kEventDurationForever
);
4981 SELECT_TYPE orfds
, owfds
, oefds
;
4983 if (timeout
== NULL
)
4985 if (rfds
) orfds
= *rfds
;
4986 if (wfds
) owfds
= *wfds
;
4987 if (efds
) oefds
= *efds
;
4990 /* Try detect_input_pending before mac_run_loop_run_once in the same
4991 BLOCK_INPUT block, in case that some input has already been read
4996 if (detect_input_pending ())
4999 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5000 r
= select (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5004 if (timeoutval
== 0.0)
5007 timedout_p
= mac_run_loop_run_once (timeoutval
);
5009 if (timeout
== NULL
&& timedout_p
)
5011 if (rfds
) *rfds
= orfds
;
5012 if (wfds
) *wfds
= owfds
;
5013 if (efds
) *efds
= oefds
;
5022 else if (!timedout_p
)
5024 /* Pretend that `select' is interrupted by a signal. */
5025 detect_input_pending ();
5033 /* Clean up the CFSocket associated with the file descriptor FD in
5034 case the same descriptor is used in other threads later. If no
5035 CFSocket is associated with FD, then return 0 without closing FD.
5036 Otherwise, return 1 with closing FD. */
5039 mac_try_close_socket (fd
)
5042 #if SELECT_USE_CFSOCKET
5043 if (getpid () == mac_emacs_pid
&& cfsockets_for_select
)
5045 void *key
= (void *) fd
;
5046 CFSocketRef socket
=
5047 (CFSocketRef
) CFDictionaryGetValue (cfsockets_for_select
, key
);
5051 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
5052 CFOptionFlags flags
= CFSocketGetSocketFlags (socket
);
5054 if (!(flags
& kCFSocketCloseOnInvalidate
))
5055 CFSocketSetSocketFlags (socket
, flags
| kCFSocketCloseOnInvalidate
);
5058 CFSocketInvalidate (socket
);
5059 CFDictionaryRemoveValue (cfsockets_for_select
, key
);
5071 sys_select (nfds
, rfds
, wfds
, efds
, timeout
)
5073 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5074 EMACS_TIME
*timeout
;
5078 EMACS_TIME select_timeout
;
5079 SELECT_TYPE orfds
, owfds
, oefds
;
5081 if (inhibit_window_system
|| noninteractive
5082 || nfds
< 1 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
5083 return select (nfds
, rfds
, wfds
, efds
, timeout
);
5097 EventTimeout timeoutval
=
5099 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5100 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5101 : kEventDurationForever
);
5103 FD_SET (0, rfds
); /* sentinel */
5108 while (!(FD_ISSET (nfds
, rfds
) || (wfds
&& FD_ISSET (nfds
, wfds
))));
5113 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
);
5115 /* Avoid initial overhead of RunLoop setup for the case that
5116 some input is already available. */
5117 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5118 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5119 if (r
!= 0 || timeoutval
== 0.0)
5126 #if SELECT_USE_CFSOCKET
5127 if (timeoutval
> 0 && timeoutval
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
5128 goto poll_periodically
;
5130 /* Try detect_input_pending before mac_run_loop_run_once in the
5131 same BLOCK_INPUT block, in case that some input has already
5132 been read asynchronously. */
5134 if (!detect_input_pending ())
5137 CFRunLoopRef runloop
=
5138 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5139 static CFMutableDictionaryRef sources
;
5141 if (sources
== NULL
)
5143 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5144 &kCFTypeDictionaryValueCallBacks
);
5146 if (cfsockets_for_select
== NULL
)
5147 cfsockets_for_select
=
5148 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5149 &kCFTypeDictionaryValueCallBacks
);
5151 for (minfd
= 1; ; minfd
++) /* nfds-1 works as a sentinel. */
5152 if (FD_ISSET (minfd
, rfds
) || (wfds
&& FD_ISSET (minfd
, wfds
)))
5155 for (fd
= minfd
; fd
< nfds
; fd
++)
5156 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5158 void *key
= (void *) fd
;
5159 CFRunLoopSourceRef source
=
5160 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5162 if (source
== NULL
|| !CFRunLoopSourceIsValid (source
))
5164 CFSocketRef socket
=
5165 CFSocketCreateWithNative (NULL
, fd
,
5166 (kCFSocketReadCallBack
5167 | kCFSocketConnectCallBack
),
5168 socket_callback
, NULL
);
5172 CFDictionarySetValue (cfsockets_for_select
, key
, socket
);
5173 source
= CFSocketCreateRunLoopSource (NULL
, socket
, 0);
5177 CFDictionarySetValue (sources
, key
, source
);
5180 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
5183 timedout_p
= mac_run_loop_run_once (timeoutval
);
5185 for (fd
= minfd
; fd
< nfds
; fd
++)
5186 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5188 void *key
= (void *) fd
;
5189 CFRunLoopSourceRef source
=
5190 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5192 CFRunLoopRemoveSource (runloop
, source
, kCFRunLoopDefaultMode
);
5199 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5200 return select_and_poll_event (nfds
, rfds
, wfds
, efds
,
5210 #endif /* SELECT_USE_CFSOCKET */
5215 EMACS_TIME end_time
, now
, remaining_time
;
5219 remaining_time
= *timeout
;
5220 EMACS_GET_TIME (now
);
5221 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5226 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5227 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5228 select_timeout
= remaining_time
;
5229 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5241 EMACS_GET_TIME (now
);
5242 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5245 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5247 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5248 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5252 /* Set up environment variables so that Emacs can correctly find its
5253 support files when packaged as an application bundle. Directories
5254 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5255 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5256 by `make install' by default can instead be placed in
5257 .../Emacs.app/Contents/Resources/ and
5258 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5259 is changed only if it is not already set. Presumably if the user
5260 sets an environment variable, he will want to use files in his path
5261 instead of ones in the application bundle. */
5263 init_mac_osx_environment ()
5267 CFStringRef cf_app_bundle_pathname
;
5268 int app_bundle_pathname_len
;
5269 char *app_bundle_pathname
;
5273 mac_emacs_pid
= getpid ();
5275 /* Initialize locale related variables. */
5276 mac_system_script_code
=
5277 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5278 Vmac_system_locale
= mac_get_system_locale ();
5280 /* Fetch the pathname of the application bundle as a C string into
5281 app_bundle_pathname. */
5283 bundle
= CFBundleGetMainBundle ();
5284 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5286 /* We could not find the bundle identifier. For now, prevent
5287 the fatal error by bringing it up in the terminal. */
5288 inhibit_window_system
= 1;
5292 bundleURL
= CFBundleCopyBundleURL (bundle
);
5296 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5297 kCFURLPOSIXPathStyle
);
5298 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5299 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5301 if (!CFStringGetCString (cf_app_bundle_pathname
,
5302 app_bundle_pathname
,
5303 app_bundle_pathname_len
+ 1,
5304 kCFStringEncodingISOLatin1
))
5306 CFRelease (cf_app_bundle_pathname
);
5310 CFRelease (cf_app_bundle_pathname
);
5312 /* P should have sufficient room for the pathname of the bundle plus
5313 the subpath in it leading to the respective directories. Q
5314 should have three times that much room because EMACSLOADPATH can
5315 have the value "<path to site-lisp dir>:<path to lisp dir>:<path
5317 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5318 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5319 if (!getenv ("EMACSLOADPATH"))
5323 strcpy (p
, app_bundle_pathname
);
5324 strcat (p
, "/Contents/Resources/site-lisp");
5325 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5328 strcpy (p
, app_bundle_pathname
);
5329 strcat (p
, "/Contents/Resources/lisp");
5330 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5337 strcpy (p
, app_bundle_pathname
);
5338 strcat (p
, "/Contents/Resources/leim");
5339 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5347 setenv ("EMACSLOADPATH", q
, 1);
5350 if (!getenv ("EMACSPATH"))
5354 strcpy (p
, app_bundle_pathname
);
5355 strcat (p
, "/Contents/MacOS/libexec");
5356 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5359 strcpy (p
, app_bundle_pathname
);
5360 strcat (p
, "/Contents/MacOS/bin");
5361 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5369 setenv ("EMACSPATH", q
, 1);
5372 if (!getenv ("EMACSDATA"))
5374 strcpy (p
, app_bundle_pathname
);
5375 strcat (p
, "/Contents/Resources/etc");
5376 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5377 setenv ("EMACSDATA", p
, 1);
5380 if (!getenv ("EMACSDOC"))
5382 strcpy (p
, app_bundle_pathname
);
5383 strcat (p
, "/Contents/Resources/etc");
5384 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5385 setenv ("EMACSDOC", p
, 1);
5388 if (!getenv ("INFOPATH"))
5390 strcpy (p
, app_bundle_pathname
);
5391 strcat (p
, "/Contents/Resources/info");
5392 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5393 setenv ("INFOPATH", p
, 1);
5396 #endif /* MAC_OSX */
5398 #if TARGET_API_MAC_CARBON
5400 mac_wakeup_from_rne ()
5403 if (wakeup_from_rne_enabled_p
)
5404 /* Post a harmless event so as to wake up from
5405 ReceiveNextEvent. */
5406 mac_post_mouse_moved_event ();
5414 Qundecoded_file_name
= intern ("undecoded-file-name");
5415 staticpro (&Qundecoded_file_name
);
5417 #if TARGET_API_MAC_CARBON
5418 Qstring
= intern ("string"); staticpro (&Qstring
);
5419 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5420 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5421 Qdate
= intern ("date"); staticpro (&Qdate
);
5422 Qdata
= intern ("data"); staticpro (&Qdata
);
5423 Qarray
= intern ("array"); staticpro (&Qarray
);
5424 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5426 Qxml
= intern ("xml");
5429 Qmime_charset
= intern ("mime-charset");
5430 staticpro (&Qmime_charset
);
5432 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5433 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5434 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5435 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5436 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5437 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5443 for (i
= 0; i
< sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]); i
++)
5445 ae_attr_table
[i
].symbol
= intern (ae_attr_table
[i
].name
);
5446 staticpro (&ae_attr_table
[i
].symbol
);
5450 defsubr (&Smac_coerce_ae_data
);
5451 #if TARGET_API_MAC_CARBON
5452 defsubr (&Smac_get_preference
);
5453 defsubr (&Smac_code_convert_string
);
5454 defsubr (&Smac_process_hi_command
);
5457 defsubr (&Smac_set_file_creator
);
5458 defsubr (&Smac_set_file_type
);
5459 defsubr (&Smac_get_file_creator
);
5460 defsubr (&Smac_get_file_type
);
5461 defsubr (&Sdo_applescript
);
5462 defsubr (&Smac_file_name_to_posix
);
5463 defsubr (&Sposix_file_name_to_mac
);
5465 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5466 doc
: /* The system script code. */);
5467 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5469 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5470 doc
: /* The system locale identifier string.
5471 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5472 information is not included. */);
5473 Vmac_system_locale
= mac_get_system_locale ();
5476 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5477 (do not change this comment) */