1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
35 #include "sysselect.h"
36 #include "blockinput.h"
42 #if !TARGET_API_MAC_CARBON
45 #include <TextUtils.h>
47 #include <Resources.h>
51 #include <AppleScript.h>
53 #include <Processes.h>
55 #include <MacLocales.h>
57 #endif /* not TARGET_API_MAC_CARBON */
61 #include <sys/types.h>
65 #include <sys/param.h>
71 /* The system script code. */
72 static int mac_system_script_code
;
74 /* The system locale identifier string. */
75 static Lisp_Object Vmac_system_locale
;
77 /* An instance of the AppleScript component. */
78 static ComponentInstance as_scripting_component
;
79 /* The single script context used for all script executions. */
80 static OSAID as_script_context
;
83 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
84 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
87 /* When converting from Mac to Unix pathnames, /'s in folder names are
88 converted to :'s. This function, used in copying folder names,
89 performs a strncat and converts all character a to b in the copy of
90 the string s2 appended to the end of s1. */
93 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
101 for (i
= 0; i
< l2
; i
++)
110 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
111 that does not begin with a ':' and contains at least one ':'. A Mac
112 full pathname causes a '/' to be prepended to the Posix pathname.
113 The algorithm for the rest of the pathname is as follows:
114 For each segment between two ':',
115 if it is non-null, copy as is and then add a '/' at the end,
116 otherwise, insert a "../" into the Posix pathname.
117 Returns 1 if successful; 0 if fails. */
120 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
122 const char *p
, *q
, *pe
;
129 p
= strchr (mfn
, ':');
130 if (p
!= 0 && p
!= mfn
) /* full pathname */
137 pe
= mfn
+ strlen (mfn
);
144 { /* two consecutive ':' */
145 if (strlen (ufn
) + 3 >= ufnbuflen
)
151 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
153 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
160 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
162 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
163 /* no separator for last one */
172 extern char *get_temp_dir_name ();
175 /* Convert a Posix pathname to Mac form. Approximately reverse of the
176 above in algorithm. */
179 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
181 const char *p
, *q
, *pe
;
182 char expanded_pathname
[MAXPATHLEN
+1];
191 /* Check for and handle volume names. Last comparison: strangely
192 somewhere "/.emacs" is passed. A temporary fix for now. */
193 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
195 if (strlen (p
) + 1 > mfnbuflen
)
202 /* expand to emacs dir found by init_emacs_passwd_dir */
203 if (strncmp (p
, "~emacs/", 7) == 0)
205 struct passwd
*pw
= getpwnam ("emacs");
207 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
209 strcpy (expanded_pathname
, pw
->pw_dir
);
210 strcat (expanded_pathname
, p
);
211 p
= expanded_pathname
;
212 /* now p points to the pathname with emacs dir prefix */
214 else if (strncmp (p
, "/tmp/", 5) == 0)
216 char *t
= get_temp_dir_name ();
218 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
220 strcpy (expanded_pathname
, t
);
221 strcat (expanded_pathname
, p
);
222 p
= expanded_pathname
;
223 /* now p points to the pathname with emacs dir prefix */
225 else if (*p
!= '/') /* relative pathname */
237 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
239 if (strlen (mfn
) + 1 >= mfnbuflen
)
245 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
247 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
254 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
256 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
265 /***********************************************************************
266 Conversions on Apple event objects
267 ***********************************************************************/
269 static Lisp_Object Qundecoded_file_name
;
276 {{keyTransactionIDAttr
, "transaction-id"},
277 {keyReturnIDAttr
, "return-id"},
278 {keyEventClassAttr
, "event-class"},
279 {keyEventIDAttr
, "event-id"},
280 {keyAddressAttr
, "address"},
281 {keyOptionalKeywordAttr
, "optional-keyword"},
282 {keyTimeoutAttr
, "timeout"},
283 {keyInteractLevelAttr
, "interact-level"},
284 {keyEventSourceAttr
, "event-source"},
285 /* {keyMissedKeywordAttr, "missed-keyword"}, */
286 {keyOriginalAddressAttr
, "original-address"},
287 {keyReplyRequestedAttr
, "reply-requested"},
288 {KEY_EMACS_SUSPENSION_ID_ATTR
, "emacs-suspension-id"}
292 mac_aelist_to_lisp (desc_list
)
293 const AEDescList
*desc_list
;
297 Lisp_Object result
, elem
;
304 err
= AECountItems (desc_list
, &count
);
314 keyword
= ae_attr_table
[count
- 1].keyword
;
315 err
= AESizeOfAttribute (desc_list
, keyword
, &desc_type
, &size
);
318 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
327 err
= AEGetAttributeDesc (desc_list
, keyword
, typeWildCard
,
330 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
334 elem
= mac_aelist_to_lisp (&desc
);
335 AEDisposeDesc (&desc
);
339 if (desc_type
== typeNull
)
343 elem
= make_uninit_string (size
);
345 err
= AEGetAttributePtr (desc_list
, keyword
, typeWildCard
,
346 &desc_type
, SDATA (elem
),
349 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
350 &desc_type
, SDATA (elem
), size
, &size
);
354 desc_type
= EndianU32_NtoB (desc_type
);
355 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
359 if (err
== noErr
|| desc_list
->descriptorType
== typeAEList
)
362 elem
= Qnil
; /* Don't skip elements in AEList. */
363 else if (desc_list
->descriptorType
!= typeAEList
)
366 elem
= Fcons (ae_attr_table
[count
-1].symbol
, elem
);
369 keyword
= EndianU32_NtoB (keyword
);
370 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4),
375 result
= Fcons (elem
, result
);
381 if (desc_list
->descriptorType
== typeAppleEvent
&& !attribute_p
)
384 count
= sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]);
388 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
389 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
393 mac_aedesc_to_lisp (desc
)
397 DescType desc_type
= desc
->descriptorType
;
409 return mac_aelist_to_lisp (desc
);
411 /* The following one is much simpler, but creates and disposes
412 of Apple event descriptors many times. */
419 err
= AECountItems (desc
, &count
);
425 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
428 elem
= mac_aedesc_to_lisp (&desc1
);
429 AEDisposeDesc (&desc1
);
430 if (desc_type
!= typeAEList
)
432 keyword
= EndianU32_NtoB (keyword
);
433 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
435 result
= Fcons (elem
, result
);
443 #if TARGET_API_MAC_CARBON
444 result
= make_uninit_string (AEGetDescDataSize (desc
));
445 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
447 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
448 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
456 desc_type
= EndianU32_NtoB (desc_type
);
457 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
461 mac_ae_put_lisp (desc
, keyword_or_index
, obj
)
463 UInt32 keyword_or_index
;
468 if (!(desc
->descriptorType
== typeAppleEvent
469 || desc
->descriptorType
== typeAERecord
470 || desc
->descriptorType
== typeAEList
))
471 return errAEWrongDataType
;
473 if (CONSP (obj
) && STRINGP (XCAR (obj
)) && SBYTES (XCAR (obj
)) == 4)
475 DescType desc_type1
= EndianU32_BtoN (*((UInt32
*) SDATA (XCAR (obj
))));
476 Lisp_Object data
= XCDR (obj
), rest
;
487 err
= AECreateList (NULL
, 0, desc_type1
== typeAERecord
, &desc1
);
490 for (rest
= data
; CONSP (rest
); rest
= XCDR (rest
))
492 UInt32 keyword_or_index1
= 0;
493 Lisp_Object elem
= XCAR (rest
);
495 if (desc_type1
== typeAERecord
)
497 if (CONSP (elem
) && STRINGP (XCAR (elem
))
498 && SBYTES (XCAR (elem
)) == 4)
501 EndianU32_BtoN (*((UInt32
*)
502 SDATA (XCAR (elem
))));
509 err
= mac_ae_put_lisp (&desc1
, keyword_or_index1
, elem
);
516 if (desc
->descriptorType
== typeAEList
)
517 err
= AEPutDesc (desc
, keyword_or_index
, &desc1
);
519 err
= AEPutParamDesc (desc
, keyword_or_index
, &desc1
);
522 AEDisposeDesc (&desc1
);
529 if (desc
->descriptorType
== typeAEList
)
530 err
= AEPutPtr (desc
, keyword_or_index
, desc_type1
,
531 SDATA (data
), SBYTES (data
));
533 err
= AEPutParamPtr (desc
, keyword_or_index
, desc_type1
,
534 SDATA (data
), SBYTES (data
));
539 if (desc
->descriptorType
== typeAEList
)
540 err
= AEPutPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
542 err
= AEPutParamPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
548 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
549 to_type
, handler_refcon
, result
)
551 const void *data_ptr
;
559 if (type_code
== typeNull
)
560 err
= errAECoercionFail
;
561 else if (type_code
== to_type
|| to_type
== typeWildCard
)
562 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
563 else if (type_code
== TYPE_FILE_NAME
)
564 /* Coercion from undecoded file name. */
569 CFDataRef data
= NULL
;
571 str
= CFStringCreateWithBytes (NULL
, data_ptr
, data_size
,
572 kCFStringEncodingUTF8
, false);
575 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
576 kCFURLPOSIXPathStyle
, false);
581 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
586 err
= AECoercePtr (typeFileURL
, CFDataGetBytePtr (data
),
587 CFDataGetLength (data
), to_type
, result
);
595 /* Just to be paranoid ... */
599 buf
= xmalloc (data_size
+ 1);
600 memcpy (buf
, data_ptr
, data_size
);
601 buf
[data_size
] = '\0';
602 err
= FSPathMakeRef (buf
, &fref
, NULL
);
605 err
= AECoercePtr (typeFSRef
, &fref
, sizeof (FSRef
),
612 buf
= xmalloc (data_size
+ 1);
613 memcpy (buf
, data_ptr
, data_size
);
614 buf
[data_size
] = '\0';
615 err
= posix_pathname_to_fsspec (buf
, &fs
);
618 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
621 else if (to_type
== TYPE_FILE_NAME
)
622 /* Coercion to undecoded file name. */
626 CFStringRef str
= NULL
;
627 CFDataRef data
= NULL
;
629 if (type_code
== typeFileURL
)
630 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
631 kCFStringEncodingUTF8
, NULL
);
638 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
642 size
= AEGetDescDataSize (&desc
);
643 buf
= xmalloc (size
);
644 err
= AEGetDescData (&desc
, buf
, size
);
646 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
647 kCFStringEncodingUTF8
, NULL
);
649 AEDisposeDesc (&desc
);
654 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
659 data
= CFStringCreateExternalRepresentation (NULL
, str
,
660 kCFStringEncodingUTF8
,
666 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
667 CFDataGetLength (data
), result
);
673 /* Coercion from typeAlias to typeFileURL fails on Mac OS X
674 10.2. In such cases, try typeFSRef as a target type. */
675 char file_name
[MAXPATHLEN
];
677 if (type_code
== typeFSRef
&& data_size
== sizeof (FSRef
))
678 err
= FSRefMakePath (data_ptr
, file_name
, sizeof (file_name
));
684 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
688 err
= AEGetDescData (&desc
, &fref
, sizeof (FSRef
));
689 AEDisposeDesc (&desc
);
692 err
= FSRefMakePath (&fref
, file_name
, sizeof (file_name
));
695 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
696 strlen (file_name
), result
);
699 char file_name
[MAXPATHLEN
];
701 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
702 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
703 sizeof (file_name
) - 1);
709 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
712 #if TARGET_API_MAC_CARBON
713 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
715 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
717 AEDisposeDesc (&desc
);
720 err
= fsspec_to_posix_pathname (&fs
, file_name
,
721 sizeof (file_name
) - 1);
724 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
725 strlen (file_name
), result
);
732 return errAECoercionFail
;
737 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
738 const AEDesc
*from_desc
;
744 DescType from_type
= from_desc
->descriptorType
;
746 if (from_type
== typeNull
)
747 err
= errAECoercionFail
;
748 else if (from_type
== to_type
|| to_type
== typeWildCard
)
749 err
= AEDuplicateDesc (from_desc
, result
);
755 #if TARGET_API_MAC_CARBON
756 data_size
= AEGetDescDataSize (from_desc
);
758 data_size
= GetHandleSize (from_desc
->dataHandle
);
760 data_ptr
= xmalloc (data_size
);
761 #if TARGET_API_MAC_CARBON
762 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
764 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
767 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
769 handler_refcon
, result
);
774 return errAECoercionFail
;
779 init_coercion_handler ()
783 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
784 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
786 if (coerce_file_name_ptrUPP
== NULL
)
788 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
789 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
792 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
793 (AECoercionHandlerUPP
)
794 coerce_file_name_ptrUPP
, 0, false, false);
796 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
797 (AECoercionHandlerUPP
)
798 coerce_file_name_ptrUPP
, 0, false, false);
800 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
801 coerce_file_name_descUPP
, 0, true, false);
803 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
804 coerce_file_name_descUPP
, 0, true, false);
808 #if TARGET_API_MAC_CARBON
810 create_apple_event (class, id
, result
)
816 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
817 AEAddressDesc address_desc
;
819 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
820 sizeof (ProcessSerialNumber
), &address_desc
);
823 err
= AECreateAppleEvent (class, id
,
824 &address_desc
, /* NULL is not allowed
825 on Mac OS Classic. */
826 kAutoGenerateReturnID
,
827 kAnyTransactionID
, result
);
828 AEDisposeDesc (&address_desc
);
835 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
838 const EventParamName
*names
;
839 const EventParamType
*types
;
848 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
852 for (i
= 0; i
< num_params
; i
++)
856 case typeCFStringRef
:
857 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
858 sizeof (CFStringRef
), NULL
, &string
);
861 data
= CFStringCreateExternalRepresentation (NULL
, string
,
862 kCFStringEncodingUTF8
,
866 AEPutParamPtr (result
, names
[i
], typeUTF8Text
,
867 CFDataGetBytePtr (data
), CFDataGetLength (data
));
873 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
877 buf
= xrealloc (buf
, size
);
878 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
881 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
891 create_apple_event_from_drag_ref (drag
, num_types
, types
, result
)
894 const FlavorType
*types
;
903 err
= CountDragItems (drag
, &num_items
);
906 err
= AECreateList (NULL
, 0, false, &items
);
910 for (index
= 1; index
<= num_items
; index
++)
913 DescType desc_type
= typeNull
;
916 err
= GetDragItemReferenceNumber (drag
, index
, &item
);
921 for (i
= 0; i
< num_types
; i
++)
923 err
= GetFlavorDataSize (drag
, item
, types
[i
], &size
);
926 buf
= xrealloc (buf
, size
);
927 err
= GetFlavorData (drag
, item
, types
[i
], buf
, &size
, 0);
931 desc_type
= types
[i
];
936 err
= AEPutPtr (&items
, index
, desc_type
,
937 desc_type
!= typeNull
? buf
: NULL
,
938 desc_type
!= typeNull
? size
: 0);
947 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
949 err
= AEPutParamDesc (result
, keyDirectObject
, &items
);
951 AEDisposeDesc (result
);
954 AEDisposeDesc (&items
);
958 #endif /* TARGET_API_MAC_CARBON */
960 /***********************************************************************
961 Conversion between Lisp and Core Foundation objects
962 ***********************************************************************/
964 #if TARGET_API_MAC_CARBON
965 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
966 static Lisp_Object Qarray
, Qdictionary
;
968 struct cfdict_context
971 int with_tag
, hash_bound
;
974 /* C string to CFString. */
977 cfstring_create_with_utf8_cstring (c_str
)
982 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
984 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
985 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
991 /* Lisp string to CFString. */
994 cfstring_create_with_string (s
)
997 CFStringRef string
= NULL
;
999 if (STRING_MULTIBYTE (s
))
1001 char *p
, *end
= SDATA (s
) + SBYTES (s
);
1003 for (p
= SDATA (s
); p
< end
; p
++)
1006 s
= ENCODE_UTF_8 (s
);
1009 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
1010 kCFStringEncodingUTF8
, false);
1014 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
1015 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
1016 kCFStringEncodingMacRoman
, false);
1022 /* From CFData to a lisp string. Always returns a unibyte string. */
1025 cfdata_to_lisp (data
)
1028 CFIndex len
= CFDataGetLength (data
);
1029 Lisp_Object result
= make_uninit_string (len
);
1031 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
1037 /* From CFString to a lisp string. Returns a unibyte string
1038 containing a UTF-8 byte sequence. */
1041 cfstring_to_lisp_nodecode (string
)
1044 Lisp_Object result
= Qnil
;
1045 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
1048 result
= make_unibyte_string (s
, strlen (s
));
1052 CFStringCreateExternalRepresentation (NULL
, string
,
1053 kCFStringEncodingUTF8
, '?');
1057 result
= cfdata_to_lisp (data
);
1066 /* From CFString to a lisp string. Never returns a unibyte string
1067 (even if it only contains ASCII characters).
1068 This may cause GC during code conversion. */
1071 cfstring_to_lisp (string
)
1074 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
1078 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
1079 /* This may be superfluous. Just to make sure that the result
1080 is a multibyte string. */
1081 result
= string_to_multibyte (result
);
1088 /* CFNumber to a lisp integer or a lisp float. */
1091 cfnumber_to_lisp (number
)
1094 Lisp_Object result
= Qnil
;
1095 #if BITS_PER_EMACS_INT > 32
1097 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
1100 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
1104 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
1105 && !FIXNUM_OVERFLOW_P (int_val
))
1106 result
= make_number (int_val
);
1108 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
1109 result
= make_float (float_val
);
1114 /* CFDate to a list of three integers as in a return value of
1118 cfdate_to_lisp (date
)
1121 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
1122 static CFAbsoluteTime epoch
= 0.0, sec
;
1126 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
1128 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
1129 high
= sec
/ 65536.0;
1130 low
= sec
- high
* 65536.0;
1132 return list3 (make_number (high
), make_number (low
), make_number (0));
1136 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1139 cfboolean_to_lisp (boolean
)
1140 CFBooleanRef boolean
;
1142 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
1146 /* Any Core Foundation object to a (lengthy) lisp string. */
1149 cfobject_desc_to_lisp (object
)
1152 Lisp_Object result
= Qnil
;
1153 CFStringRef desc
= CFCopyDescription (object
);
1157 result
= cfstring_to_lisp (desc
);
1165 /* Callback functions for cfproperty_list_to_lisp. */
1168 cfdictionary_add_to_list (key
, value
, context
)
1173 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1176 Fcons (Fcons (cfstring_to_lisp (key
),
1177 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
1183 cfdictionary_puthash (key
, value
, context
)
1188 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
1189 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1190 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
1193 hash_lookup (h
, lisp_key
, &hash_code
);
1194 hash_put (h
, lisp_key
,
1195 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
1200 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1201 non-zero, a symbol that represents the type of the original Core
1202 Foundation object is prepended. HASH_BOUND specifies which kinds
1203 of the lisp objects, alists or hash tables, are used as the targets
1204 of the conversion from CFDictionary. If HASH_BOUND is negative,
1205 always generate alists. If HASH_BOUND >= 0, generate an alist if
1206 the number of keys in the dictionary is smaller than HASH_BOUND,
1207 and a hash table otherwise. */
1210 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
1211 CFPropertyListRef plist
;
1212 int with_tag
, hash_bound
;
1214 CFTypeID type_id
= CFGetTypeID (plist
);
1215 Lisp_Object tag
= Qnil
, result
= Qnil
;
1216 struct gcpro gcpro1
, gcpro2
;
1218 GCPRO2 (tag
, result
);
1220 if (type_id
== CFStringGetTypeID ())
1223 result
= cfstring_to_lisp (plist
);
1225 else if (type_id
== CFNumberGetTypeID ())
1228 result
= cfnumber_to_lisp (plist
);
1230 else if (type_id
== CFBooleanGetTypeID ())
1233 result
= cfboolean_to_lisp (plist
);
1235 else if (type_id
== CFDateGetTypeID ())
1238 result
= cfdate_to_lisp (plist
);
1240 else if (type_id
== CFDataGetTypeID ())
1243 result
= cfdata_to_lisp (plist
);
1245 else if (type_id
== CFArrayGetTypeID ())
1247 CFIndex index
, count
= CFArrayGetCount (plist
);
1250 result
= Fmake_vector (make_number (count
), Qnil
);
1251 for (index
= 0; index
< count
; index
++)
1252 XVECTOR (result
)->contents
[index
] =
1253 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1254 with_tag
, hash_bound
);
1256 else if (type_id
== CFDictionaryGetTypeID ())
1258 struct cfdict_context context
;
1259 CFIndex count
= CFDictionaryGetCount (plist
);
1262 context
.result
= &result
;
1263 context
.with_tag
= with_tag
;
1264 context
.hash_bound
= hash_bound
;
1265 if (hash_bound
< 0 || count
< hash_bound
)
1268 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1273 result
= make_hash_table (Qequal
,
1274 make_number (count
),
1275 make_float (DEFAULT_REHASH_SIZE
),
1276 make_float (DEFAULT_REHASH_THRESHOLD
),
1278 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1288 result
= Fcons (tag
, result
);
1295 /***********************************************************************
1296 Emulation of the X Resource Manager
1297 ***********************************************************************/
1299 /* Parser functions for resource lines. Each function takes an
1300 address of a variable whose value points to the head of a string.
1301 The value will be advanced so that it points to the next character
1302 of the parsed part when the function returns.
1304 A resource name such as "Emacs*font" is parsed into a non-empty
1305 list called `quarks'. Each element is either a Lisp string that
1306 represents a concrete component, a Lisp symbol LOOSE_BINDING
1307 (actually Qlambda) that represents any number (>=0) of intervening
1308 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1309 that represents as any single component. */
1313 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1314 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1317 skip_white_space (p
)
1320 /* WhiteSpace = {<space> | <horizontal tab>} */
1321 while (*P
== ' ' || *P
== '\t')
1329 /* Comment = "!" {<any character except null or newline>} */
1342 /* Don't interpret filename. Just skip until the newline. */
1344 parse_include_file (p
)
1347 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1364 /* Binding = "." | "*" */
1365 if (*P
== '.' || *P
== '*')
1367 char binding
= *P
++;
1369 while (*P
== '.' || *P
== '*')
1382 /* Component = "?" | ComponentName
1383 ComponentName = NameChar {NameChar}
1384 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1388 return SINGLE_COMPONENT
;
1390 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1392 const char *start
= P
++;
1394 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1397 return make_unibyte_string (start
, P
- start
);
1404 parse_resource_name (p
)
1407 Lisp_Object result
= Qnil
, component
;
1410 /* ResourceName = [Binding] {Component Binding} ComponentName */
1411 if (parse_binding (p
) == '*')
1412 result
= Fcons (LOOSE_BINDING
, result
);
1414 component
= parse_component (p
);
1415 if (NILP (component
))
1418 result
= Fcons (component
, result
);
1419 while ((binding
= parse_binding (p
)) != '\0')
1422 result
= Fcons (LOOSE_BINDING
, result
);
1423 component
= parse_component (p
);
1424 if (NILP (component
))
1427 result
= Fcons (component
, result
);
1430 /* The final component should not be '?'. */
1431 if (EQ (component
, SINGLE_COMPONENT
))
1434 return Fnreverse (result
);
1442 Lisp_Object seq
= Qnil
, result
;
1443 int buf_len
, total_len
= 0, len
, continue_p
;
1445 q
= strchr (P
, '\n');
1446 buf_len
= q
? q
- P
: strlen (P
);
1447 buf
= xmalloc (buf_len
);
1460 else if (*P
== '\\')
1465 else if (*P
== '\n')
1476 else if ('0' <= P
[0] && P
[0] <= '7'
1477 && '0' <= P
[1] && P
[1] <= '7'
1478 && '0' <= P
[2] && P
[2] <= '7')
1480 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1490 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1495 q
= strchr (P
, '\n');
1496 len
= q
? q
- P
: strlen (P
);
1501 buf
= xmalloc (buf_len
);
1509 if (SBYTES (XCAR (seq
)) == total_len
)
1510 return make_string (SDATA (XCAR (seq
)), total_len
);
1513 buf
= xmalloc (total_len
);
1514 q
= buf
+ total_len
;
1515 for (; CONSP (seq
); seq
= XCDR (seq
))
1517 len
= SBYTES (XCAR (seq
));
1519 memcpy (q
, SDATA (XCAR (seq
)), len
);
1521 result
= make_string (buf
, total_len
);
1528 parse_resource_line (p
)
1531 Lisp_Object quarks
, value
;
1533 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1534 if (parse_comment (p
) || parse_include_file (p
))
1537 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1538 skip_white_space (p
);
1539 quarks
= parse_resource_name (p
);
1542 skip_white_space (p
);
1546 skip_white_space (p
);
1547 value
= parse_value (p
);
1548 return Fcons (quarks
, value
);
1551 /* Skip the remaining data as a dummy value. */
1558 /* Equivalents of X Resource Manager functions.
1560 An X Resource Database acts as a collection of resource names and
1561 associated values. It is implemented as a trie on quarks. Namely,
1562 each edge is labeled by either a string, LOOSE_BINDING, or
1563 SINGLE_COMPONENT. Each node has a node id, which is a unique
1564 nonnegative integer, and the root node id is 0. A database is
1565 implemented as a hash table that maps a pair (SRC-NODE-ID .
1566 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1567 in the table as a value for HASHKEY_MAX_NID. A value associated to
1568 a node is recorded as a value for the node id.
1570 A database also has a cache for past queries as a value for
1571 HASHKEY_QUERY_CACHE. It is another hash table that maps
1572 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1574 #define HASHKEY_MAX_NID (make_number (0))
1575 #define HASHKEY_QUERY_CACHE (make_number (-1))
1578 xrm_create_database ()
1580 XrmDatabase database
;
1582 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1583 make_float (DEFAULT_REHASH_SIZE
),
1584 make_float (DEFAULT_REHASH_THRESHOLD
),
1586 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1587 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1593 xrm_q_put_resource (database
, quarks
, value
)
1594 XrmDatabase database
;
1595 Lisp_Object quarks
, value
;
1597 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1600 Lisp_Object node_id
, key
;
1602 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1604 XSETINT (node_id
, 0);
1605 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1607 key
= Fcons (node_id
, XCAR (quarks
));
1608 i
= hash_lookup (h
, key
, &hash_code
);
1612 XSETINT (node_id
, max_nid
);
1613 hash_put (h
, key
, node_id
, hash_code
);
1616 node_id
= HASH_VALUE (h
, i
);
1618 Fputhash (node_id
, value
, database
);
1620 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1621 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1624 /* Merge multiple resource entries specified by DATA into a resource
1625 database DATABASE. DATA points to the head of a null-terminated
1626 string consisting of multiple resource lines. It's like a
1627 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1630 xrm_merge_string_database (database
, data
)
1631 XrmDatabase database
;
1634 Lisp_Object quarks_value
;
1638 quarks_value
= parse_resource_line (&data
);
1639 if (!NILP (quarks_value
))
1640 xrm_q_put_resource (database
,
1641 XCAR (quarks_value
), XCDR (quarks_value
));
1646 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1647 XrmDatabase database
;
1648 Lisp_Object node_id
, quark_name
, quark_class
;
1650 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1651 Lisp_Object key
, labels
[3], value
;
1654 if (!CONSP (quark_name
))
1655 return Fgethash (node_id
, database
, Qnil
);
1657 /* First, try tight bindings */
1658 labels
[0] = XCAR (quark_name
);
1659 labels
[1] = XCAR (quark_class
);
1660 labels
[2] = SINGLE_COMPONENT
;
1662 key
= Fcons (node_id
, Qnil
);
1663 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1665 XSETCDR (key
, labels
[k
]);
1666 i
= hash_lookup (h
, key
, NULL
);
1669 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1670 XCDR (quark_name
), XCDR (quark_class
));
1676 /* Then, try loose bindings */
1677 XSETCDR (key
, LOOSE_BINDING
);
1678 i
= hash_lookup (h
, key
, NULL
);
1681 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1682 quark_name
, quark_class
);
1686 return xrm_q_get_resource_1 (database
, node_id
,
1687 XCDR (quark_name
), XCDR (quark_class
));
1694 xrm_q_get_resource (database
, quark_name
, quark_class
)
1695 XrmDatabase database
;
1696 Lisp_Object quark_name
, quark_class
;
1698 return xrm_q_get_resource_1 (database
, make_number (0),
1699 quark_name
, quark_class
);
1702 /* Retrieve a resource value for the specified NAME and CLASS from the
1703 resource database DATABASE. It corresponds to XrmGetResource. */
1706 xrm_get_resource (database
, name
, class)
1707 XrmDatabase database
;
1708 const char *name
, *class;
1710 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1712 struct Lisp_Hash_Table
*h
;
1716 nc
= strlen (class);
1717 key
= make_uninit_string (nn
+ nc
+ 1);
1718 strcpy (SDATA (key
), name
);
1719 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1721 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1722 if (NILP (query_cache
))
1724 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1725 make_float (DEFAULT_REHASH_SIZE
),
1726 make_float (DEFAULT_REHASH_THRESHOLD
),
1728 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1730 h
= XHASH_TABLE (query_cache
);
1731 i
= hash_lookup (h
, key
, &hash_code
);
1733 return HASH_VALUE (h
, i
);
1735 quark_name
= parse_resource_name (&name
);
1738 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1739 if (!STRINGP (XCAR (tmp
)))
1742 quark_class
= parse_resource_name (&class);
1745 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1746 if (!STRINGP (XCAR (tmp
)))
1753 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1754 hash_put (h
, key
, tmp
, hash_code
);
1759 #if TARGET_API_MAC_CARBON
1761 xrm_cfproperty_list_to_value (plist
)
1762 CFPropertyListRef plist
;
1764 CFTypeID type_id
= CFGetTypeID (plist
);
1766 if (type_id
== CFStringGetTypeID ())
1767 return cfstring_to_lisp (plist
);
1768 else if (type_id
== CFNumberGetTypeID ())
1771 Lisp_Object result
= Qnil
;
1773 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1776 result
= cfstring_to_lisp (string
);
1781 else if (type_id
== CFBooleanGetTypeID ())
1782 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1783 else if (type_id
== CFDataGetTypeID ())
1784 return cfdata_to_lisp (plist
);
1790 /* Create a new resource database from the preferences for the
1791 application APPLICATION. APPLICATION is either a string that
1792 specifies an application ID, or NULL that represents the current
1796 xrm_get_preference_database (application
)
1797 const char *application
;
1799 #if TARGET_API_MAC_CARBON
1800 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1801 CFMutableSetRef key_set
= NULL
;
1802 CFArrayRef key_array
;
1803 CFIndex index
, count
;
1805 XrmDatabase database
;
1806 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1807 CFPropertyListRef plist
;
1809 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1811 user_doms
[0] = kCFPreferencesCurrentUser
;
1812 user_doms
[1] = kCFPreferencesAnyUser
;
1813 host_doms
[0] = kCFPreferencesCurrentHost
;
1814 host_doms
[1] = kCFPreferencesAnyHost
;
1816 database
= xrm_create_database ();
1818 GCPRO3 (database
, quarks
, value
);
1822 app_id
= kCFPreferencesCurrentApplication
;
1825 app_id
= cfstring_create_with_utf8_cstring (application
);
1830 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1831 if (key_set
== NULL
)
1833 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1834 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1836 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1840 count
= CFArrayGetCount (key_array
);
1841 for (index
= 0; index
< count
; index
++)
1842 CFSetAddValue (key_set
,
1843 CFArrayGetValueAtIndex (key_array
, index
));
1844 CFRelease (key_array
);
1848 count
= CFSetGetCount (key_set
);
1849 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1850 CFSetGetValues (key_set
, (const void **)keys
);
1851 for (index
= 0; index
< count
; index
++)
1853 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1854 quarks
= parse_resource_name (&res_name
);
1855 if (!(NILP (quarks
) || *res_name
))
1857 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1858 value
= xrm_cfproperty_list_to_value (plist
);
1861 xrm_q_put_resource (database
, quarks
, value
);
1868 CFRelease (key_set
);
1877 return xrm_create_database ();
1884 /* The following functions with "sys_" prefix are stubs to Unix
1885 functions that have already been implemented by CW or MPW. The
1886 calls to them in Emacs source course are #define'd to call the sys_
1887 versions by the header files s-mac.h. In these stubs pathnames are
1888 converted between their Unix and Mac forms. */
1891 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1892 + 17 leap days. These are for adjusting time values returned by
1893 MacOS Toolbox functions. */
1895 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1898 #if __MSL__ < 0x6000
1899 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1900 a leap year! This is for adjusting time_t values returned by MSL
1902 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1903 #else /* __MSL__ >= 0x6000 */
1904 /* CW changes Pro 6 to follow Unix! */
1905 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1906 #endif /* __MSL__ >= 0x6000 */
1908 /* MPW library functions follow Unix (confused?). */
1909 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1910 #else /* not __MRC__ */
1912 #endif /* not __MRC__ */
1915 /* Define our own stat function for both MrC and CW. The reason for
1916 doing this: "stat" is both the name of a struct and function name:
1917 can't use the same trick like that for sys_open, sys_close, etc. to
1918 redirect Emacs's calls to our own version that converts Unix style
1919 filenames to Mac style filename because all sorts of compilation
1920 errors will be generated if stat is #define'd to be sys_stat. */
1923 stat_noalias (const char *path
, struct stat
*buf
)
1925 char mac_pathname
[MAXPATHLEN
+1];
1928 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1931 c2pstr (mac_pathname
);
1932 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1933 cipb
.hFileInfo
.ioVRefNum
= 0;
1934 cipb
.hFileInfo
.ioDirID
= 0;
1935 cipb
.hFileInfo
.ioFDirIndex
= 0;
1936 /* set to 0 to get information about specific dir or file */
1938 errno
= PBGetCatInfo (&cipb
, false);
1939 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1944 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1946 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1948 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1949 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1950 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1951 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1952 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1953 /* size of dir = number of files and dirs */
1956 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1957 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1961 buf
->st_mode
= S_IFREG
| S_IREAD
;
1962 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1963 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1964 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1965 buf
->st_mode
|= S_IEXEC
;
1966 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1967 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1968 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1971 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1972 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1975 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1977 /* identify alias files as symlinks */
1978 buf
->st_mode
&= ~S_IFREG
;
1979 buf
->st_mode
|= S_IFLNK
;
1983 buf
->st_uid
= getuid ();
1984 buf
->st_gid
= getgid ();
1992 lstat (const char *path
, struct stat
*buf
)
1995 char true_pathname
[MAXPATHLEN
+1];
1997 /* Try looking for the file without resolving aliases first. */
1998 if ((result
= stat_noalias (path
, buf
)) >= 0)
2001 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2004 return stat_noalias (true_pathname
, buf
);
2009 stat (const char *path
, struct stat
*sb
)
2012 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2015 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
2016 ! (sb
->st_mode
& S_IFLNK
))
2019 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2022 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2025 fully_resolved_name
[len
] = '\0';
2026 /* in fact our readlink terminates strings */
2027 return lstat (fully_resolved_name
, sb
);
2030 return lstat (true_pathname
, sb
);
2035 /* CW defines fstat in stat.mac.c while MPW does not provide this
2036 function. Without the information of how to get from a file
2037 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
2038 to implement this function. Fortunately, there is only one place
2039 where this function is called in our configuration: in fileio.c,
2040 where only the st_dev and st_ino fields are used to determine
2041 whether two fildes point to different i-nodes to prevent copying
2042 a file onto itself equal. What we have here probably needs
2046 fstat (int fildes
, struct stat
*buf
)
2049 buf
->st_ino
= fildes
;
2050 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
2051 return 0; /* success */
2053 #endif /* __MRC__ */
2057 mkdir (const char *dirname
, int mode
)
2059 #pragma unused(mode)
2062 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
2064 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
2067 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2070 c2pstr (mac_pathname
);
2071 hfpb
.ioNamePtr
= mac_pathname
;
2072 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2073 hfpb
.ioDirID
= 0; /* parent is the root */
2075 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
2076 /* just return the Mac OSErr code for now */
2077 return errno
== noErr
? 0 : -1;
2082 sys_rmdir (const char *dirname
)
2085 char mac_pathname
[MAXPATHLEN
+1];
2087 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2090 c2pstr (mac_pathname
);
2091 hfpb
.ioNamePtr
= mac_pathname
;
2092 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2093 hfpb
.ioDirID
= 0; /* parent is the root */
2095 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
2096 return errno
== noErr
? 0 : -1;
2101 /* No implementation yet. */
2103 execvp (const char *path
, ...)
2107 #endif /* __MRC__ */
2111 utime (const char *path
, const struct utimbuf
*times
)
2113 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2115 char mac_pathname
[MAXPATHLEN
+1];
2118 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2121 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2123 fully_resolved_name
[len
] = '\0';
2125 strcpy (fully_resolved_name
, true_pathname
);
2127 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2130 c2pstr (mac_pathname
);
2131 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2132 cipb
.hFileInfo
.ioVRefNum
= 0;
2133 cipb
.hFileInfo
.ioDirID
= 0;
2134 cipb
.hFileInfo
.ioFDirIndex
= 0;
2135 /* set to 0 to get information about specific dir or file */
2137 errno
= PBGetCatInfo (&cipb
, false);
2141 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
2144 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2146 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
2151 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2153 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
2156 errno
= PBSetCatInfo (&cipb
, false);
2157 return errno
== noErr
? 0 : -1;
2171 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2173 access (const char *path
, int mode
)
2175 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2177 char mac_pathname
[MAXPATHLEN
+1];
2180 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2183 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2185 fully_resolved_name
[len
] = '\0';
2187 strcpy (fully_resolved_name
, true_pathname
);
2189 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2192 c2pstr (mac_pathname
);
2193 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2194 cipb
.hFileInfo
.ioVRefNum
= 0;
2195 cipb
.hFileInfo
.ioDirID
= 0;
2196 cipb
.hFileInfo
.ioFDirIndex
= 0;
2197 /* set to 0 to get information about specific dir or file */
2199 errno
= PBGetCatInfo (&cipb
, false);
2203 if (mode
== F_OK
) /* got this far, file exists */
2207 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
2211 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2218 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2219 /* don't allow if lock bit is on */
2225 #define DEV_NULL_FD 0x10000
2229 sys_open (const char *path
, int oflag
)
2231 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2233 char mac_pathname
[MAXPATHLEN
+1];
2235 if (strcmp (path
, "/dev/null") == 0)
2236 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2238 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2241 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2243 fully_resolved_name
[len
] = '\0';
2245 strcpy (fully_resolved_name
, true_pathname
);
2247 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2252 int res
= open (mac_pathname
, oflag
);
2253 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2254 if (oflag
& O_CREAT
)
2255 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2257 #else /* not __MRC__ */
2258 return open (mac_pathname
, oflag
);
2259 #endif /* not __MRC__ */
2266 sys_creat (const char *path
, mode_t mode
)
2268 char true_pathname
[MAXPATHLEN
+1];
2270 char mac_pathname
[MAXPATHLEN
+1];
2272 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2275 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2280 int result
= creat (mac_pathname
);
2281 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2283 #else /* not __MRC__ */
2284 return creat (mac_pathname
, mode
);
2285 #endif /* not __MRC__ */
2292 sys_unlink (const char *path
)
2294 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2296 char mac_pathname
[MAXPATHLEN
+1];
2298 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2301 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2303 fully_resolved_name
[len
] = '\0';
2305 strcpy (fully_resolved_name
, true_pathname
);
2307 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2310 return unlink (mac_pathname
);
2316 sys_read (int fildes
, char *buf
, int count
)
2318 if (fildes
== 0) /* this should not be used for console input */
2321 #if __MSL__ >= 0x6000
2322 return _read (fildes
, buf
, count
);
2324 return read (fildes
, buf
, count
);
2331 sys_write (int fildes
, const char *buf
, int count
)
2333 if (fildes
== DEV_NULL_FD
)
2336 #if __MSL__ >= 0x6000
2337 return _write (fildes
, buf
, count
);
2339 return write (fildes
, buf
, count
);
2346 sys_rename (const char * old_name
, const char * new_name
)
2348 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2349 char fully_resolved_old_name
[MAXPATHLEN
+1];
2351 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2353 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2356 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2358 fully_resolved_old_name
[len
] = '\0';
2360 strcpy (fully_resolved_old_name
, true_old_pathname
);
2362 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2365 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2368 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2373 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2376 /* If a file with new_name already exists, rename deletes the old
2377 file in Unix. CW version fails in these situation. So we add a
2378 call to unlink here. */
2379 (void) unlink (mac_new_name
);
2381 return rename (mac_old_name
, mac_new_name
);
2386 extern FILE *fopen (const char *name
, const char *mode
);
2388 sys_fopen (const char *name
, const char *mode
)
2390 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2392 char mac_pathname
[MAXPATHLEN
+1];
2394 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2397 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2399 fully_resolved_name
[len
] = '\0';
2401 strcpy (fully_resolved_name
, true_pathname
);
2403 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2408 if (mode
[0] == 'w' || mode
[0] == 'a')
2409 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
2410 #endif /* not __MRC__ */
2411 return fopen (mac_pathname
, mode
);
2416 extern Boolean mac_wait_next_event
P_ ((EventRecord
*, UInt32
, Boolean
));
2419 select (nfds
, rfds
, wfds
, efds
, timeout
)
2421 SELECT_TYPE
*rfds
, *wfds
, *efds
;
2422 EMACS_TIME
*timeout
;
2424 OSStatus err
= noErr
;
2426 /* Can only handle wait for keyboard input. */
2427 if (nfds
> 1 || wfds
|| efds
)
2430 /* Try detect_input_pending before ReceiveNextEvent in the same
2431 BLOCK_INPUT block, in case that some input has already been read
2434 if (!detect_input_pending ())
2436 #if TARGET_API_MAC_CARBON
2437 EventTimeout timeoutval
=
2439 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2440 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2441 : kEventDurationForever
);
2443 if (timeoutval
== 0.0)
2444 err
= eventLoopTimedOutErr
;
2446 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
2447 kEventLeaveInQueue
, NULL
);
2448 #else /* not TARGET_API_MAC_CARBON */
2450 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2451 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2453 if (sleep_time
== 0)
2454 err
= -9875; /* eventLoopTimedOutErr */
2457 if (mac_wait_next_event (&e
, sleep_time
, false))
2460 err
= -9875; /* eventLoopTimedOutErr */
2462 #endif /* not TARGET_API_MAC_CARBON */
2468 /* Pretend that `select' is interrupted by a signal. */
2469 detect_input_pending ();
2482 /* Simulation of SIGALRM. The stub for function signal stores the
2483 signal handler function in alarm_signal_func if a SIGALRM is
2487 #include "syssignal.h"
2489 static TMTask mac_atimer_task
;
2491 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2493 static int signal_mask
= 0;
2496 __sigfun alarm_signal_func
= (__sigfun
) 0;
2498 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2499 #else /* not __MRC__ and not __MWERKS__ */
2501 #endif /* not __MRC__ and not __MWERKS__ */
2505 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2507 sys_signal (int signal_num
, __sigfun signal_func
)
2509 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2511 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2512 #else /* not __MRC__ and not __MWERKS__ */
2514 #endif /* not __MRC__ and not __MWERKS__ */
2516 if (signal_num
!= SIGALRM
)
2517 return signal (signal_num
, signal_func
);
2521 __sigfun old_signal_func
;
2523 __signal_func_ptr old_signal_func
;
2527 old_signal_func
= alarm_signal_func
;
2528 alarm_signal_func
= signal_func
;
2529 return old_signal_func
;
2535 mac_atimer_handler (qlink
)
2538 if (alarm_signal_func
)
2539 (alarm_signal_func
) (SIGALRM
);
2544 set_mac_atimer (count
)
2547 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2549 if (mac_atimer_handlerUPP
== NULL
)
2550 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2551 mac_atimer_task
.tmCount
= 0;
2552 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2553 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2554 InsTime (mac_atimer_qlink
);
2556 PrimeTime (mac_atimer_qlink
, count
);
2561 remove_mac_atimer (remaining_count
)
2562 long *remaining_count
;
2564 if (mac_atimer_qlink
)
2566 RmvTime (mac_atimer_qlink
);
2567 if (remaining_count
)
2568 *remaining_count
= mac_atimer_task
.tmCount
;
2569 mac_atimer_qlink
= NULL
;
2581 int old_mask
= signal_mask
;
2583 signal_mask
|= mask
;
2585 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2586 remove_mac_atimer (NULL
);
2593 sigsetmask (int mask
)
2595 int old_mask
= signal_mask
;
2599 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2600 if (signal_mask
& sigmask (SIGALRM
))
2601 remove_mac_atimer (NULL
);
2603 set_mac_atimer (mac_atimer_task
.tmCount
);
2612 long remaining_count
;
2614 if (remove_mac_atimer (&remaining_count
) == 0)
2616 set_mac_atimer (seconds
* 1000);
2618 return remaining_count
/ 1000;
2622 mac_atimer_task
.tmCount
= seconds
* 1000;
2630 setitimer (which
, value
, ovalue
)
2632 const struct itimerval
*value
;
2633 struct itimerval
*ovalue
;
2635 long remaining_count
;
2636 long count
= (EMACS_SECS (value
->it_value
) * 1000
2637 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2639 if (remove_mac_atimer (&remaining_count
) == 0)
2643 bzero (ovalue
, sizeof (*ovalue
));
2644 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2645 (remaining_count
% 1000) * 1000);
2647 set_mac_atimer (count
);
2650 mac_atimer_task
.tmCount
= count
;
2656 /* gettimeofday should return the amount of time (in a timeval
2657 structure) since midnight today. The toolbox function Microseconds
2658 returns the number of microseconds (in a UnsignedWide value) since
2659 the machine was booted. Also making this complicated is WideAdd,
2660 WideSubtract, etc. take wide values. */
2667 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2668 UnsignedWide uw_microseconds
;
2669 wide w_microseconds
;
2670 time_t sys_time (time_t *);
2672 /* If this function is called for the first time, record the number
2673 of seconds since midnight and the number of microseconds since
2674 boot at the time of this first call. */
2679 systime
= sys_time (NULL
);
2680 /* Store microseconds since midnight in wall_clock_at_epoch. */
2681 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2682 Microseconds (&uw_microseconds
);
2683 /* Store microseconds since boot in clicks_at_epoch. */
2684 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2685 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2688 /* Get time since boot */
2689 Microseconds (&uw_microseconds
);
2691 /* Convert to time since midnight*/
2692 w_microseconds
.hi
= uw_microseconds
.hi
;
2693 w_microseconds
.lo
= uw_microseconds
.lo
;
2694 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2695 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2696 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2704 sleep (unsigned int seconds
)
2706 unsigned long time_up
;
2709 time_up
= TickCount () + seconds
* 60;
2710 while (TickCount () < time_up
)
2712 /* Accept no event; just wait. by T.I. */
2713 WaitNextEvent (0, &e
, 30, NULL
);
2718 #endif /* __MRC__ */
2721 /* The time functions adjust time values according to the difference
2722 between the Unix and CW epoches. */
2725 extern struct tm
*gmtime (const time_t *);
2727 sys_gmtime (const time_t *timer
)
2729 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2731 return gmtime (&unix_time
);
2736 extern struct tm
*localtime (const time_t *);
2738 sys_localtime (const time_t *timer
)
2740 #if __MSL__ >= 0x6000
2741 time_t unix_time
= *timer
;
2743 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2746 return localtime (&unix_time
);
2751 extern char *ctime (const time_t *);
2753 sys_ctime (const time_t *timer
)
2755 #if __MSL__ >= 0x6000
2756 time_t unix_time
= *timer
;
2758 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2761 return ctime (&unix_time
);
2766 extern time_t time (time_t *);
2768 sys_time (time_t *timer
)
2770 #if __MSL__ >= 0x6000
2771 time_t mac_time
= time (NULL
);
2773 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2783 /* no subprocesses, empty wait */
2793 croak (char *badfunc
)
2795 printf ("%s not yet implemented\r\n", badfunc
);
2801 mktemp (char *template)
2806 len
= strlen (template);
2808 while (k
>= 0 && template[k
] == 'X')
2811 k
++; /* make k index of first 'X' */
2815 /* Zero filled, number of digits equal to the number of X's. */
2816 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2825 /* Emulate getpwuid, getpwnam and others. */
2827 #define PASSWD_FIELD_SIZE 256
2829 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2830 static char my_passwd_dir
[MAXPATHLEN
+1];
2832 static struct passwd my_passwd
=
2838 static struct group my_group
=
2840 /* There are no groups on the mac, so we just return "root" as the
2846 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2848 char emacs_passwd_dir
[MAXPATHLEN
+1];
2854 init_emacs_passwd_dir ()
2858 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2860 /* Need pathname of first ancestor that begins with "emacs"
2861 since Mac emacs application is somewhere in the emacs-*
2863 int len
= strlen (emacs_passwd_dir
);
2865 /* j points to the "/" following the directory name being
2868 while (i
>= 0 && !found
)
2870 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2872 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2873 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2875 emacs_passwd_dir
[j
+1] = '\0';
2886 /* Setting to "/" probably won't work but set it to something
2888 strcpy (emacs_passwd_dir
, "/");
2889 strcpy (my_passwd_dir
, "/");
2894 static struct passwd emacs_passwd
=
2900 static int my_passwd_inited
= 0;
2908 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2909 directory where Emacs was started. */
2911 owner_name
= (char **) GetResource ('STR ',-16096);
2915 BlockMove ((unsigned char *) *owner_name
,
2916 (unsigned char *) my_passwd_name
,
2918 HUnlock (owner_name
);
2919 p2cstr ((unsigned char *) my_passwd_name
);
2922 my_passwd_name
[0] = 0;
2927 getpwuid (uid_t uid
)
2929 if (!my_passwd_inited
)
2932 my_passwd_inited
= 1;
2940 getgrgid (gid_t gid
)
2947 getpwnam (const char *name
)
2949 if (strcmp (name
, "emacs") == 0)
2950 return &emacs_passwd
;
2952 if (!my_passwd_inited
)
2955 my_passwd_inited
= 1;
2962 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2963 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2984 error ("Can't spawn subshell");
2989 request_sigio (void)
2995 unrequest_sigio (void)
3010 pipe (int _fildes
[2])
3017 /* Hard and symbolic links. */
3020 symlink (const char *name1
, const char *name2
)
3028 link (const char *name1
, const char *name2
)
3034 #endif /* ! MAC_OSX */
3036 /* Determine the path name of the file specified by VREFNUM, DIRID,
3037 and NAME and place that in the buffer PATH of length
3040 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
3041 long dir_id
, ConstStr255Param name
)
3047 if (strlen (name
) > man_path_len
)
3050 memcpy (dir_name
, name
, name
[0]+1);
3051 memcpy (path
, name
, name
[0]+1);
3054 cipb
.dirInfo
.ioDrParID
= dir_id
;
3055 cipb
.dirInfo
.ioNamePtr
= dir_name
;
3059 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
3060 cipb
.dirInfo
.ioFDirIndex
= -1;
3061 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
3062 /* go up to parent each time */
3064 err
= PBGetCatInfo (&cipb
, false);
3069 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
3072 strcat (dir_name
, ":");
3073 strcat (dir_name
, path
);
3074 /* attach to front since we're going up directory tree */
3075 strcpy (path
, dir_name
);
3077 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
3078 /* stop when we see the volume's root directory */
3080 return 1; /* success */
3087 posix_pathname_to_fsspec (ufn
, fs
)
3091 Str255 mac_pathname
;
3093 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
3097 c2pstr (mac_pathname
);
3098 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
3103 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
3108 char mac_pathname
[MAXPATHLEN
];
3110 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
3111 fs
->vRefNum
, fs
->parID
, fs
->name
)
3112 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
3119 readlink (const char *path
, char *buf
, int bufsiz
)
3121 char mac_sym_link_name
[MAXPATHLEN
+1];
3124 Boolean target_is_folder
, was_aliased
;
3125 Str255 directory_name
, mac_pathname
;
3128 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
3131 c2pstr (mac_sym_link_name
);
3132 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
3139 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
3140 if (err
!= noErr
|| !was_aliased
)
3146 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
3153 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
3159 return strlen (buf
);
3163 /* Convert a path to one with aliases fully expanded. */
3166 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
3168 char *q
, temp
[MAXPATHLEN
+1];
3172 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
3179 q
= strchr (p
+ 1, '/');
3181 q
= strchr (p
, '/');
3182 len
= 0; /* loop may not be entered, e.g., for "/" */
3187 strncat (temp
, p
, q
- p
);
3188 len
= readlink (temp
, buf
, bufsiz
);
3191 if (strlen (temp
) + 1 > bufsiz
)
3201 if (len
+ strlen (p
) + 1 >= bufsiz
)
3205 return len
+ strlen (p
);
3210 umask (mode_t numask
)
3212 static mode_t mask
= 022;
3213 mode_t oldmask
= mask
;
3220 chmod (const char *path
, mode_t mode
)
3222 /* say it always succeed for now */
3228 fchmod (int fd
, mode_t mode
)
3230 /* say it always succeed for now */
3236 fchown (int fd
, uid_t owner
, gid_t group
)
3238 /* say it always succeed for now */
3247 return fcntl (oldd
, F_DUPFD
, 0);
3249 /* current implementation of fcntl in fcntl.mac.c simply returns old
3251 return fcntl (oldd
, F_DUPFD
);
3258 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3259 newd if it already exists. Then, attempt to dup oldd. If not
3260 successful, call dup2 recursively until we are, then close the
3261 unsuccessful ones. */
3264 dup2 (int oldd
, int newd
)
3275 ret
= dup2 (oldd
, newd
);
3281 /* let it fail for now */
3298 ioctl (int d
, int request
, void *argp
)
3308 if (fildes
>=0 && fildes
<= 2)
3341 #endif /* __MRC__ */
3345 #if __MSL__ < 0x6000
3353 #endif /* __MWERKS__ */
3355 #endif /* ! MAC_OSX */
3358 /* Return the path to the directory in which Emacs can create
3359 temporary files. The MacOS "temporary items" directory cannot be
3360 used because it removes the file written by a process when it
3361 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3362 again not exactly). And of course Emacs needs to read back the
3363 files written by its subprocesses. So here we write the files to a
3364 directory "Emacs" in the Preferences Folder. This directory is
3365 created if it does not exist. */
3368 get_temp_dir_name ()
3370 static char *temp_dir_name
= NULL
;
3375 char unix_dir_name
[MAXPATHLEN
+1];
3378 /* Cache directory name with pointer temp_dir_name.
3379 Look for it only the first time. */
3382 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3383 &vol_ref_num
, &dir_id
);
3387 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3390 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3391 strcat (full_path
, "Emacs:");
3395 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3398 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3401 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3404 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3405 strcpy (temp_dir_name
, unix_dir_name
);
3408 return temp_dir_name
;
3413 /* Allocate and construct an array of pointers to strings from a list
3414 of strings stored in a 'STR#' resource. The returned pointer array
3415 is stored in the style of argv and environ: if the 'STR#' resource
3416 contains numString strings, a pointer array with numString+1
3417 elements is returned in which the last entry contains a null
3418 pointer. The pointer to the pointer array is passed by pointer in
3419 parameter t. The resource ID of the 'STR#' resource is passed in
3420 parameter StringListID.
3424 get_string_list (char ***t
, short string_list_id
)
3430 h
= GetResource ('STR#', string_list_id
);
3435 num_strings
= * (short *) p
;
3437 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3438 for (i
= 0; i
< num_strings
; i
++)
3440 short length
= *p
++;
3441 (*t
)[i
] = (char *) malloc (length
+ 1);
3442 strncpy ((*t
)[i
], p
, length
);
3443 (*t
)[i
][length
] = '\0';
3446 (*t
)[num_strings
] = 0;
3451 /* Return no string in case GetResource fails. Bug fixed by
3452 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3453 option (no sym -on implies -opt local). */
3454 *t
= (char **) malloc (sizeof (char *));
3461 get_path_to_system_folder ()
3467 static char system_folder_unix_name
[MAXPATHLEN
+1];
3470 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3471 &vol_ref_num
, &dir_id
);
3475 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3478 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3482 return system_folder_unix_name
;
3488 #define ENVIRON_STRING_LIST_ID 128
3490 /* Get environment variable definitions from STR# resource. */
3497 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3503 /* Make HOME directory the one Emacs starts up in if not specified
3505 if (getenv ("HOME") == NULL
)
3507 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3510 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3513 strcpy (environ
[i
], "HOME=");
3514 strcat (environ
[i
], my_passwd_dir
);
3521 /* Make HOME directory the one Emacs starts up in if not specified
3523 if (getenv ("MAIL") == NULL
)
3525 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3528 char * path_to_system_folder
= get_path_to_system_folder ();
3529 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3532 strcpy (environ
[i
], "MAIL=");
3533 strcat (environ
[i
], path_to_system_folder
);
3534 strcat (environ
[i
], "Eudora Folder/In");
3542 /* Return the value of the environment variable NAME. */
3545 getenv (const char *name
)
3547 int length
= strlen(name
);
3550 for (e
= environ
; *e
!= 0; e
++)
3551 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3552 return &(*e
)[length
+ 1];
3554 if (strcmp (name
, "TMPDIR") == 0)
3555 return get_temp_dir_name ();
3562 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3563 char *sys_siglist
[] =
3565 "Zero is not a signal!!!",
3567 "Interactive user interrupt", /* 2 */ "?",
3568 "Floating point exception", /* 4 */ "?", "?", "?",
3569 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3570 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3571 "?", "?", "?", "?", "?", "?", "?", "?",
3575 char *sys_siglist
[] =
3577 "Zero is not a signal!!!",
3579 "Floating point exception",
3580 "Illegal instruction",
3581 "Interactive user interrupt",
3582 "Segment violation",
3585 #else /* not __MRC__ and not __MWERKS__ */
3587 #endif /* not __MRC__ and not __MWERKS__ */
3590 #include <utsname.h>
3593 uname (struct utsname
*name
)
3596 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3599 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3600 p2cstr (name
->nodename
);
3608 /* Event class of HLE sent to subprocess. */
3609 const OSType kEmacsSubprocessSend
= 'ESND';
3611 /* Event class of HLE sent back from subprocess. */
3612 const OSType kEmacsSubprocessReply
= 'ERPY';
3616 mystrchr (char *s
, char c
)
3618 while (*s
&& *s
!= c
)
3646 mystrcpy (char *to
, char *from
)
3658 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3659 terminated). The process should run with the default directory
3660 "workdir", read input from "infn", and write output and error to
3661 "outfn" and "errfn", resp. The Process Manager call
3662 LaunchApplication is used to start the subprocess. We use high
3663 level events as the mechanism to pass arguments to the subprocess
3664 and to make Emacs wait for the subprocess to terminate and pass
3665 back a result code. The bulk of the code here packs the arguments
3666 into one message to be passed together with the high level event.
3667 Emacs also sometimes starts a subprocess using a shell to perform
3668 wildcard filename expansion. Since we don't really have a shell on
3669 the Mac, this case is detected and the starting of the shell is
3670 by-passed. We really need to add code here to do filename
3671 expansion to support such functionality.
3673 We can't use this strategy in Carbon because the High Level Event
3674 APIs are not available. */
3677 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3678 unsigned char **argv
;
3679 const char *workdir
;
3680 const char *infn
, *outfn
, *errfn
;
3682 #if TARGET_API_MAC_CARBON
3684 #else /* not TARGET_API_MAC_CARBON */
3685 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3686 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3687 int paramlen
, argc
, newargc
, j
, retries
;
3688 char **newargv
, *param
, *p
;
3691 LaunchParamBlockRec lpbr
;
3692 EventRecord send_event
, reply_event
;
3693 RgnHandle cursor_region_handle
;
3695 unsigned long ref_con
, len
;
3697 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3699 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3701 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3703 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3706 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3707 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3716 /* If a subprocess is invoked with a shell, we receive 3 arguments
3717 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3718 bins>/<command> <command args>" */
3719 j
= strlen (argv
[0]);
3720 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3721 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3723 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3725 /* The arguments for the command in argv[2] are separated by
3726 spaces. Count them and put the count in newargc. */
3727 command
= (char *) alloca (strlen (argv
[2])+2);
3728 strcpy (command
, argv
[2]);
3729 if (command
[strlen (command
) - 1] != ' ')
3730 strcat (command
, " ");
3734 t
= mystrchr (t
, ' ');
3738 t
= mystrchr (t
+1, ' ');
3741 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3744 for (j
= 0; j
< newargc
; j
++)
3746 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3747 mystrcpy (newargv
[j
], t
);
3750 paramlen
+= strlen (newargv
[j
]) + 1;
3753 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3755 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3760 { /* sometimes Emacs call "sh" without a path for the command */
3762 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3763 strcpy (t
, "~emacs/");
3764 strcat (t
, newargv
[0]);
3767 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3768 make_number (X_OK
));
3772 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3776 strcpy (macappname
, tempmacpathname
);
3780 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3783 newargv
= (char **) alloca (sizeof (char *) * argc
);
3785 for (j
= 1; j
< argc
; j
++)
3787 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3789 char *t
= strchr (argv
[j
], ' ');
3792 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3793 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3794 tempcmdname
[t
-argv
[j
]] = '\0';
3795 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3798 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3800 strcpy (newargv
[j
], tempmaccmdname
);
3801 strcat (newargv
[j
], t
);
3805 char tempmaccmdname
[MAXPATHLEN
+1];
3806 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3809 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3810 strcpy (newargv
[j
], tempmaccmdname
);
3814 newargv
[j
] = argv
[j
];
3815 paramlen
+= strlen (newargv
[j
]) + 1;
3819 /* After expanding all the arguments, we now know the length of the
3820 parameter block to be sent to the subprocess as a message
3821 attached to the HLE. */
3822 param
= (char *) malloc (paramlen
+ 1);
3828 /* first byte of message contains number of arguments for command */
3829 strcpy (p
, macworkdir
);
3830 p
+= strlen (macworkdir
);
3832 /* null terminate strings sent so it's possible to use strcpy over there */
3833 strcpy (p
, macinfn
);
3834 p
+= strlen (macinfn
);
3836 strcpy (p
, macoutfn
);
3837 p
+= strlen (macoutfn
);
3839 strcpy (p
, macerrfn
);
3840 p
+= strlen (macerrfn
);
3842 for (j
= 1; j
< newargc
; j
++)
3844 strcpy (p
, newargv
[j
]);
3845 p
+= strlen (newargv
[j
]);
3849 c2pstr (macappname
);
3851 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3859 lpbr
.launchBlockID
= extendedBlock
;
3860 lpbr
.launchEPBLength
= extendedBlockLen
;
3861 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3862 lpbr
.launchAppSpec
= &spec
;
3863 lpbr
.launchAppParameters
= NULL
;
3865 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3872 send_event
.what
= kHighLevelEvent
;
3873 send_event
.message
= kEmacsSubprocessSend
;
3874 /* Event ID stored in "where" unused */
3877 /* OS may think current subprocess has terminated if previous one
3878 terminated recently. */
3881 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3882 paramlen
+ 1, receiverIDisPSN
);
3884 while (iErr
== sessClosedErr
&& retries
-- > 0);
3892 cursor_region_handle
= NewRgn ();
3894 /* Wait for the subprocess to finish, when it will send us a ERPY
3895 high level event. */
3897 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3898 cursor_region_handle
)
3899 && reply_event
.message
== kEmacsSubprocessReply
)
3902 /* The return code is sent through the refCon */
3903 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3906 DisposeHandle ((Handle
) cursor_region_handle
);
3911 DisposeHandle ((Handle
) cursor_region_handle
);
3915 #endif /* not TARGET_API_MAC_CARBON */
3920 opendir (const char *dirname
)
3922 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3923 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3927 int len
, vol_name_len
;
3929 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3932 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3934 fully_resolved_name
[len
] = '\0';
3936 strcpy (fully_resolved_name
, true_pathname
);
3938 dirp
= (DIR *) malloc (sizeof(DIR));
3942 /* Handle special case when dirname is "/": sets up for readir to
3943 get all mount volumes. */
3944 if (strcmp (fully_resolved_name
, "/") == 0)
3946 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3947 dirp
->current_index
= 1; /* index for first volume */
3951 /* Handle typical cases: not accessing all mounted volumes. */
3952 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3955 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3956 len
= strlen (mac_pathname
);
3957 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3958 strcat (mac_pathname
, ":");
3960 /* Extract volume name */
3961 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3962 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3963 vol_name
[vol_name_len
] = '\0';
3964 strcat (vol_name
, ":");
3966 c2pstr (mac_pathname
);
3967 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3968 /* using full pathname so vRefNum and DirID ignored */
3969 cipb
.hFileInfo
.ioVRefNum
= 0;
3970 cipb
.hFileInfo
.ioDirID
= 0;
3971 cipb
.hFileInfo
.ioFDirIndex
= 0;
3972 /* set to 0 to get information about specific dir or file */
3974 errno
= PBGetCatInfo (&cipb
, false);
3981 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3982 return 0; /* not a directory */
3984 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3985 dirp
->getting_volumes
= 0;
3986 dirp
->current_index
= 1; /* index for first file/directory */
3989 vpb
.ioNamePtr
= vol_name
;
3990 /* using full pathname so vRefNum and DirID ignored */
3992 vpb
.ioVolIndex
= -1;
3993 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
4000 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
4017 HParamBlockRec hpblock
;
4019 static struct dirent s_dirent
;
4020 static Str255 s_name
;
4024 /* Handle the root directory containing the mounted volumes. Call
4025 PBHGetVInfo specifying an index to obtain the info for a volume.
4026 PBHGetVInfo returns an error when it receives an index beyond the
4027 last volume, at which time we should return a nil dirent struct
4029 if (dp
->getting_volumes
)
4031 hpblock
.volumeParam
.ioNamePtr
= s_name
;
4032 hpblock
.volumeParam
.ioVRefNum
= 0;
4033 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
4035 errno
= PBHGetVInfo (&hpblock
, false);
4043 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
4045 dp
->current_index
++;
4047 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
4048 s_dirent
.d_name
= s_name
;
4054 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
4055 cipb
.hFileInfo
.ioNamePtr
= s_name
;
4056 /* location to receive filename returned */
4058 /* return only visible files */
4062 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
4063 /* directory ID found by opendir */
4064 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
4066 errno
= PBGetCatInfo (&cipb
, false);
4073 /* insist on a visible entry */
4074 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
4075 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
4077 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
4079 dp
->current_index
++;
4092 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
4093 /* value unimportant: non-zero for valid file */
4094 s_dirent
.d_name
= s_name
;
4104 char mac_pathname
[MAXPATHLEN
+1];
4105 Str255 directory_name
;
4109 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
4112 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
4118 #endif /* ! MAC_OSX */
4122 initialize_applescript ()
4127 /* if open fails, as_scripting_component is set to NULL. Its
4128 subsequent use in OSA calls will fail with badComponentInstance
4130 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
4131 kAppleScriptSubtype
);
4133 null_desc
.descriptorType
= typeNull
;
4134 null_desc
.dataHandle
= 0;
4135 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
4136 kOSANullScript
, &as_script_context
);
4138 as_script_context
= kOSANullScript
;
4139 /* use default context if create fails */
4144 terminate_applescript()
4146 OSADispose (as_scripting_component
, as_script_context
);
4147 CloseComponent (as_scripting_component
);
4150 /* Convert a lisp string to the 4 byte character code. */
4153 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
4162 /* check type string */
4164 if (SBYTES (arg
) != 4)
4166 error ("Wrong argument: need string of length 4 for code");
4168 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
4173 /* Convert the 4 byte character code into a 4 byte string. */
4176 mac_get_object_from_code(OSType defCode
)
4178 UInt32 code
= EndianU32_NtoB (defCode
);
4180 return make_unibyte_string ((char *)&code
, 4);
4184 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
4185 doc
: /* Get the creator code of FILENAME as a four character string. */)
4187 Lisp_Object filename
;
4195 Lisp_Object result
= Qnil
;
4196 CHECK_STRING (filename
);
4198 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4201 filename
= Fexpand_file_name (filename
, Qnil
);
4205 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4207 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4210 if (status
== noErr
)
4213 FSCatalogInfo catalogInfo
;
4215 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4216 &catalogInfo
, NULL
, NULL
, NULL
);
4220 status
= FSpGetFInfo (&fss
, &finder_info
);
4222 if (status
== noErr
)
4225 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4227 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4232 if (status
!= noErr
) {
4233 error ("Error while getting file information.");
4238 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4239 doc
: /* Get the type code of FILENAME as a four character string. */)
4241 Lisp_Object filename
;
4249 Lisp_Object result
= Qnil
;
4250 CHECK_STRING (filename
);
4252 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4255 filename
= Fexpand_file_name (filename
, Qnil
);
4259 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4261 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4264 if (status
== noErr
)
4267 FSCatalogInfo catalogInfo
;
4269 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4270 &catalogInfo
, NULL
, NULL
, NULL
);
4274 status
= FSpGetFInfo (&fss
, &finder_info
);
4276 if (status
== noErr
)
4279 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4281 result
= mac_get_object_from_code (finder_info
.fdType
);
4286 if (status
!= noErr
) {
4287 error ("Error while getting file information.");
4292 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4293 doc
: /* Set creator code of file FILENAME to CODE.
4294 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4295 assumed. Return non-nil if successful. */)
4297 Lisp_Object filename
, code
;
4306 CHECK_STRING (filename
);
4308 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4310 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4313 filename
= Fexpand_file_name (filename
, Qnil
);
4317 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4319 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4322 if (status
== noErr
)
4325 FSCatalogInfo catalogInfo
;
4327 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4328 &catalogInfo
, NULL
, NULL
, &parentDir
);
4332 status
= FSpGetFInfo (&fss
, &finder_info
);
4334 if (status
== noErr
)
4337 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4338 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4339 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4341 finder_info
.fdCreator
= cCode
;
4342 status
= FSpSetFInfo (&fss
, &finder_info
);
4347 if (status
!= noErr
) {
4348 error ("Error while setting creator information.");
4353 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4354 doc
: /* Set file code of file FILENAME to CODE.
4355 CODE must be a 4-character string. Return non-nil if successful. */)
4357 Lisp_Object filename
, code
;
4366 CHECK_STRING (filename
);
4368 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4370 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4373 filename
= Fexpand_file_name (filename
, Qnil
);
4377 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4379 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4382 if (status
== noErr
)
4385 FSCatalogInfo catalogInfo
;
4387 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4388 &catalogInfo
, NULL
, NULL
, &parentDir
);
4392 status
= FSpGetFInfo (&fss
, &finder_info
);
4394 if (status
== noErr
)
4397 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4398 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4399 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4401 finder_info
.fdType
= cCode
;
4402 status
= FSpSetFInfo (&fss
, &finder_info
);
4407 if (status
!= noErr
) {
4408 error ("Error while setting creator information.");
4414 /* Compile and execute the AppleScript SCRIPT and return the error
4415 status as function value. A zero is returned if compilation and
4416 execution is successful, in which case *RESULT is set to a Lisp
4417 string containing the resulting script value. Otherwise, the Mac
4418 error code is returned and *RESULT is set to an error Lisp string.
4419 For documentation on the MacOS scripting architecture, see Inside
4420 Macintosh - Interapplication Communications: Scripting
4424 do_applescript (script
, result
)
4425 Lisp_Object script
, *result
;
4427 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4433 if (!as_scripting_component
)
4434 initialize_applescript();
4436 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4441 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4442 typeChar
, kOSAModeNull
, &result_desc
);
4444 if (osaerror
== noErr
)
4445 /* success: retrieve resulting script value */
4446 desc
= &result_desc
;
4447 else if (osaerror
== errOSAScriptError
)
4448 /* error executing AppleScript: retrieve error message */
4449 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4455 #if TARGET_API_MAC_CARBON
4456 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4457 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4458 #else /* not TARGET_API_MAC_CARBON */
4459 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4460 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4461 #endif /* not TARGET_API_MAC_CARBON */
4462 AEDisposeDesc (desc
);
4465 AEDisposeDesc (&script_desc
);
4471 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4472 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4473 If compilation and execution are successful, the resulting script
4474 value is returned as a string. Otherwise the function aborts and
4475 displays the error message returned by the AppleScript scripting
4483 CHECK_STRING (script
);
4486 status
= do_applescript (script
, &result
);
4490 else if (!STRINGP (result
))
4491 error ("AppleScript error %d", status
);
4493 error ("%s", SDATA (result
));
4497 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4498 Smac_file_name_to_posix
, 1, 1, 0,
4499 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4501 Lisp_Object filename
;
4503 char posix_filename
[MAXPATHLEN
+1];
4505 CHECK_STRING (filename
);
4507 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4508 return build_string (posix_filename
);
4514 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4515 Sposix_file_name_to_mac
, 1, 1, 0,
4516 doc
: /* Convert Posix FILENAME to Mac form. */)
4518 Lisp_Object filename
;
4520 char mac_filename
[MAXPATHLEN
+1];
4522 CHECK_STRING (filename
);
4524 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4525 return build_string (mac_filename
);
4531 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4532 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4533 Each type should be a string of length 4 or the symbol
4534 `undecoded-file-name'. */)
4535 (src_type
, src_data
, dst_type
)
4536 Lisp_Object src_type
, src_data
, dst_type
;
4539 Lisp_Object result
= Qnil
;
4540 DescType src_desc_type
, dst_desc_type
;
4543 CHECK_STRING (src_data
);
4544 if (EQ (src_type
, Qundecoded_file_name
))
4545 src_desc_type
= TYPE_FILE_NAME
;
4547 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4549 if (EQ (dst_type
, Qundecoded_file_name
))
4550 dst_desc_type
= TYPE_FILE_NAME
;
4552 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4555 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4556 dst_desc_type
, &dst_desc
);
4559 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4560 AEDisposeDesc (&dst_desc
);
4568 #if TARGET_API_MAC_CARBON
4569 static Lisp_Object Qxml
, Qmime_charset
;
4570 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4572 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4573 doc
: /* Return the application preference value for KEY.
4574 KEY is either a string specifying a preference key, or a list of key
4575 strings. If it is a list, the (i+1)-th element is used as a key for
4576 the CFDictionary value obtained by the i-th element. Return nil if
4577 lookup is failed at some stage.
4579 Optional arg APPLICATION is an application ID string. If omitted or
4580 nil, that stands for the current application.
4582 Optional arg FORMAT specifies the data format of the return value. If
4583 omitted or nil, each Core Foundation object is converted into a
4584 corresponding Lisp object as follows:
4586 Core Foundation Lisp Tag
4587 ------------------------------------------------------------
4588 CFString Multibyte string string
4589 CFNumber Integer or float number
4590 CFBoolean Symbol (t or nil) boolean
4591 CFDate List of three integers date
4592 (cf. `current-time')
4593 CFData Unibyte string data
4594 CFArray Vector array
4595 CFDictionary Alist or hash table dictionary
4596 (depending on HASH-BOUND)
4598 If it is t, a symbol that represents the type of the original Core
4599 Foundation object is prepended. If it is `xml', the value is returned
4600 as an XML representation.
4602 Optional arg HASH-BOUND specifies which kinds of the list objects,
4603 alists or hash tables, are used as the targets of the conversion from
4604 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4605 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4606 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4608 (key
, application
, format
, hash_bound
)
4609 Lisp_Object key
, application
, format
, hash_bound
;
4611 CFStringRef app_id
, key_str
;
4612 CFPropertyListRef app_plist
= NULL
, plist
;
4613 Lisp_Object result
= Qnil
, tmp
;
4614 struct gcpro gcpro1
, gcpro2
;
4617 key
= Fcons (key
, Qnil
);
4621 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4622 CHECK_STRING_CAR (tmp
);
4623 CHECK_LIST_END (tmp
, key
);
4625 if (!NILP (application
))
4626 CHECK_STRING (application
);
4627 CHECK_SYMBOL (format
);
4628 if (!NILP (hash_bound
))
4629 CHECK_NUMBER (hash_bound
);
4631 GCPRO2 (key
, format
);
4635 app_id
= kCFPreferencesCurrentApplication
;
4636 if (!NILP (application
))
4638 app_id
= cfstring_create_with_string (application
);
4642 key_str
= cfstring_create_with_string (XCAR (key
));
4643 if (key_str
== NULL
)
4645 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4646 CFRelease (key_str
);
4647 if (app_plist
== NULL
)
4651 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4653 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4655 key_str
= cfstring_create_with_string (XCAR (key
));
4656 if (key_str
== NULL
)
4658 plist
= CFDictionaryGetValue (plist
, key_str
);
4659 CFRelease (key_str
);
4666 if (EQ (format
, Qxml
))
4668 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4671 result
= cfdata_to_lisp (data
);
4676 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4677 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4682 CFRelease (app_plist
);
4693 static CFStringEncoding
4694 get_cfstring_encoding_from_lisp (obj
)
4697 CFStringRef iana_name
;
4698 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4701 return kCFStringEncodingUnicode
;
4706 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4708 Lisp_Object coding_spec
, plist
;
4710 coding_spec
= Fget (obj
, Qcoding_system
);
4711 plist
= XVECTOR (coding_spec
)->contents
[3];
4712 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4716 obj
= SYMBOL_NAME (obj
);
4720 iana_name
= cfstring_create_with_string (obj
);
4723 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4724 CFRelease (iana_name
);
4731 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4733 cfstring_create_normalized (str
, symbol
)
4738 TextEncodingVariant variant
;
4739 float initial_mag
= 0.0;
4740 CFStringRef result
= NULL
;
4742 if (EQ (symbol
, QNFD
))
4743 form
= kCFStringNormalizationFormD
;
4744 else if (EQ (symbol
, QNFKD
))
4745 form
= kCFStringNormalizationFormKD
;
4746 else if (EQ (symbol
, QNFC
))
4747 form
= kCFStringNormalizationFormC
;
4748 else if (EQ (symbol
, QNFKC
))
4749 form
= kCFStringNormalizationFormKC
;
4750 else if (EQ (symbol
, QHFS_plus_D
))
4752 variant
= kUnicodeHFSPlusDecompVariant
;
4755 else if (EQ (symbol
, QHFS_plus_C
))
4757 variant
= kUnicodeHFSPlusCompVariant
;
4763 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4767 CFStringNormalize (mut_str
, form
);
4771 else if (initial_mag
> 0.0)
4773 UnicodeToTextInfo uni
= NULL
;
4776 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4777 OSStatus err
= noErr
;
4778 ByteCount out_read
, out_size
, out_len
;
4780 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4782 kTextEncodingDefaultFormat
);
4783 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4785 kTextEncodingDefaultFormat
);
4786 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4788 length
= CFStringGetLength (str
);
4789 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4793 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4794 if (in_text
== NULL
)
4796 buffer
= xmalloc (sizeof (UniChar
) * length
);
4797 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4802 err
= CreateUnicodeToTextInfo (&map
, &uni
);
4803 while (err
== noErr
)
4805 out_buf
= xmalloc (out_size
);
4806 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4808 kUnicodeDefaultDirectionMask
,
4809 0, NULL
, NULL
, NULL
,
4810 out_size
, &out_read
, &out_len
,
4812 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4821 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4822 out_len
/ sizeof (UniChar
));
4824 DisposeUnicodeToTextInfo (&uni
);
4840 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4841 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4842 The conversion is performed using the converter provided by the system.
4843 Each encoding is specified by either a coding system symbol, a mime
4844 charset string, or an integer as a CFStringEncoding value. Nil for
4845 encoding means UTF-16 in native byte order, no byte order mark.
4846 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4847 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4848 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4849 On successful conversion, return the result string, else return nil. */)
4850 (string
, source
, target
, normalization_form
)
4851 Lisp_Object string
, source
, target
, normalization_form
;
4853 Lisp_Object result
= Qnil
;
4854 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4855 CFStringEncoding src_encoding
, tgt_encoding
;
4856 CFStringRef str
= NULL
;
4858 CHECK_STRING (string
);
4859 if (!INTEGERP (source
) && !STRINGP (source
))
4860 CHECK_SYMBOL (source
);
4861 if (!INTEGERP (target
) && !STRINGP (target
))
4862 CHECK_SYMBOL (target
);
4863 CHECK_SYMBOL (normalization_form
);
4865 GCPRO4 (string
, source
, target
, normalization_form
);
4869 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4870 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4872 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4873 use string_as_unibyte which works as well, except for the fact that
4874 it's too permissive (it doesn't check that the multibyte string only
4875 contain single-byte chars). */
4876 string
= Fstring_as_unibyte (string
);
4877 if (src_encoding
!= kCFStringEncodingInvalidId
4878 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4879 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4880 src_encoding
, !NILP (source
));
4881 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4884 CFStringRef saved_str
= str
;
4886 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4887 CFRelease (saved_str
);
4892 CFIndex str_len
, buf_len
;
4894 str_len
= CFStringGetLength (str
);
4895 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4896 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4898 result
= make_uninit_string (buf_len
);
4899 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4900 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4912 DEFUN ("mac-process-hi-command", Fmac_process_hi_command
, Smac_process_hi_command
, 1, 1, 0,
4913 doc
: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4914 COMMAND-ID must be a 4-character string. Some common command IDs are
4915 defined in the Carbon Event Manager. */)
4917 Lisp_Object command_id
;
4922 bzero (&command
, sizeof (HICommand
));
4923 command
.commandID
= mac_get_code_from_arg (command_id
, 0);
4926 err
= ProcessHICommand (&command
);
4930 error ("HI command (command ID: '%s') not handled.", SDATA (command_id
));
4935 #endif /* TARGET_API_MAC_CARBON */
4939 mac_get_system_locale ()
4947 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4948 region
= GetScriptManagerVariable (smRegionCode
);
4949 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4951 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4954 return build_string (str
);
4962 extern int inhibit_window_system
;
4963 extern int noninteractive
;
4965 /* Unlike in X11, window events in Carbon do not come from sockets.
4966 So we cannot simply use `select' to monitor two kinds of inputs:
4967 window events and process outputs. We emulate such functionality
4968 by regarding fd 0 as the window event channel and simultaneously
4969 monitoring both kinds of input channels. It is implemented by
4970 dividing into some cases:
4971 1. The window event channel is not involved.
4973 2. Sockets are not involved.
4974 -> Use ReceiveNextEvent.
4975 3. [If SELECT_USE_CFSOCKET is set]
4976 Only the window event channel and socket read/write channels are
4977 involved, and timeout is not too short (greater than
4978 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4979 -> Create CFSocket for each socket and add it into the current
4980 event RunLoop so that the current event loop gets quit when
4981 the socket becomes ready. Then ReceiveNextEvent can wait for
4982 both kinds of inputs.
4984 -> Periodically poll the window input channel while repeatedly
4985 executing `select' with a short timeout
4986 (SELECT_POLLING_PERIOD_USEC microseconds). */
4988 #ifndef SELECT_USE_CFSOCKET
4989 #define SELECT_USE_CFSOCKET 1
4992 #define SELECT_POLLING_PERIOD_USEC 100000
4993 #if SELECT_USE_CFSOCKET
4994 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4997 socket_callback (s
, type
, address
, data
, info
)
4999 CFSocketCallBackType type
;
5004 int fd
= CFSocketGetNative (s
);
5005 SELECT_TYPE
*ofds
= (SELECT_TYPE
*)info
;
5007 if ((type
== kCFSocketReadCallBack
&& FD_ISSET (fd
, &ofds
[0]))
5008 || (type
== kCFSocketConnectCallBack
&& FD_ISSET (fd
, &ofds
[1])))
5009 QuitEventLoop (GetCurrentEventLoop ());
5011 #endif /* SELECT_USE_CFSOCKET */
5014 select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
)
5016 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5017 EMACS_TIME
*timeout
;
5019 OSStatus err
= noErr
;
5022 /* Try detect_input_pending before ReceiveNextEvent in the same
5023 BLOCK_INPUT block, in case that some input has already been read
5026 if (!detect_input_pending ())
5028 EMACS_TIME select_timeout
;
5029 EventTimeout timeoutval
=
5031 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5032 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5033 : kEventDurationForever
);
5035 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5036 r
= select (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5037 if (timeoutval
== 0.0)
5038 err
= eventLoopTimedOutErr
;
5042 mac_prepare_for_quickdraw (NULL
);
5044 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
5045 kEventLeaveInQueue
, NULL
);
5052 else if (err
== noErr
)
5054 /* Pretend that `select' is interrupted by a signal. */
5055 detect_input_pending ();
5064 sys_select (nfds
, rfds
, wfds
, efds
, timeout
)
5066 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5067 EMACS_TIME
*timeout
;
5069 OSStatus err
= noErr
;
5071 EMACS_TIME select_timeout
;
5072 static SELECT_TYPE ofds
[3];
5074 if (inhibit_window_system
|| noninteractive
5075 || nfds
< 1 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
5076 return select (nfds
, rfds
, wfds
, efds
, timeout
);
5090 EventTimeout timeoutval
=
5092 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5093 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5094 : kEventDurationForever
);
5096 FD_SET (0, rfds
); /* sentinel */
5101 while (!(FD_ISSET (nfds
, rfds
) || (wfds
&& FD_ISSET (nfds
, wfds
))));
5106 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
);
5108 /* Avoid initial overhead of RunLoop setup for the case that
5109 some input is already available. */
5110 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5111 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5112 if (r
!= 0 || timeoutval
== 0.0)
5119 #if SELECT_USE_CFSOCKET
5120 if (timeoutval
> 0 && timeoutval
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
5121 goto poll_periodically
;
5123 /* Try detect_input_pending before ReceiveNextEvent in the same
5124 BLOCK_INPUT block, in case that some input has already been
5125 read asynchronously. */
5127 if (!detect_input_pending ())
5130 CFRunLoopRef runloop
=
5131 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5132 static const CFSocketContext context
= {0, ofds
, NULL
, NULL
, NULL
};
5133 static CFMutableDictionaryRef sources
;
5135 if (sources
== NULL
)
5137 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5138 &kCFTypeDictionaryValueCallBacks
);
5140 for (minfd
= 1; ; minfd
++) /* nfds-1 works as a sentinel. */
5141 if (FD_ISSET (minfd
, rfds
) || (wfds
&& FD_ISSET (minfd
, wfds
)))
5144 for (fd
= minfd
; fd
< nfds
; fd
++)
5145 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5147 void *key
= (void *) fd
;
5148 CFRunLoopSourceRef source
=
5149 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5153 CFSocketRef socket
=
5154 CFSocketCreateWithNative (NULL
, fd
,
5155 (kCFSocketReadCallBack
5156 | kCFSocketConnectCallBack
),
5157 socket_callback
, &context
);
5161 source
= CFSocketCreateRunLoopSource (NULL
, socket
, 0);
5165 CFDictionaryAddValue (sources
, key
, source
);
5168 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
5172 mac_prepare_for_quickdraw (NULL
);
5174 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
5175 kEventLeaveInQueue
, NULL
);
5177 for (fd
= minfd
; fd
< nfds
; fd
++)
5178 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5180 void *key
= (void *) fd
;
5181 CFRunLoopSourceRef source
=
5182 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5184 CFRunLoopRemoveSource (runloop
, source
, kCFRunLoopDefaultMode
);
5189 if (err
== noErr
|| err
== eventLoopQuitErr
)
5191 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5192 return select_and_poll_event (nfds
, rfds
, wfds
, efds
,
5202 #endif /* SELECT_USE_CFSOCKET */
5207 EMACS_TIME end_time
, now
, remaining_time
;
5211 remaining_time
= *timeout
;
5212 EMACS_GET_TIME (now
);
5213 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5218 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5219 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5220 select_timeout
= remaining_time
;
5221 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5233 EMACS_GET_TIME (now
);
5234 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5237 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5239 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5240 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5244 /* Set up environment variables so that Emacs can correctly find its
5245 support files when packaged as an application bundle. Directories
5246 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5247 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5248 by `make install' by default can instead be placed in
5249 .../Emacs.app/Contents/Resources/ and
5250 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5251 is changed only if it is not already set. Presumably if the user
5252 sets an environment variable, he will want to use files in his path
5253 instead of ones in the application bundle. */
5255 init_mac_osx_environment ()
5259 CFStringRef cf_app_bundle_pathname
;
5260 int app_bundle_pathname_len
;
5261 char *app_bundle_pathname
;
5265 /* Initialize locale related variables. */
5266 mac_system_script_code
=
5267 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5268 Vmac_system_locale
= mac_get_system_locale ();
5270 /* Fetch the pathname of the application bundle as a C string into
5271 app_bundle_pathname. */
5273 bundle
= CFBundleGetMainBundle ();
5274 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5276 /* We could not find the bundle identifier. For now, prevent
5277 the fatal error by bringing it up in the terminal. */
5278 inhibit_window_system
= 1;
5282 bundleURL
= CFBundleCopyBundleURL (bundle
);
5286 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5287 kCFURLPOSIXPathStyle
);
5288 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5289 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5291 if (!CFStringGetCString (cf_app_bundle_pathname
,
5292 app_bundle_pathname
,
5293 app_bundle_pathname_len
+ 1,
5294 kCFStringEncodingISOLatin1
))
5296 CFRelease (cf_app_bundle_pathname
);
5300 CFRelease (cf_app_bundle_pathname
);
5302 /* P should have sufficient room for the pathname of the bundle plus
5303 the subpath in it leading to the respective directories. Q
5304 should have three times that much room because EMACSLOADPATH can
5305 have the value "<path to lisp dir>:<path to leim dir>:<path to
5307 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5308 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5309 if (!getenv ("EMACSLOADPATH"))
5313 strcpy (p
, app_bundle_pathname
);
5314 strcat (p
, "/Contents/Resources/lisp");
5315 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5318 strcpy (p
, app_bundle_pathname
);
5319 strcat (p
, "/Contents/Resources/leim");
5320 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5327 strcpy (p
, app_bundle_pathname
);
5328 strcat (p
, "/Contents/Resources/site-lisp");
5329 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5337 setenv ("EMACSLOADPATH", q
, 1);
5340 if (!getenv ("EMACSPATH"))
5344 strcpy (p
, app_bundle_pathname
);
5345 strcat (p
, "/Contents/MacOS/libexec");
5346 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5349 strcpy (p
, app_bundle_pathname
);
5350 strcat (p
, "/Contents/MacOS/bin");
5351 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5359 setenv ("EMACSPATH", q
, 1);
5362 if (!getenv ("EMACSDATA"))
5364 strcpy (p
, app_bundle_pathname
);
5365 strcat (p
, "/Contents/Resources/etc");
5366 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5367 setenv ("EMACSDATA", p
, 1);
5370 if (!getenv ("EMACSDOC"))
5372 strcpy (p
, app_bundle_pathname
);
5373 strcat (p
, "/Contents/Resources/etc");
5374 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5375 setenv ("EMACSDOC", p
, 1);
5378 if (!getenv ("INFOPATH"))
5380 strcpy (p
, app_bundle_pathname
);
5381 strcat (p
, "/Contents/Resources/info");
5382 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5383 setenv ("INFOPATH", p
, 1);
5386 #endif /* MAC_OSX */
5392 Qundecoded_file_name
= intern ("undecoded-file-name");
5393 staticpro (&Qundecoded_file_name
);
5395 #if TARGET_API_MAC_CARBON
5396 Qstring
= intern ("string"); staticpro (&Qstring
);
5397 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5398 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5399 Qdate
= intern ("date"); staticpro (&Qdate
);
5400 Qdata
= intern ("data"); staticpro (&Qdata
);
5401 Qarray
= intern ("array"); staticpro (&Qarray
);
5402 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5404 Qxml
= intern ("xml");
5407 Qmime_charset
= intern ("mime-charset");
5408 staticpro (&Qmime_charset
);
5410 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5411 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5412 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5413 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5414 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5415 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5421 for (i
= 0; i
< sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]); i
++)
5423 ae_attr_table
[i
].symbol
= intern (ae_attr_table
[i
].name
);
5424 staticpro (&ae_attr_table
[i
].symbol
);
5428 defsubr (&Smac_coerce_ae_data
);
5429 #if TARGET_API_MAC_CARBON
5430 defsubr (&Smac_get_preference
);
5431 defsubr (&Smac_code_convert_string
);
5432 defsubr (&Smac_process_hi_command
);
5435 defsubr (&Smac_set_file_creator
);
5436 defsubr (&Smac_set_file_type
);
5437 defsubr (&Smac_get_file_creator
);
5438 defsubr (&Smac_get_file_type
);
5439 defsubr (&Sdo_applescript
);
5440 defsubr (&Smac_file_name_to_posix
);
5441 defsubr (&Sposix_file_name_to_mac
);
5443 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5444 doc
: /* The system script code. */);
5445 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5447 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5448 doc
: /* The system locale identifier string.
5449 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5450 information is not included. */);
5451 Vmac_system_locale
= mac_get_system_locale ();
5454 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5455 (do not change this comment) */