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 EventParamName
*names
;
839 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
)
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
== '-')
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
;
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
)
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 #include "keyboard.h"
2417 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
2420 select (n
, rfds
, wfds
, efds
, timeout
)
2425 struct timeval
*timeout
;
2428 #if TARGET_API_MAC_CARBON
2429 EventTimeout timeout_sec
=
2431 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2432 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2433 : kEventDurationForever
);
2436 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
2438 #else /* not TARGET_API_MAC_CARBON */
2440 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2441 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2443 /* Can only handle wait for keyboard input. */
2444 if (n
> 1 || wfds
|| efds
)
2447 /* Also return true if an event other than a keyDown has occurred.
2448 This causes kbd_buffer_get_event in keyboard.c to call
2449 read_avail_input which in turn calls XTread_socket to poll for
2450 these events. Otherwise these never get processed except but a
2451 very slow poll timer. */
2452 if (mac_wait_next_event (&e
, sleep_time
, false))
2455 err
= -9875; /* eventLoopTimedOutErr */
2456 #endif /* not TARGET_API_MAC_CARBON */
2458 if (FD_ISSET (0, rfds
))
2469 if (input_polling_used ())
2471 /* It could be confusing if a real alarm arrives while
2472 processing the fake one. Turn it off and let the
2473 handler reset it. */
2474 extern void poll_for_input_1
P_ ((void));
2475 int old_poll_suppress_count
= poll_suppress_count
;
2476 poll_suppress_count
= 1;
2477 poll_for_input_1 ();
2478 poll_suppress_count
= old_poll_suppress_count
;
2488 /* Simulation of SIGALRM. The stub for function signal stores the
2489 signal handler function in alarm_signal_func if a SIGALRM is
2493 #include "syssignal.h"
2495 static TMTask mac_atimer_task
;
2497 static QElemPtr mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2499 static int signal_mask
= 0;
2502 __sigfun alarm_signal_func
= (__sigfun
) 0;
2504 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
2505 #else /* not __MRC__ and not __MWERKS__ */
2507 #endif /* not __MRC__ and not __MWERKS__ */
2511 extern __sigfun
signal (int signal
, __sigfun signal_func
);
2513 sys_signal (int signal_num
, __sigfun signal_func
)
2515 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
2517 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
2518 #else /* not __MRC__ and not __MWERKS__ */
2520 #endif /* not __MRC__ and not __MWERKS__ */
2522 if (signal_num
!= SIGALRM
)
2523 return signal (signal_num
, signal_func
);
2527 __sigfun old_signal_func
;
2529 __signal_func_ptr old_signal_func
;
2533 old_signal_func
= alarm_signal_func
;
2534 alarm_signal_func
= signal_func
;
2535 return old_signal_func
;
2541 mac_atimer_handler (qlink
)
2544 if (alarm_signal_func
)
2545 (alarm_signal_func
) (SIGALRM
);
2550 set_mac_atimer (count
)
2553 static TimerUPP mac_atimer_handlerUPP
= NULL
;
2555 if (mac_atimer_handlerUPP
== NULL
)
2556 mac_atimer_handlerUPP
= NewTimerUPP (mac_atimer_handler
);
2557 mac_atimer_task
.tmCount
= 0;
2558 mac_atimer_task
.tmAddr
= mac_atimer_handlerUPP
;
2559 mac_atimer_qlink
= (QElemPtr
) &mac_atimer_task
;
2560 InsTime (mac_atimer_qlink
);
2562 PrimeTime (mac_atimer_qlink
, count
);
2567 remove_mac_atimer (remaining_count
)
2568 long *remaining_count
;
2570 if (mac_atimer_qlink
)
2572 RmvTime (mac_atimer_qlink
);
2573 if (remaining_count
)
2574 *remaining_count
= mac_atimer_task
.tmCount
;
2575 mac_atimer_qlink
= NULL
;
2587 int old_mask
= signal_mask
;
2589 signal_mask
|= mask
;
2591 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2592 remove_mac_atimer (NULL
);
2599 sigsetmask (int mask
)
2601 int old_mask
= signal_mask
;
2605 if ((old_mask
^ signal_mask
) & sigmask (SIGALRM
))
2606 if (signal_mask
& sigmask (SIGALRM
))
2607 remove_mac_atimer (NULL
);
2609 set_mac_atimer (mac_atimer_task
.tmCount
);
2618 long remaining_count
;
2620 if (remove_mac_atimer (&remaining_count
) == 0)
2622 set_mac_atimer (seconds
* 1000);
2624 return remaining_count
/ 1000;
2628 mac_atimer_task
.tmCount
= seconds
* 1000;
2636 setitimer (which
, value
, ovalue
)
2638 const struct itimerval
*value
;
2639 struct itimerval
*ovalue
;
2641 long remaining_count
;
2642 long count
= (EMACS_SECS (value
->it_value
) * 1000
2643 + (EMACS_USECS (value
->it_value
) + 999) / 1000);
2645 if (remove_mac_atimer (&remaining_count
) == 0)
2649 bzero (ovalue
, sizeof (*ovalue
));
2650 EMACS_SET_SECS_USECS (ovalue
->it_value
, remaining_count
/ 1000,
2651 (remaining_count
% 1000) * 1000);
2653 set_mac_atimer (count
);
2656 mac_atimer_task
.tmCount
= count
;
2662 /* gettimeofday should return the amount of time (in a timeval
2663 structure) since midnight today. The toolbox function Microseconds
2664 returns the number of microseconds (in a UnsignedWide value) since
2665 the machine was booted. Also making this complicated is WideAdd,
2666 WideSubtract, etc. take wide values. */
2673 static wide wall_clock_at_epoch
, clicks_at_epoch
;
2674 UnsignedWide uw_microseconds
;
2675 wide w_microseconds
;
2676 time_t sys_time (time_t *);
2678 /* If this function is called for the first time, record the number
2679 of seconds since midnight and the number of microseconds since
2680 boot at the time of this first call. */
2685 systime
= sys_time (NULL
);
2686 /* Store microseconds since midnight in wall_clock_at_epoch. */
2687 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
2688 Microseconds (&uw_microseconds
);
2689 /* Store microseconds since boot in clicks_at_epoch. */
2690 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
2691 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
2694 /* Get time since boot */
2695 Microseconds (&uw_microseconds
);
2697 /* Convert to time since midnight*/
2698 w_microseconds
.hi
= uw_microseconds
.hi
;
2699 w_microseconds
.lo
= uw_microseconds
.lo
;
2700 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
2701 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
2702 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
2710 sleep (unsigned int seconds
)
2712 unsigned long time_up
;
2715 time_up
= TickCount () + seconds
* 60;
2716 while (TickCount () < time_up
)
2718 /* Accept no event; just wait. by T.I. */
2719 WaitNextEvent (0, &e
, 30, NULL
);
2724 #endif /* __MRC__ */
2727 /* The time functions adjust time values according to the difference
2728 between the Unix and CW epoches. */
2731 extern struct tm
*gmtime (const time_t *);
2733 sys_gmtime (const time_t *timer
)
2735 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2737 return gmtime (&unix_time
);
2742 extern struct tm
*localtime (const time_t *);
2744 sys_localtime (const time_t *timer
)
2746 #if __MSL__ >= 0x6000
2747 time_t unix_time
= *timer
;
2749 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2752 return localtime (&unix_time
);
2757 extern char *ctime (const time_t *);
2759 sys_ctime (const time_t *timer
)
2761 #if __MSL__ >= 0x6000
2762 time_t unix_time
= *timer
;
2764 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
2767 return ctime (&unix_time
);
2772 extern time_t time (time_t *);
2774 sys_time (time_t *timer
)
2776 #if __MSL__ >= 0x6000
2777 time_t mac_time
= time (NULL
);
2779 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
2789 /* no subprocesses, empty wait */
2799 croak (char *badfunc
)
2801 printf ("%s not yet implemented\r\n", badfunc
);
2807 mktemp (char *template)
2812 len
= strlen (template);
2814 while (k
>= 0 && template[k
] == 'X')
2817 k
++; /* make k index of first 'X' */
2821 /* Zero filled, number of digits equal to the number of X's. */
2822 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2831 /* Emulate getpwuid, getpwnam and others. */
2833 #define PASSWD_FIELD_SIZE 256
2835 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2836 static char my_passwd_dir
[MAXPATHLEN
+1];
2838 static struct passwd my_passwd
=
2844 static struct group my_group
=
2846 /* There are no groups on the mac, so we just return "root" as the
2852 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2854 char emacs_passwd_dir
[MAXPATHLEN
+1];
2860 init_emacs_passwd_dir ()
2864 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2866 /* Need pathname of first ancestor that begins with "emacs"
2867 since Mac emacs application is somewhere in the emacs-*
2869 int len
= strlen (emacs_passwd_dir
);
2871 /* j points to the "/" following the directory name being
2874 while (i
>= 0 && !found
)
2876 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2878 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2879 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2881 emacs_passwd_dir
[j
+1] = '\0';
2892 /* Setting to "/" probably won't work but set it to something
2894 strcpy (emacs_passwd_dir
, "/");
2895 strcpy (my_passwd_dir
, "/");
2900 static struct passwd emacs_passwd
=
2906 static int my_passwd_inited
= 0;
2914 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2915 directory where Emacs was started. */
2917 owner_name
= (char **) GetResource ('STR ',-16096);
2921 BlockMove ((unsigned char *) *owner_name
,
2922 (unsigned char *) my_passwd_name
,
2924 HUnlock (owner_name
);
2925 p2cstr ((unsigned char *) my_passwd_name
);
2928 my_passwd_name
[0] = 0;
2933 getpwuid (uid_t uid
)
2935 if (!my_passwd_inited
)
2938 my_passwd_inited
= 1;
2946 getgrgid (gid_t gid
)
2953 getpwnam (const char *name
)
2955 if (strcmp (name
, "emacs") == 0)
2956 return &emacs_passwd
;
2958 if (!my_passwd_inited
)
2961 my_passwd_inited
= 1;
2968 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2969 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2990 error ("Can't spawn subshell");
2995 request_sigio (void)
3001 unrequest_sigio (void)
3016 pipe (int _fildes
[2])
3023 /* Hard and symbolic links. */
3026 symlink (const char *name1
, const char *name2
)
3034 link (const char *name1
, const char *name2
)
3040 #endif /* ! MAC_OSX */
3042 /* Determine the path name of the file specified by VREFNUM, DIRID,
3043 and NAME and place that in the buffer PATH of length
3046 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
3047 long dir_id
, ConstStr255Param name
)
3053 if (strlen (name
) > man_path_len
)
3056 memcpy (dir_name
, name
, name
[0]+1);
3057 memcpy (path
, name
, name
[0]+1);
3060 cipb
.dirInfo
.ioDrParID
= dir_id
;
3061 cipb
.dirInfo
.ioNamePtr
= dir_name
;
3065 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
3066 cipb
.dirInfo
.ioFDirIndex
= -1;
3067 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
3068 /* go up to parent each time */
3070 err
= PBGetCatInfo (&cipb
, false);
3075 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
3078 strcat (dir_name
, ":");
3079 strcat (dir_name
, path
);
3080 /* attach to front since we're going up directory tree */
3081 strcpy (path
, dir_name
);
3083 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
3084 /* stop when we see the volume's root directory */
3086 return 1; /* success */
3093 posix_pathname_to_fsspec (ufn
, fs
)
3097 Str255 mac_pathname
;
3099 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
3103 c2pstr (mac_pathname
);
3104 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
3109 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
3114 char mac_pathname
[MAXPATHLEN
];
3116 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
3117 fs
->vRefNum
, fs
->parID
, fs
->name
)
3118 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
3125 readlink (const char *path
, char *buf
, int bufsiz
)
3127 char mac_sym_link_name
[MAXPATHLEN
+1];
3130 Boolean target_is_folder
, was_aliased
;
3131 Str255 directory_name
, mac_pathname
;
3134 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
3137 c2pstr (mac_sym_link_name
);
3138 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
3145 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
3146 if (err
!= noErr
|| !was_aliased
)
3152 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
3159 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
3165 return strlen (buf
);
3169 /* Convert a path to one with aliases fully expanded. */
3172 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
3174 char *q
, temp
[MAXPATHLEN
+1];
3178 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
3185 q
= strchr (p
+ 1, '/');
3187 q
= strchr (p
, '/');
3188 len
= 0; /* loop may not be entered, e.g., for "/" */
3193 strncat (temp
, p
, q
- p
);
3194 len
= readlink (temp
, buf
, bufsiz
);
3197 if (strlen (temp
) + 1 > bufsiz
)
3207 if (len
+ strlen (p
) + 1 >= bufsiz
)
3211 return len
+ strlen (p
);
3216 umask (mode_t numask
)
3218 static mode_t mask
= 022;
3219 mode_t oldmask
= mask
;
3226 chmod (const char *path
, mode_t mode
)
3228 /* say it always succeed for now */
3234 fchmod (int fd
, mode_t mode
)
3236 /* say it always succeed for now */
3242 fchown (int fd
, uid_t owner
, gid_t group
)
3244 /* say it always succeed for now */
3253 return fcntl (oldd
, F_DUPFD
, 0);
3255 /* current implementation of fcntl in fcntl.mac.c simply returns old
3257 return fcntl (oldd
, F_DUPFD
);
3264 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3265 newd if it already exists. Then, attempt to dup oldd. If not
3266 successful, call dup2 recursively until we are, then close the
3267 unsuccessful ones. */
3270 dup2 (int oldd
, int newd
)
3281 ret
= dup2 (oldd
, newd
);
3287 /* let it fail for now */
3304 ioctl (int d
, int request
, void *argp
)
3314 if (fildes
>=0 && fildes
<= 2)
3347 #endif /* __MRC__ */
3351 #if __MSL__ < 0x6000
3359 #endif /* __MWERKS__ */
3361 #endif /* ! MAC_OSX */
3364 /* Return the path to the directory in which Emacs can create
3365 temporary files. The MacOS "temporary items" directory cannot be
3366 used because it removes the file written by a process when it
3367 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3368 again not exactly). And of course Emacs needs to read back the
3369 files written by its subprocesses. So here we write the files to a
3370 directory "Emacs" in the Preferences Folder. This directory is
3371 created if it does not exist. */
3374 get_temp_dir_name ()
3376 static char *temp_dir_name
= NULL
;
3381 char unix_dir_name
[MAXPATHLEN
+1];
3384 /* Cache directory name with pointer temp_dir_name.
3385 Look for it only the first time. */
3388 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
3389 &vol_ref_num
, &dir_id
);
3393 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3396 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
3397 strcat (full_path
, "Emacs:");
3401 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
3404 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
3407 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
3410 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
3411 strcpy (temp_dir_name
, unix_dir_name
);
3414 return temp_dir_name
;
3419 /* Allocate and construct an array of pointers to strings from a list
3420 of strings stored in a 'STR#' resource. The returned pointer array
3421 is stored in the style of argv and environ: if the 'STR#' resource
3422 contains numString strings, a pointer array with numString+1
3423 elements is returned in which the last entry contains a null
3424 pointer. The pointer to the pointer array is passed by pointer in
3425 parameter t. The resource ID of the 'STR#' resource is passed in
3426 parameter StringListID.
3430 get_string_list (char ***t
, short string_list_id
)
3436 h
= GetResource ('STR#', string_list_id
);
3441 num_strings
= * (short *) p
;
3443 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
3444 for (i
= 0; i
< num_strings
; i
++)
3446 short length
= *p
++;
3447 (*t
)[i
] = (char *) malloc (length
+ 1);
3448 strncpy ((*t
)[i
], p
, length
);
3449 (*t
)[i
][length
] = '\0';
3452 (*t
)[num_strings
] = 0;
3457 /* Return no string in case GetResource fails. Bug fixed by
3458 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3459 option (no sym -on implies -opt local). */
3460 *t
= (char **) malloc (sizeof (char *));
3467 get_path_to_system_folder ()
3473 static char system_folder_unix_name
[MAXPATHLEN
+1];
3476 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
3477 &vol_ref_num
, &dir_id
);
3481 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
3484 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
3488 return system_folder_unix_name
;
3494 #define ENVIRON_STRING_LIST_ID 128
3496 /* Get environment variable definitions from STR# resource. */
3503 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
3509 /* Make HOME directory the one Emacs starts up in if not specified
3511 if (getenv ("HOME") == NULL
)
3513 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3516 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
3519 strcpy (environ
[i
], "HOME=");
3520 strcat (environ
[i
], my_passwd_dir
);
3527 /* Make HOME directory the one Emacs starts up in if not specified
3529 if (getenv ("MAIL") == NULL
)
3531 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
3534 char * path_to_system_folder
= get_path_to_system_folder ();
3535 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
3538 strcpy (environ
[i
], "MAIL=");
3539 strcat (environ
[i
], path_to_system_folder
);
3540 strcat (environ
[i
], "Eudora Folder/In");
3548 /* Return the value of the environment variable NAME. */
3551 getenv (const char *name
)
3553 int length
= strlen(name
);
3556 for (e
= environ
; *e
!= 0; e
++)
3557 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
3558 return &(*e
)[length
+ 1];
3560 if (strcmp (name
, "TMPDIR") == 0)
3561 return get_temp_dir_name ();
3568 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3569 char *sys_siglist
[] =
3571 "Zero is not a signal!!!",
3573 "Interactive user interrupt", /* 2 */ "?",
3574 "Floating point exception", /* 4 */ "?", "?", "?",
3575 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3576 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3577 "?", "?", "?", "?", "?", "?", "?", "?",
3581 char *sys_siglist
[] =
3583 "Zero is not a signal!!!",
3585 "Floating point exception",
3586 "Illegal instruction",
3587 "Interactive user interrupt",
3588 "Segment violation",
3591 #else /* not __MRC__ and not __MWERKS__ */
3593 #endif /* not __MRC__ and not __MWERKS__ */
3596 #include <utsname.h>
3599 uname (struct utsname
*name
)
3602 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
3605 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
3606 p2cstr (name
->nodename
);
3614 /* Event class of HLE sent to subprocess. */
3615 const OSType kEmacsSubprocessSend
= 'ESND';
3617 /* Event class of HLE sent back from subprocess. */
3618 const OSType kEmacsSubprocessReply
= 'ERPY';
3622 mystrchr (char *s
, char c
)
3624 while (*s
&& *s
!= c
)
3652 mystrcpy (char *to
, char *from
)
3664 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3665 terminated). The process should run with the default directory
3666 "workdir", read input from "infn", and write output and error to
3667 "outfn" and "errfn", resp. The Process Manager call
3668 LaunchApplication is used to start the subprocess. We use high
3669 level events as the mechanism to pass arguments to the subprocess
3670 and to make Emacs wait for the subprocess to terminate and pass
3671 back a result code. The bulk of the code here packs the arguments
3672 into one message to be passed together with the high level event.
3673 Emacs also sometimes starts a subprocess using a shell to perform
3674 wildcard filename expansion. Since we don't really have a shell on
3675 the Mac, this case is detected and the starting of the shell is
3676 by-passed. We really need to add code here to do filename
3677 expansion to support such functionality.
3679 We can't use this strategy in Carbon because the High Level Event
3680 APIs are not available. */
3683 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
3684 unsigned char **argv
;
3685 const char *workdir
;
3686 const char *infn
, *outfn
, *errfn
;
3688 #if TARGET_API_MAC_CARBON
3690 #else /* not TARGET_API_MAC_CARBON */
3691 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
3692 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
3693 int paramlen
, argc
, newargc
, j
, retries
;
3694 char **newargv
, *param
, *p
;
3697 LaunchParamBlockRec lpbr
;
3698 EventRecord send_event
, reply_event
;
3699 RgnHandle cursor_region_handle
;
3701 unsigned long ref_con
, len
;
3703 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
3705 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
3707 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
3709 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
3712 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
3713 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
3722 /* If a subprocess is invoked with a shell, we receive 3 arguments
3723 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3724 bins>/<command> <command args>" */
3725 j
= strlen (argv
[0]);
3726 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
3727 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
3729 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
3731 /* The arguments for the command in argv[2] are separated by
3732 spaces. Count them and put the count in newargc. */
3733 command
= (char *) alloca (strlen (argv
[2])+2);
3734 strcpy (command
, argv
[2]);
3735 if (command
[strlen (command
) - 1] != ' ')
3736 strcat (command
, " ");
3740 t
= mystrchr (t
, ' ');
3744 t
= mystrchr (t
+1, ' ');
3747 newargv
= (char **) alloca (sizeof (char *) * newargc
);
3750 for (j
= 0; j
< newargc
; j
++)
3752 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
3753 mystrcpy (newargv
[j
], t
);
3756 paramlen
+= strlen (newargv
[j
]) + 1;
3759 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
3761 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
3766 { /* sometimes Emacs call "sh" without a path for the command */
3768 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
3769 strcpy (t
, "~emacs/");
3770 strcat (t
, newargv
[0]);
3773 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
3774 make_number (X_OK
));
3778 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
3782 strcpy (macappname
, tempmacpathname
);
3786 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
3789 newargv
= (char **) alloca (sizeof (char *) * argc
);
3791 for (j
= 1; j
< argc
; j
++)
3793 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
3795 char *t
= strchr (argv
[j
], ' ');
3798 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
3799 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
3800 tempcmdname
[t
-argv
[j
]] = '\0';
3801 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
3804 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3806 strcpy (newargv
[j
], tempmaccmdname
);
3807 strcat (newargv
[j
], t
);
3811 char tempmaccmdname
[MAXPATHLEN
+1];
3812 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3815 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3816 strcpy (newargv
[j
], tempmaccmdname
);
3820 newargv
[j
] = argv
[j
];
3821 paramlen
+= strlen (newargv
[j
]) + 1;
3825 /* After expanding all the arguments, we now know the length of the
3826 parameter block to be sent to the subprocess as a message
3827 attached to the HLE. */
3828 param
= (char *) malloc (paramlen
+ 1);
3834 /* first byte of message contains number of arguments for command */
3835 strcpy (p
, macworkdir
);
3836 p
+= strlen (macworkdir
);
3838 /* null terminate strings sent so it's possible to use strcpy over there */
3839 strcpy (p
, macinfn
);
3840 p
+= strlen (macinfn
);
3842 strcpy (p
, macoutfn
);
3843 p
+= strlen (macoutfn
);
3845 strcpy (p
, macerrfn
);
3846 p
+= strlen (macerrfn
);
3848 for (j
= 1; j
< newargc
; j
++)
3850 strcpy (p
, newargv
[j
]);
3851 p
+= strlen (newargv
[j
]);
3855 c2pstr (macappname
);
3857 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3865 lpbr
.launchBlockID
= extendedBlock
;
3866 lpbr
.launchEPBLength
= extendedBlockLen
;
3867 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3868 lpbr
.launchAppSpec
= &spec
;
3869 lpbr
.launchAppParameters
= NULL
;
3871 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3878 send_event
.what
= kHighLevelEvent
;
3879 send_event
.message
= kEmacsSubprocessSend
;
3880 /* Event ID stored in "where" unused */
3883 /* OS may think current subprocess has terminated if previous one
3884 terminated recently. */
3887 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3888 paramlen
+ 1, receiverIDisPSN
);
3890 while (iErr
== sessClosedErr
&& retries
-- > 0);
3898 cursor_region_handle
= NewRgn ();
3900 /* Wait for the subprocess to finish, when it will send us a ERPY
3901 high level event. */
3903 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3904 cursor_region_handle
)
3905 && reply_event
.message
== kEmacsSubprocessReply
)
3908 /* The return code is sent through the refCon */
3909 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3912 DisposeHandle ((Handle
) cursor_region_handle
);
3917 DisposeHandle ((Handle
) cursor_region_handle
);
3921 #endif /* not TARGET_API_MAC_CARBON */
3926 opendir (const char *dirname
)
3928 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3929 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3933 int len
, vol_name_len
;
3935 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3938 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3940 fully_resolved_name
[len
] = '\0';
3942 strcpy (fully_resolved_name
, true_pathname
);
3944 dirp
= (DIR *) malloc (sizeof(DIR));
3948 /* Handle special case when dirname is "/": sets up for readir to
3949 get all mount volumes. */
3950 if (strcmp (fully_resolved_name
, "/") == 0)
3952 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3953 dirp
->current_index
= 1; /* index for first volume */
3957 /* Handle typical cases: not accessing all mounted volumes. */
3958 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3961 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3962 len
= strlen (mac_pathname
);
3963 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3964 strcat (mac_pathname
, ":");
3966 /* Extract volume name */
3967 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3968 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3969 vol_name
[vol_name_len
] = '\0';
3970 strcat (vol_name
, ":");
3972 c2pstr (mac_pathname
);
3973 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3974 /* using full pathname so vRefNum and DirID ignored */
3975 cipb
.hFileInfo
.ioVRefNum
= 0;
3976 cipb
.hFileInfo
.ioDirID
= 0;
3977 cipb
.hFileInfo
.ioFDirIndex
= 0;
3978 /* set to 0 to get information about specific dir or file */
3980 errno
= PBGetCatInfo (&cipb
, false);
3987 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3988 return 0; /* not a directory */
3990 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3991 dirp
->getting_volumes
= 0;
3992 dirp
->current_index
= 1; /* index for first file/directory */
3995 vpb
.ioNamePtr
= vol_name
;
3996 /* using full pathname so vRefNum and DirID ignored */
3998 vpb
.ioVolIndex
= -1;
3999 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
4006 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
4023 HParamBlockRec hpblock
;
4025 static struct dirent s_dirent
;
4026 static Str255 s_name
;
4030 /* Handle the root directory containing the mounted volumes. Call
4031 PBHGetVInfo specifying an index to obtain the info for a volume.
4032 PBHGetVInfo returns an error when it receives an index beyond the
4033 last volume, at which time we should return a nil dirent struct
4035 if (dp
->getting_volumes
)
4037 hpblock
.volumeParam
.ioNamePtr
= s_name
;
4038 hpblock
.volumeParam
.ioVRefNum
= 0;
4039 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
4041 errno
= PBHGetVInfo (&hpblock
, false);
4049 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
4051 dp
->current_index
++;
4053 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
4054 s_dirent
.d_name
= s_name
;
4060 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
4061 cipb
.hFileInfo
.ioNamePtr
= s_name
;
4062 /* location to receive filename returned */
4064 /* return only visible files */
4068 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
4069 /* directory ID found by opendir */
4070 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
4072 errno
= PBGetCatInfo (&cipb
, false);
4079 /* insist on a visible entry */
4080 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
4081 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
4083 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
4085 dp
->current_index
++;
4098 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
4099 /* value unimportant: non-zero for valid file */
4100 s_dirent
.d_name
= s_name
;
4110 char mac_pathname
[MAXPATHLEN
+1];
4111 Str255 directory_name
;
4115 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
4118 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
4124 #endif /* ! MAC_OSX */
4128 initialize_applescript ()
4133 /* if open fails, as_scripting_component is set to NULL. Its
4134 subsequent use in OSA calls will fail with badComponentInstance
4136 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
4137 kAppleScriptSubtype
);
4139 null_desc
.descriptorType
= typeNull
;
4140 null_desc
.dataHandle
= 0;
4141 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
4142 kOSANullScript
, &as_script_context
);
4144 as_script_context
= kOSANullScript
;
4145 /* use default context if create fails */
4150 terminate_applescript()
4152 OSADispose (as_scripting_component
, as_script_context
);
4153 CloseComponent (as_scripting_component
);
4156 /* Convert a lisp string to the 4 byte character code. */
4159 mac_get_code_from_arg(Lisp_Object arg
, OSType defCode
)
4168 /* check type string */
4170 if (SBYTES (arg
) != 4)
4172 error ("Wrong argument: need string of length 4 for code");
4174 result
= EndianU32_BtoN (*((UInt32
*) SDATA (arg
)));
4179 /* Convert the 4 byte character code into a 4 byte string. */
4182 mac_get_object_from_code(OSType defCode
)
4184 UInt32 code
= EndianU32_NtoB (defCode
);
4186 return make_unibyte_string ((char *)&code
, 4);
4190 DEFUN ("mac-get-file-creator", Fmac_get_file_creator
, Smac_get_file_creator
, 1, 1, 0,
4191 doc
: /* Get the creator code of FILENAME as a four character string. */)
4193 Lisp_Object filename
;
4201 Lisp_Object result
= Qnil
;
4202 CHECK_STRING (filename
);
4204 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4207 filename
= Fexpand_file_name (filename
, Qnil
);
4211 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4213 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4216 if (status
== noErr
)
4219 FSCatalogInfo catalogInfo
;
4221 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4222 &catalogInfo
, NULL
, NULL
, NULL
);
4226 status
= FSpGetFInfo (&fss
, &finder_info
);
4228 if (status
== noErr
)
4231 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
);
4233 result
= mac_get_object_from_code (finder_info
.fdCreator
);
4238 if (status
!= noErr
) {
4239 error ("Error while getting file information.");
4244 DEFUN ("mac-get-file-type", Fmac_get_file_type
, Smac_get_file_type
, 1, 1, 0,
4245 doc
: /* Get the type code of FILENAME as a four character string. */)
4247 Lisp_Object filename
;
4255 Lisp_Object result
= Qnil
;
4256 CHECK_STRING (filename
);
4258 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4261 filename
= Fexpand_file_name (filename
, Qnil
);
4265 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4267 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4270 if (status
== noErr
)
4273 FSCatalogInfo catalogInfo
;
4275 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4276 &catalogInfo
, NULL
, NULL
, NULL
);
4280 status
= FSpGetFInfo (&fss
, &finder_info
);
4282 if (status
== noErr
)
4285 result
= mac_get_object_from_code(((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
);
4287 result
= mac_get_object_from_code (finder_info
.fdType
);
4292 if (status
!= noErr
) {
4293 error ("Error while getting file information.");
4298 DEFUN ("mac-set-file-creator", Fmac_set_file_creator
, Smac_set_file_creator
, 1, 2, 0,
4299 doc
: /* Set creator code of file FILENAME to CODE.
4300 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4301 assumed. Return non-nil if successful. */)
4303 Lisp_Object filename
, code
;
4312 CHECK_STRING (filename
);
4314 cCode
= mac_get_code_from_arg(code
, 'EMAx');
4316 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4319 filename
= Fexpand_file_name (filename
, Qnil
);
4323 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4325 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4328 if (status
== noErr
)
4331 FSCatalogInfo catalogInfo
;
4333 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4334 &catalogInfo
, NULL
, NULL
, &parentDir
);
4338 status
= FSpGetFInfo (&fss
, &finder_info
);
4340 if (status
== noErr
)
4343 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileCreator
= cCode
;
4344 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4345 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4347 finder_info
.fdCreator
= cCode
;
4348 status
= FSpSetFInfo (&fss
, &finder_info
);
4353 if (status
!= noErr
) {
4354 error ("Error while setting creator information.");
4359 DEFUN ("mac-set-file-type", Fmac_set_file_type
, Smac_set_file_type
, 2, 2, 0,
4360 doc
: /* Set file code of file FILENAME to CODE.
4361 CODE must be a 4-character string. Return non-nil if successful. */)
4363 Lisp_Object filename
, code
;
4372 CHECK_STRING (filename
);
4374 cCode
= mac_get_code_from_arg(code
, 0); /* Default to empty code*/
4376 if (NILP(Ffile_exists_p(filename
)) || !NILP(Ffile_directory_p(filename
))) {
4379 filename
= Fexpand_file_name (filename
, Qnil
);
4383 status
= FSPathMakeRef(SDATA(ENCODE_FILE(filename
)), &fref
, NULL
);
4385 status
= posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename
)), &fss
);
4388 if (status
== noErr
)
4391 FSCatalogInfo catalogInfo
;
4393 status
= FSGetCatalogInfo(&fref
, kFSCatInfoFinderInfo
,
4394 &catalogInfo
, NULL
, NULL
, &parentDir
);
4398 status
= FSpGetFInfo (&fss
, &finder_info
);
4400 if (status
== noErr
)
4403 ((FileInfo
*)&catalogInfo
.finderInfo
)->fileType
= cCode
;
4404 status
= FSSetCatalogInfo(&fref
, kFSCatInfoFinderInfo
, &catalogInfo
);
4405 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4407 finder_info
.fdType
= cCode
;
4408 status
= FSpSetFInfo (&fss
, &finder_info
);
4413 if (status
!= noErr
) {
4414 error ("Error while setting creator information.");
4420 /* Compile and execute the AppleScript SCRIPT and return the error
4421 status as function value. A zero is returned if compilation and
4422 execution is successful, in which case *RESULT is set to a Lisp
4423 string containing the resulting script value. Otherwise, the Mac
4424 error code is returned and *RESULT is set to an error Lisp string.
4425 For documentation on the MacOS scripting architecture, see Inside
4426 Macintosh - Interapplication Communications: Scripting
4430 do_applescript (script
, result
)
4431 Lisp_Object script
, *result
;
4433 AEDesc script_desc
, result_desc
, error_desc
, *desc
= NULL
;
4439 if (!as_scripting_component
)
4440 initialize_applescript();
4442 error
= AECreateDesc (typeChar
, SDATA (script
), SBYTES (script
),
4447 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
4448 typeChar
, kOSAModeNull
, &result_desc
);
4450 if (osaerror
== noErr
)
4451 /* success: retrieve resulting script value */
4452 desc
= &result_desc
;
4453 else if (osaerror
== errOSAScriptError
)
4454 /* error executing AppleScript: retrieve error message */
4455 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
4461 #if TARGET_API_MAC_CARBON
4462 *result
= make_uninit_string (AEGetDescDataSize (desc
));
4463 AEGetDescData (desc
, SDATA (*result
), SBYTES (*result
));
4464 #else /* not TARGET_API_MAC_CARBON */
4465 *result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
4466 memcpy (SDATA (*result
), *(desc
->dataHandle
), SBYTES (*result
));
4467 #endif /* not TARGET_API_MAC_CARBON */
4468 AEDisposeDesc (desc
);
4471 AEDisposeDesc (&script_desc
);
4477 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
4478 doc
: /* Compile and execute AppleScript SCRIPT and return the result.
4479 If compilation and execution are successful, the resulting script
4480 value is returned as a string. Otherwise the function aborts and
4481 displays the error message returned by the AppleScript scripting
4489 CHECK_STRING (script
);
4492 status
= do_applescript (script
, &result
);
4496 else if (!STRINGP (result
))
4497 error ("AppleScript error %d", status
);
4499 error ("%s", SDATA (result
));
4503 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
4504 Smac_file_name_to_posix
, 1, 1, 0,
4505 doc
: /* Convert Macintosh FILENAME to Posix form. */)
4507 Lisp_Object filename
;
4509 char posix_filename
[MAXPATHLEN
+1];
4511 CHECK_STRING (filename
);
4513 if (mac_to_posix_pathname (SDATA (filename
), posix_filename
, MAXPATHLEN
))
4514 return build_string (posix_filename
);
4520 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
4521 Sposix_file_name_to_mac
, 1, 1, 0,
4522 doc
: /* Convert Posix FILENAME to Mac form. */)
4524 Lisp_Object filename
;
4526 char mac_filename
[MAXPATHLEN
+1];
4528 CHECK_STRING (filename
);
4530 if (posix_to_mac_pathname (SDATA (filename
), mac_filename
, MAXPATHLEN
))
4531 return build_string (mac_filename
);
4537 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data
, Smac_coerce_ae_data
, 3, 3, 0,
4538 doc
: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4539 Each type should be a string of length 4 or the symbol
4540 `undecoded-file-name'. */)
4541 (src_type
, src_data
, dst_type
)
4542 Lisp_Object src_type
, src_data
, dst_type
;
4545 Lisp_Object result
= Qnil
;
4546 DescType src_desc_type
, dst_desc_type
;
4549 CHECK_STRING (src_data
);
4550 if (EQ (src_type
, Qundecoded_file_name
))
4551 src_desc_type
= TYPE_FILE_NAME
;
4553 src_desc_type
= mac_get_code_from_arg (src_type
, 0);
4555 if (EQ (dst_type
, Qundecoded_file_name
))
4556 dst_desc_type
= TYPE_FILE_NAME
;
4558 dst_desc_type
= mac_get_code_from_arg (dst_type
, 0);
4561 err
= AECoercePtr (src_desc_type
, SDATA (src_data
), SBYTES (src_data
),
4562 dst_desc_type
, &dst_desc
);
4565 result
= Fcdr (mac_aedesc_to_lisp (&dst_desc
));
4566 AEDisposeDesc (&dst_desc
);
4574 #if TARGET_API_MAC_CARBON
4575 static Lisp_Object Qxml
, Qmime_charset
;
4576 static Lisp_Object QNFD
, QNFKD
, QNFC
, QNFKC
, QHFS_plus_D
, QHFS_plus_C
;
4578 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
4579 doc
: /* Return the application preference value for KEY.
4580 KEY is either a string specifying a preference key, or a list of key
4581 strings. If it is a list, the (i+1)-th element is used as a key for
4582 the CFDictionary value obtained by the i-th element. Return nil if
4583 lookup is failed at some stage.
4585 Optional arg APPLICATION is an application ID string. If omitted or
4586 nil, that stands for the current application.
4588 Optional arg FORMAT specifies the data format of the return value. If
4589 omitted or nil, each Core Foundation object is converted into a
4590 corresponding Lisp object as follows:
4592 Core Foundation Lisp Tag
4593 ------------------------------------------------------------
4594 CFString Multibyte string string
4595 CFNumber Integer or float number
4596 CFBoolean Symbol (t or nil) boolean
4597 CFDate List of three integers date
4598 (cf. `current-time')
4599 CFData Unibyte string data
4600 CFArray Vector array
4601 CFDictionary Alist or hash table dictionary
4602 (depending on HASH-BOUND)
4604 If it is t, a symbol that represents the type of the original Core
4605 Foundation object is prepended. If it is `xml', the value is returned
4606 as an XML representation.
4608 Optional arg HASH-BOUND specifies which kinds of the list objects,
4609 alists or hash tables, are used as the targets of the conversion from
4610 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4611 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4612 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4614 (key
, application
, format
, hash_bound
)
4615 Lisp_Object key
, application
, format
, hash_bound
;
4617 CFStringRef app_id
, key_str
;
4618 CFPropertyListRef app_plist
= NULL
, plist
;
4619 Lisp_Object result
= Qnil
, tmp
;
4622 key
= Fcons (key
, Qnil
);
4626 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4627 CHECK_STRING_CAR (tmp
);
4628 CHECK_LIST_END (tmp
, key
);
4630 if (!NILP (application
))
4631 CHECK_STRING (application
);
4632 CHECK_SYMBOL (format
);
4633 if (!NILP (hash_bound
))
4634 CHECK_NUMBER (hash_bound
);
4638 app_id
= kCFPreferencesCurrentApplication
;
4639 if (!NILP (application
))
4641 app_id
= cfstring_create_with_string (application
);
4645 key_str
= cfstring_create_with_string (XCAR (key
));
4646 if (key_str
== NULL
)
4648 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4649 CFRelease (key_str
);
4650 if (app_plist
== NULL
)
4654 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4656 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4658 key_str
= cfstring_create_with_string (XCAR (key
));
4659 if (key_str
== NULL
)
4661 plist
= CFDictionaryGetValue (plist
, key_str
);
4662 CFRelease (key_str
);
4669 if (EQ (format
, Qxml
))
4671 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4674 result
= cfdata_to_lisp (data
);
4679 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4680 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4685 CFRelease (app_plist
);
4694 static CFStringEncoding
4695 get_cfstring_encoding_from_lisp (obj
)
4698 CFStringRef iana_name
;
4699 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4702 return kCFStringEncodingUnicode
;
4707 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4709 Lisp_Object coding_spec
, plist
;
4711 coding_spec
= Fget (obj
, Qcoding_system
);
4712 plist
= XVECTOR (coding_spec
)->contents
[3];
4713 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4717 obj
= SYMBOL_NAME (obj
);
4721 iana_name
= cfstring_create_with_string (obj
);
4724 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4725 CFRelease (iana_name
);
4732 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4734 cfstring_create_normalized (str
, symbol
)
4739 TextEncodingVariant variant
;
4740 float initial_mag
= 0.0;
4741 CFStringRef result
= NULL
;
4743 if (EQ (symbol
, QNFD
))
4744 form
= kCFStringNormalizationFormD
;
4745 else if (EQ (symbol
, QNFKD
))
4746 form
= kCFStringNormalizationFormKD
;
4747 else if (EQ (symbol
, QNFC
))
4748 form
= kCFStringNormalizationFormC
;
4749 else if (EQ (symbol
, QNFKC
))
4750 form
= kCFStringNormalizationFormKC
;
4751 else if (EQ (symbol
, QHFS_plus_D
))
4753 variant
= kUnicodeHFSPlusDecompVariant
;
4756 else if (EQ (symbol
, QHFS_plus_C
))
4758 variant
= kUnicodeHFSPlusCompVariant
;
4764 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4768 CFStringNormalize (mut_str
, form
);
4772 else if (initial_mag
> 0.0)
4774 UnicodeToTextInfo uni
= NULL
;
4777 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4779 ByteCount out_read
, out_size
, out_len
;
4781 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4783 kTextEncodingDefaultFormat
);
4784 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4786 kTextEncodingDefaultFormat
);
4787 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4789 length
= CFStringGetLength (str
);
4790 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4794 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4795 if (in_text
== NULL
)
4797 buffer
= xmalloc (sizeof (UniChar
) * length
);
4798 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4803 err
= CreateUnicodeToTextInfo (&map
, &uni
);
4804 while (err
== noErr
)
4806 out_buf
= xmalloc (out_size
);
4807 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4809 kUnicodeDefaultDirectionMask
,
4810 0, NULL
, NULL
, NULL
,
4811 out_size
, &out_read
, &out_len
,
4813 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4822 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4823 out_len
/ sizeof (UniChar
));
4825 DisposeUnicodeToTextInfo (&uni
);
4841 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4842 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4843 The conversion is performed using the converter provided by the system.
4844 Each encoding is specified by either a coding system symbol, a mime
4845 charset string, or an integer as a CFStringEncoding value. Nil for
4846 encoding means UTF-16 in native byte order, no byte order mark.
4847 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4848 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4849 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4850 On successful conversion, return the result string, else return nil. */)
4851 (string
, source
, target
, normalization_form
)
4852 Lisp_Object string
, source
, target
, normalization_form
;
4854 Lisp_Object result
= Qnil
;
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
);
4867 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4868 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4870 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4871 use string_as_unibyte which works as well, except for the fact that
4872 it's too permissive (it doesn't check that the multibyte string only
4873 contain single-byte chars). */
4874 string
= Fstring_as_unibyte (string
);
4875 if (src_encoding
!= kCFStringEncodingInvalidId
4876 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4877 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4878 src_encoding
, !NILP (source
));
4879 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4882 CFStringRef saved_str
= str
;
4884 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4885 CFRelease (saved_str
);
4890 CFIndex str_len
, buf_len
;
4892 str_len
= CFStringGetLength (str
);
4893 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4894 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4896 result
= make_uninit_string (buf_len
);
4897 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4898 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4907 #endif /* TARGET_API_MAC_CARBON */
4911 mac_get_system_locale ()
4919 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4920 region
= GetScriptManagerVariable (smRegionCode
);
4921 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4923 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4926 return build_string (str
);
4934 extern int inhibit_window_system
;
4935 extern int noninteractive
;
4937 /* Unlike in X11, window events in Carbon do not come from sockets.
4938 So we cannot simply use `select' to monitor two kinds of inputs:
4939 window events and process outputs. We emulate such functionality
4940 by regarding fd 0 as the window event channel and simultaneously
4941 monitoring both kinds of input channels. It is implemented by
4942 dividing into some cases:
4943 1. The window event channel is not involved.
4945 2. Sockets are not involved.
4946 -> Use ReceiveNextEvent.
4947 3. [If SELECT_USE_CFSOCKET is defined]
4948 Only the window event channel and socket read channels are
4949 involved, and timeout is not too short (greater than
4950 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4951 -> Create CFSocket for each socket and add it into the current
4952 event RunLoop so that a `ready-to-read' event can be posted
4953 to the event queue that is also used for window events. Then
4954 ReceiveNextEvent can wait for both kinds of inputs.
4956 -> Periodically poll the window input channel while repeatedly
4957 executing `select' with a short timeout
4958 (SELECT_POLLING_PERIOD_USEC microseconds). */
4960 #define SELECT_POLLING_PERIOD_USEC 20000
4961 #ifdef SELECT_USE_CFSOCKET
4962 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4963 #define EVENT_CLASS_SOCK 'Sock'
4966 socket_callback (s
, type
, address
, data
, info
)
4968 CFSocketCallBackType type
;
4975 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
4976 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
4977 ReleaseEvent (event
);
4979 #endif /* SELECT_USE_CFSOCKET */
4982 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
4987 struct timeval
*timeout
;
4992 r
= select (n
, rfds
, wfds
, efds
, timeout
);
4996 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
4997 kEventLeaveInQueue
, NULL
);
5008 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
5009 #undef SELECT_INVALIDATE_CFSOCKET
5013 sys_select (n
, rfds
, wfds
, efds
, timeout
)
5018 struct timeval
*timeout
;
5022 EMACS_TIME select_timeout
;
5024 if (inhibit_window_system
|| noninteractive
5025 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
5026 return select (n
, rfds
, wfds
, efds
, timeout
);
5030 if (wfds
== NULL
&& efds
== NULL
)
5033 SELECT_TYPE orfds
= *rfds
;
5035 EventTimeout timeout_sec
=
5037 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5038 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5039 : kEventDurationForever
);
5041 for (i
= 1; i
< n
; i
++)
5042 if (FD_ISSET (i
, rfds
))
5048 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
5049 kEventLeaveInQueue
, NULL
);
5061 mac_prepare_for_quickdraw (NULL
);
5063 /* Avoid initial overhead of RunLoop setup for the case that
5064 some input is already available. */
5065 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5066 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
5067 if (r
!= 0 || timeout_sec
== 0.0)
5072 #ifdef SELECT_USE_CFSOCKET
5073 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
5074 goto poll_periodically
;
5077 CFRunLoopRef runloop
=
5078 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5079 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
5080 #ifdef SELECT_INVALIDATE_CFSOCKET
5081 CFSocketRef
*shead
, *s
;
5083 CFRunLoopSourceRef
*shead
, *s
;
5088 #ifdef SELECT_INVALIDATE_CFSOCKET
5089 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
5091 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
5094 for (i
= 1; i
< n
; i
++)
5095 if (FD_ISSET (i
, rfds
))
5097 CFSocketRef socket
=
5098 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
5099 socket_callback
, NULL
);
5100 CFRunLoopSourceRef source
=
5101 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
5103 #ifdef SELECT_INVALIDATE_CFSOCKET
5104 CFSocketSetSocketFlags (socket
, 0);
5106 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
5107 #ifdef SELECT_INVALIDATE_CFSOCKET
5117 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
5122 #ifdef SELECT_INVALIDATE_CFSOCKET
5123 CFSocketInvalidate (*s
);
5125 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
5140 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
5141 GetEventTypeCount (specs
),
5143 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5144 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
5151 #endif /* SELECT_USE_CFSOCKET */
5156 EMACS_TIME end_time
, now
, remaining_time
;
5157 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
5165 remaining_time
= *timeout
;
5166 EMACS_GET_TIME (now
);
5167 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5172 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5173 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5174 select_timeout
= remaining_time
;
5175 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
5187 EMACS_GET_TIME (now
);
5188 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5191 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5202 /* Set up environment variables so that Emacs can correctly find its
5203 support files when packaged as an application bundle. Directories
5204 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5205 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5206 by `make install' by default can instead be placed in
5207 .../Emacs.app/Contents/Resources/ and
5208 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5209 is changed only if it is not already set. Presumably if the user
5210 sets an environment variable, he will want to use files in his path
5211 instead of ones in the application bundle. */
5213 init_mac_osx_environment ()
5217 CFStringRef cf_app_bundle_pathname
;
5218 int app_bundle_pathname_len
;
5219 char *app_bundle_pathname
;
5223 /* Initialize locale related variables. */
5224 mac_system_script_code
=
5225 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5226 Vmac_system_locale
= mac_get_system_locale ();
5228 /* Fetch the pathname of the application bundle as a C string into
5229 app_bundle_pathname. */
5231 bundle
= CFBundleGetMainBundle ();
5232 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5234 /* We could not find the bundle identifier. For now, prevent
5235 the fatal error by bringing it up in the terminal. */
5236 inhibit_window_system
= 1;
5240 bundleURL
= CFBundleCopyBundleURL (bundle
);
5244 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5245 kCFURLPOSIXPathStyle
);
5246 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5247 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5249 if (!CFStringGetCString (cf_app_bundle_pathname
,
5250 app_bundle_pathname
,
5251 app_bundle_pathname_len
+ 1,
5252 kCFStringEncodingISOLatin1
))
5254 CFRelease (cf_app_bundle_pathname
);
5258 CFRelease (cf_app_bundle_pathname
);
5260 /* P should have sufficient room for the pathname of the bundle plus
5261 the subpath in it leading to the respective directories. Q
5262 should have three times that much room because EMACSLOADPATH can
5263 have the value "<path to lisp dir>:<path to leim dir>:<path to
5265 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5266 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5267 if (!getenv ("EMACSLOADPATH"))
5271 strcpy (p
, app_bundle_pathname
);
5272 strcat (p
, "/Contents/Resources/lisp");
5273 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5276 strcpy (p
, app_bundle_pathname
);
5277 strcat (p
, "/Contents/Resources/leim");
5278 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5285 strcpy (p
, app_bundle_pathname
);
5286 strcat (p
, "/Contents/Resources/site-lisp");
5287 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5295 setenv ("EMACSLOADPATH", q
, 1);
5298 if (!getenv ("EMACSPATH"))
5302 strcpy (p
, app_bundle_pathname
);
5303 strcat (p
, "/Contents/MacOS/libexec");
5304 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5307 strcpy (p
, app_bundle_pathname
);
5308 strcat (p
, "/Contents/MacOS/bin");
5309 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5317 setenv ("EMACSPATH", q
, 1);
5320 if (!getenv ("EMACSDATA"))
5322 strcpy (p
, app_bundle_pathname
);
5323 strcat (p
, "/Contents/Resources/etc");
5324 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5325 setenv ("EMACSDATA", p
, 1);
5328 if (!getenv ("EMACSDOC"))
5330 strcpy (p
, app_bundle_pathname
);
5331 strcat (p
, "/Contents/Resources/etc");
5332 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5333 setenv ("EMACSDOC", p
, 1);
5336 if (!getenv ("INFOPATH"))
5338 strcpy (p
, app_bundle_pathname
);
5339 strcat (p
, "/Contents/Resources/info");
5340 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5341 setenv ("INFOPATH", p
, 1);
5344 #endif /* MAC_OSX */
5350 Qundecoded_file_name
= intern ("undecoded-file-name");
5351 staticpro (&Qundecoded_file_name
);
5353 #if TARGET_API_MAC_CARBON
5354 Qstring
= intern ("string"); staticpro (&Qstring
);
5355 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5356 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5357 Qdate
= intern ("date"); staticpro (&Qdate
);
5358 Qdata
= intern ("data"); staticpro (&Qdata
);
5359 Qarray
= intern ("array"); staticpro (&Qarray
);
5360 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5362 Qxml
= intern ("xml");
5365 Qmime_charset
= intern ("mime-charset");
5366 staticpro (&Qmime_charset
);
5368 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5369 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5370 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5371 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5372 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5373 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5379 for (i
= 0; i
< sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]); i
++)
5381 ae_attr_table
[i
].symbol
= intern (ae_attr_table
[i
].name
);
5382 staticpro (&ae_attr_table
[i
].symbol
);
5386 defsubr (&Smac_coerce_ae_data
);
5387 #if TARGET_API_MAC_CARBON
5388 defsubr (&Smac_get_preference
);
5389 defsubr (&Smac_code_convert_string
);
5392 defsubr (&Smac_set_file_creator
);
5393 defsubr (&Smac_set_file_type
);
5394 defsubr (&Smac_get_file_creator
);
5395 defsubr (&Smac_get_file_type
);
5396 defsubr (&Sdo_applescript
);
5397 defsubr (&Smac_file_name_to_posix
);
5398 defsubr (&Sposix_file_name_to_mac
);
5400 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5401 doc
: /* The system script code. */);
5402 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5404 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5405 doc
: /* The system locale identifier string.
5406 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5407 information is not included. */);
5408 Vmac_system_locale
= mac_get_system_locale ();
5411 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5412 (do not change this comment) */