1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, 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
;
82 #if TARGET_API_MAC_CARBON
83 static int wakeup_from_rne_enabled_p
= 0;
84 #define ENABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 1)
85 #define DISABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 0)
87 #define ENABLE_WAKEUP_FROM_RNE 0
88 #define DISABLE_WAKEUP_FROM_RNE 0
92 static OSErr posix_pathname_to_fsspec
P_ ((const char *, FSSpec
*));
93 static OSErr fsspec_to_posix_pathname
P_ ((const FSSpec
*, char *, int));
96 /* When converting from Mac to Unix pathnames, /'s in folder names are
97 converted to :'s. This function, used in copying folder names,
98 performs a strncat and converts all character a to b in the copy of
99 the string s2 appended to the end of s1. */
102 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
104 int l1
= strlen (s1
);
105 int l2
= strlen (s2
);
110 for (i
= 0; i
< l2
; i
++)
119 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
120 that does not begin with a ':' and contains at least one ':'. A Mac
121 full pathname causes a '/' to be prepended to the Posix pathname.
122 The algorithm for the rest of the pathname is as follows:
123 For each segment between two ':',
124 if it is non-null, copy as is and then add a '/' at the end,
125 otherwise, insert a "../" into the Posix pathname.
126 Returns 1 if successful; 0 if fails. */
129 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
131 const char *p
, *q
, *pe
;
138 p
= strchr (mfn
, ':');
139 if (p
!= 0 && p
!= mfn
) /* full pathname */
146 pe
= mfn
+ strlen (mfn
);
153 { /* two consecutive ':' */
154 if (strlen (ufn
) + 3 >= ufnbuflen
)
160 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
162 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
169 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
171 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
172 /* no separator for last one */
181 extern char *get_temp_dir_name ();
184 /* Convert a Posix pathname to Mac form. Approximately reverse of the
185 above in algorithm. */
188 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
190 const char *p
, *q
, *pe
;
191 char expanded_pathname
[MAXPATHLEN
+1];
200 /* Check for and handle volume names. Last comparison: strangely
201 somewhere "/.emacs" is passed. A temporary fix for now. */
202 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
204 if (strlen (p
) + 1 > mfnbuflen
)
211 /* expand to emacs dir found by init_emacs_passwd_dir */
212 if (strncmp (p
, "~emacs/", 7) == 0)
214 struct passwd
*pw
= getpwnam ("emacs");
216 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
218 strcpy (expanded_pathname
, pw
->pw_dir
);
219 strcat (expanded_pathname
, p
);
220 p
= expanded_pathname
;
221 /* now p points to the pathname with emacs dir prefix */
223 else if (strncmp (p
, "/tmp/", 5) == 0)
225 char *t
= get_temp_dir_name ();
227 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
229 strcpy (expanded_pathname
, t
);
230 strcat (expanded_pathname
, p
);
231 p
= expanded_pathname
;
232 /* now p points to the pathname with emacs dir prefix */
234 else if (*p
!= '/') /* relative pathname */
246 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
248 if (strlen (mfn
) + 1 >= mfnbuflen
)
254 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
256 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
263 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
265 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
274 /***********************************************************************
275 Conversions on Apple event objects
276 ***********************************************************************/
278 static Lisp_Object Qundecoded_file_name
;
285 {{keyTransactionIDAttr
, "transaction-id"},
286 {keyReturnIDAttr
, "return-id"},
287 {keyEventClassAttr
, "event-class"},
288 {keyEventIDAttr
, "event-id"},
289 {keyAddressAttr
, "address"},
290 {keyOptionalKeywordAttr
, "optional-keyword"},
291 {keyTimeoutAttr
, "timeout"},
292 {keyInteractLevelAttr
, "interact-level"},
293 {keyEventSourceAttr
, "event-source"},
294 /* {keyMissedKeywordAttr, "missed-keyword"}, */
295 {keyOriginalAddressAttr
, "original-address"},
296 {keyReplyRequestedAttr
, "reply-requested"},
297 {KEY_EMACS_SUSPENSION_ID_ATTR
, "emacs-suspension-id"}
301 mac_aelist_to_lisp (desc_list
)
302 const AEDescList
*desc_list
;
306 Lisp_Object result
, elem
;
313 err
= AECountItems (desc_list
, &count
);
323 keyword
= ae_attr_table
[count
- 1].keyword
;
324 err
= AESizeOfAttribute (desc_list
, keyword
, &desc_type
, &size
);
327 err
= AESizeOfNthItem (desc_list
, count
, &desc_type
, &size
);
336 err
= AEGetAttributeDesc (desc_list
, keyword
, typeWildCard
,
339 err
= AEGetNthDesc (desc_list
, count
, typeWildCard
,
343 elem
= mac_aelist_to_lisp (&desc
);
344 AEDisposeDesc (&desc
);
348 if (desc_type
== typeNull
)
352 elem
= make_uninit_string (size
);
354 err
= AEGetAttributePtr (desc_list
, keyword
, typeWildCard
,
355 &desc_type
, SDATA (elem
),
358 err
= AEGetNthPtr (desc_list
, count
, typeWildCard
, &keyword
,
359 &desc_type
, SDATA (elem
), size
, &size
);
363 desc_type
= EndianU32_NtoB (desc_type
);
364 elem
= Fcons (make_unibyte_string ((char *) &desc_type
, 4), elem
);
368 if (err
== noErr
|| desc_list
->descriptorType
== typeAEList
)
371 elem
= Qnil
; /* Don't skip elements in AEList. */
372 else if (desc_list
->descriptorType
!= typeAEList
)
375 elem
= Fcons (ae_attr_table
[count
-1].symbol
, elem
);
378 keyword
= EndianU32_NtoB (keyword
);
379 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4),
384 result
= Fcons (elem
, result
);
390 if (desc_list
->descriptorType
== typeAppleEvent
&& !attribute_p
)
393 count
= sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]);
397 desc_type
= EndianU32_NtoB (desc_list
->descriptorType
);
398 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
402 mac_aedesc_to_lisp (desc
)
406 DescType desc_type
= desc
->descriptorType
;
418 return mac_aelist_to_lisp (desc
);
420 /* The following one is much simpler, but creates and disposes
421 of Apple event descriptors many times. */
428 err
= AECountItems (desc
, &count
);
434 err
= AEGetNthDesc (desc
, count
, typeWildCard
, &keyword
, &desc1
);
437 elem
= mac_aedesc_to_lisp (&desc1
);
438 AEDisposeDesc (&desc1
);
439 if (desc_type
!= typeAEList
)
441 keyword
= EndianU32_NtoB (keyword
);
442 elem
= Fcons (make_unibyte_string ((char *) &keyword
, 4), elem
);
444 result
= Fcons (elem
, result
);
452 #if TARGET_API_MAC_CARBON
453 result
= make_uninit_string (AEGetDescDataSize (desc
));
454 err
= AEGetDescData (desc
, SDATA (result
), SBYTES (result
));
456 result
= make_uninit_string (GetHandleSize (desc
->dataHandle
));
457 memcpy (SDATA (result
), *(desc
->dataHandle
), SBYTES (result
));
465 desc_type
= EndianU32_NtoB (desc_type
);
466 return Fcons (make_unibyte_string ((char *) &desc_type
, 4), result
);
470 mac_ae_put_lisp (desc
, keyword_or_index
, obj
)
472 UInt32 keyword_or_index
;
477 if (!(desc
->descriptorType
== typeAppleEvent
478 || desc
->descriptorType
== typeAERecord
479 || desc
->descriptorType
== typeAEList
))
480 return errAEWrongDataType
;
482 if (CONSP (obj
) && STRINGP (XCAR (obj
)) && SBYTES (XCAR (obj
)) == 4)
484 DescType desc_type1
= EndianU32_BtoN (*((UInt32
*) SDATA (XCAR (obj
))));
485 Lisp_Object data
= XCDR (obj
), rest
;
496 err
= AECreateList (NULL
, 0, desc_type1
== typeAERecord
, &desc1
);
499 for (rest
= data
; CONSP (rest
); rest
= XCDR (rest
))
501 UInt32 keyword_or_index1
= 0;
502 Lisp_Object elem
= XCAR (rest
);
504 if (desc_type1
== typeAERecord
)
506 if (CONSP (elem
) && STRINGP (XCAR (elem
))
507 && SBYTES (XCAR (elem
)) == 4)
510 EndianU32_BtoN (*((UInt32
*)
511 SDATA (XCAR (elem
))));
518 err
= mac_ae_put_lisp (&desc1
, keyword_or_index1
, elem
);
525 if (desc
->descriptorType
== typeAEList
)
526 err
= AEPutDesc (desc
, keyword_or_index
, &desc1
);
528 err
= AEPutParamDesc (desc
, keyword_or_index
, &desc1
);
531 AEDisposeDesc (&desc1
);
538 if (desc
->descriptorType
== typeAEList
)
539 err
= AEPutPtr (desc
, keyword_or_index
, desc_type1
,
540 SDATA (data
), SBYTES (data
));
542 err
= AEPutParamPtr (desc
, keyword_or_index
, desc_type1
,
543 SDATA (data
), SBYTES (data
));
548 if (desc
->descriptorType
== typeAEList
)
549 err
= AEPutPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
551 err
= AEPutParamPtr (desc
, keyword_or_index
, typeNull
, NULL
, 0);
557 mac_coerce_file_name_ptr (type_code
, data_ptr
, data_size
,
558 to_type
, handler_refcon
, result
)
560 const void *data_ptr
;
568 if (type_code
== typeNull
)
569 err
= errAECoercionFail
;
570 else if (type_code
== to_type
|| to_type
== typeWildCard
)
571 err
= AECreateDesc (TYPE_FILE_NAME
, data_ptr
, data_size
, result
);
572 else if (type_code
== TYPE_FILE_NAME
)
573 /* Coercion from undecoded file name. */
578 CFDataRef data
= NULL
;
580 str
= CFStringCreateWithBytes (NULL
, data_ptr
, data_size
,
581 kCFStringEncodingUTF8
, false);
584 url
= CFURLCreateWithFileSystemPath (NULL
, str
,
585 kCFURLPOSIXPathStyle
, false);
590 data
= CFURLCreateData (NULL
, url
, kCFStringEncodingUTF8
, true);
595 err
= AECoercePtr (typeFileURL
, CFDataGetBytePtr (data
),
596 CFDataGetLength (data
), to_type
, result
);
604 /* Just to be paranoid ... */
608 buf
= xmalloc (data_size
+ 1);
609 memcpy (buf
, data_ptr
, data_size
);
610 buf
[data_size
] = '\0';
611 err
= FSPathMakeRef (buf
, &fref
, NULL
);
614 err
= AECoercePtr (typeFSRef
, &fref
, sizeof (FSRef
),
621 buf
= xmalloc (data_size
+ 1);
622 memcpy (buf
, data_ptr
, data_size
);
623 buf
[data_size
] = '\0';
624 err
= posix_pathname_to_fsspec (buf
, &fs
);
627 err
= AECoercePtr (typeFSS
, &fs
, sizeof (FSSpec
), to_type
, result
);
630 else if (to_type
== TYPE_FILE_NAME
)
631 /* Coercion to undecoded file name. */
635 CFStringRef str
= NULL
;
636 CFDataRef data
= NULL
;
638 if (type_code
== typeFileURL
)
639 url
= CFURLCreateWithBytes (NULL
, data_ptr
, data_size
,
640 kCFStringEncodingUTF8
, NULL
);
647 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
651 size
= AEGetDescDataSize (&desc
);
652 buf
= xmalloc (size
);
653 err
= AEGetDescData (&desc
, buf
, size
);
655 url
= CFURLCreateWithBytes (NULL
, buf
, size
,
656 kCFStringEncodingUTF8
, NULL
);
658 AEDisposeDesc (&desc
);
663 str
= CFURLCopyFileSystemPath (url
, kCFURLPOSIXPathStyle
);
668 data
= CFStringCreateExternalRepresentation (NULL
, str
,
669 kCFStringEncodingUTF8
,
675 err
= AECreateDesc (TYPE_FILE_NAME
, CFDataGetBytePtr (data
),
676 CFDataGetLength (data
), result
);
682 /* Coercion from typeAlias to typeFileURL fails on Mac OS X
683 10.2. In such cases, try typeFSRef as a target type. */
684 char file_name
[MAXPATHLEN
];
686 if (type_code
== typeFSRef
&& data_size
== sizeof (FSRef
))
687 err
= FSRefMakePath (data_ptr
, file_name
, sizeof (file_name
));
693 err
= AECoercePtr (type_code
, data_ptr
, data_size
,
697 err
= AEGetDescData (&desc
, &fref
, sizeof (FSRef
));
698 AEDisposeDesc (&desc
);
701 err
= FSRefMakePath (&fref
, file_name
, sizeof (file_name
));
704 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
705 strlen (file_name
), result
);
708 char file_name
[MAXPATHLEN
];
710 if (type_code
== typeFSS
&& data_size
== sizeof (FSSpec
))
711 err
= fsspec_to_posix_pathname (data_ptr
, file_name
,
712 sizeof (file_name
) - 1);
718 err
= AECoercePtr (type_code
, data_ptr
, data_size
, typeFSS
, &desc
);
721 #if TARGET_API_MAC_CARBON
722 err
= AEGetDescData (&desc
, &fs
, sizeof (FSSpec
));
724 fs
= *(FSSpec
*)(*(desc
.dataHandle
));
726 AEDisposeDesc (&desc
);
729 err
= fsspec_to_posix_pathname (&fs
, file_name
,
730 sizeof (file_name
) - 1);
733 err
= AECreateDesc (TYPE_FILE_NAME
, file_name
,
734 strlen (file_name
), result
);
741 return errAECoercionFail
;
746 mac_coerce_file_name_desc (from_desc
, to_type
, handler_refcon
, result
)
747 const AEDesc
*from_desc
;
753 DescType from_type
= from_desc
->descriptorType
;
755 if (from_type
== typeNull
)
756 err
= errAECoercionFail
;
757 else if (from_type
== to_type
|| to_type
== typeWildCard
)
758 err
= AEDuplicateDesc (from_desc
, result
);
764 #if TARGET_API_MAC_CARBON
765 data_size
= AEGetDescDataSize (from_desc
);
767 data_size
= GetHandleSize (from_desc
->dataHandle
);
769 data_ptr
= xmalloc (data_size
);
770 #if TARGET_API_MAC_CARBON
771 err
= AEGetDescData (from_desc
, data_ptr
, data_size
);
773 memcpy (data_ptr
, *(from_desc
->dataHandle
), data_size
);
776 err
= mac_coerce_file_name_ptr (from_type
, data_ptr
,
778 handler_refcon
, result
);
783 return errAECoercionFail
;
788 init_coercion_handler ()
792 static AECoercePtrUPP coerce_file_name_ptrUPP
= NULL
;
793 static AECoerceDescUPP coerce_file_name_descUPP
= NULL
;
795 if (coerce_file_name_ptrUPP
== NULL
)
797 coerce_file_name_ptrUPP
= NewAECoercePtrUPP (mac_coerce_file_name_ptr
);
798 coerce_file_name_descUPP
= NewAECoerceDescUPP (mac_coerce_file_name_desc
);
801 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
802 (AECoercionHandlerUPP
)
803 coerce_file_name_ptrUPP
, 0, false, false);
805 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
806 (AECoercionHandlerUPP
)
807 coerce_file_name_ptrUPP
, 0, false, false);
809 err
= AEInstallCoercionHandler (TYPE_FILE_NAME
, typeWildCard
,
810 coerce_file_name_descUPP
, 0, true, false);
812 err
= AEInstallCoercionHandler (typeWildCard
, TYPE_FILE_NAME
,
813 coerce_file_name_descUPP
, 0, true, false);
817 #if TARGET_API_MAC_CARBON
819 create_apple_event (class, id
, result
)
825 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
826 AEAddressDesc address_desc
;
828 err
= AECreateDesc (typeProcessSerialNumber
, &psn
,
829 sizeof (ProcessSerialNumber
), &address_desc
);
832 err
= AECreateAppleEvent (class, id
,
833 &address_desc
, /* NULL is not allowed
834 on Mac OS Classic. */
835 kAutoGenerateReturnID
,
836 kAnyTransactionID
, result
);
837 AEDisposeDesc (&address_desc
);
844 create_apple_event_from_event_ref (event
, num_params
, names
, types
, result
)
847 const EventParamName
*names
;
848 const EventParamType
*types
;
857 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
861 for (i
= 0; i
< num_params
; i
++)
865 case typeCFStringRef
:
866 err
= GetEventParameter (event
, names
[i
], typeCFStringRef
, NULL
,
867 sizeof (CFStringRef
), NULL
, &string
);
870 data
= CFStringCreateExternalRepresentation (NULL
, string
,
871 kCFStringEncodingUTF8
,
875 AEPutParamPtr (result
, names
[i
], typeUTF8Text
,
876 CFDataGetBytePtr (data
), CFDataGetLength (data
));
882 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
886 buf
= xrealloc (buf
, size
);
887 err
= GetEventParameter (event
, names
[i
], types
[i
], NULL
,
890 AEPutParamPtr (result
, names
[i
], types
[i
], buf
, size
);
900 create_apple_event_from_drag_ref (drag
, num_types
, types
, result
)
903 const FlavorType
*types
;
912 err
= CountDragItems (drag
, &num_items
);
915 err
= AECreateList (NULL
, 0, false, &items
);
919 for (index
= 1; index
<= num_items
; index
++)
922 DescType desc_type
= typeNull
;
925 err
= GetDragItemReferenceNumber (drag
, index
, &item
);
930 for (i
= 0; i
< num_types
; i
++)
932 err
= GetFlavorDataSize (drag
, item
, types
[i
], &size
);
935 buf
= xrealloc (buf
, size
);
936 err
= GetFlavorData (drag
, item
, types
[i
], buf
, &size
, 0);
940 desc_type
= types
[i
];
945 err
= AEPutPtr (&items
, index
, desc_type
,
946 desc_type
!= typeNull
? buf
: NULL
,
947 desc_type
!= typeNull
? size
: 0);
956 err
= create_apple_event (0, 0, result
); /* Dummy class and ID. */
958 err
= AEPutParamDesc (result
, keyDirectObject
, &items
);
960 AEDisposeDesc (result
);
963 AEDisposeDesc (&items
);
967 #endif /* TARGET_API_MAC_CARBON */
969 /***********************************************************************
970 Conversion between Lisp and Core Foundation objects
971 ***********************************************************************/
973 #if TARGET_API_MAC_CARBON
974 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
975 static Lisp_Object Qarray
, Qdictionary
;
977 struct cfdict_context
980 int with_tag
, hash_bound
;
983 /* C string to CFString. */
986 cfstring_create_with_utf8_cstring (c_str
)
991 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
993 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
994 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
1000 /* Lisp string to CFString. */
1003 cfstring_create_with_string (s
)
1006 CFStringRef string
= NULL
;
1008 if (STRING_MULTIBYTE (s
))
1010 char *p
, *end
= SDATA (s
) + SBYTES (s
);
1012 for (p
= SDATA (s
); p
< end
; p
++)
1015 s
= ENCODE_UTF_8 (s
);
1018 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
1019 kCFStringEncodingUTF8
, false);
1023 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
1024 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
1025 kCFStringEncodingMacRoman
, false);
1031 /* From CFData to a lisp string. Always returns a unibyte string. */
1034 cfdata_to_lisp (data
)
1037 CFIndex len
= CFDataGetLength (data
);
1038 Lisp_Object result
= make_uninit_string (len
);
1040 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
1046 /* From CFString to a lisp string. Returns a unibyte string
1047 containing a UTF-8 byte sequence. */
1050 cfstring_to_lisp_nodecode (string
)
1053 Lisp_Object result
= Qnil
;
1054 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
1057 result
= make_unibyte_string (s
, strlen (s
));
1061 CFStringCreateExternalRepresentation (NULL
, string
,
1062 kCFStringEncodingUTF8
, '?');
1066 result
= cfdata_to_lisp (data
);
1075 /* From CFString to a lisp string. Never returns a unibyte string
1076 (even if it only contains ASCII characters).
1077 This may cause GC during code conversion. */
1080 cfstring_to_lisp (string
)
1083 Lisp_Object result
= cfstring_to_lisp_nodecode (string
);
1087 result
= code_convert_string_norecord (result
, Qutf_8
, 0);
1088 /* This may be superfluous. Just to make sure that the result
1089 is a multibyte string. */
1090 result
= string_to_multibyte (result
);
1097 /* CFNumber to a lisp integer or a lisp float. */
1100 cfnumber_to_lisp (number
)
1103 Lisp_Object result
= Qnil
;
1104 #if BITS_PER_EMACS_INT > 32
1106 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
1109 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
1113 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
1114 && !FIXNUM_OVERFLOW_P (int_val
))
1115 result
= make_number (int_val
);
1117 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
1118 result
= make_float (float_val
);
1123 /* CFDate to a list of three integers as in a return value of
1127 cfdate_to_lisp (date
)
1131 int high
, low
, microsec
;
1133 sec
= CFDateGetAbsoluteTime (date
) + kCFAbsoluteTimeIntervalSince1970
;
1134 high
= sec
/ 65536.0;
1135 low
= sec
- high
* 65536.0;
1136 microsec
= (sec
- floor (sec
)) * 1000000.0;
1138 return list3 (make_number (high
), make_number (low
), make_number (microsec
));
1142 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1145 cfboolean_to_lisp (boolean
)
1146 CFBooleanRef boolean
;
1148 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
1152 /* Any Core Foundation object to a (lengthy) lisp string. */
1155 cfobject_desc_to_lisp (object
)
1158 Lisp_Object result
= Qnil
;
1159 CFStringRef desc
= CFCopyDescription (object
);
1163 result
= cfstring_to_lisp (desc
);
1171 /* Callback functions for cfproperty_list_to_lisp. */
1174 cfdictionary_add_to_list (key
, value
, context
)
1179 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1182 Fcons (Fcons (cfstring_to_lisp (key
),
1183 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
1189 cfdictionary_puthash (key
, value
, context
)
1194 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
1195 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
1196 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
1199 hash_lookup (h
, lisp_key
, &hash_code
);
1200 hash_put (h
, lisp_key
,
1201 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
1206 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1207 non-zero, a symbol that represents the type of the original Core
1208 Foundation object is prepended. HASH_BOUND specifies which kinds
1209 of the lisp objects, alists or hash tables, are used as the targets
1210 of the conversion from CFDictionary. If HASH_BOUND is negative,
1211 always generate alists. If HASH_BOUND >= 0, generate an alist if
1212 the number of keys in the dictionary is smaller than HASH_BOUND,
1213 and a hash table otherwise. */
1216 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
1217 CFPropertyListRef plist
;
1218 int with_tag
, hash_bound
;
1220 CFTypeID type_id
= CFGetTypeID (plist
);
1221 Lisp_Object tag
= Qnil
, result
= Qnil
;
1222 struct gcpro gcpro1
, gcpro2
;
1224 GCPRO2 (tag
, result
);
1226 if (type_id
== CFStringGetTypeID ())
1229 result
= cfstring_to_lisp (plist
);
1231 else if (type_id
== CFNumberGetTypeID ())
1234 result
= cfnumber_to_lisp (plist
);
1236 else if (type_id
== CFBooleanGetTypeID ())
1239 result
= cfboolean_to_lisp (plist
);
1241 else if (type_id
== CFDateGetTypeID ())
1244 result
= cfdate_to_lisp (plist
);
1246 else if (type_id
== CFDataGetTypeID ())
1249 result
= cfdata_to_lisp (plist
);
1251 else if (type_id
== CFArrayGetTypeID ())
1253 CFIndex index
, count
= CFArrayGetCount (plist
);
1256 result
= Fmake_vector (make_number (count
), Qnil
);
1257 for (index
= 0; index
< count
; index
++)
1258 XVECTOR (result
)->contents
[index
] =
1259 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
1260 with_tag
, hash_bound
);
1262 else if (type_id
== CFDictionaryGetTypeID ())
1264 struct cfdict_context context
;
1265 CFIndex count
= CFDictionaryGetCount (plist
);
1268 context
.result
= &result
;
1269 context
.with_tag
= with_tag
;
1270 context
.hash_bound
= hash_bound
;
1271 if (hash_bound
< 0 || count
< hash_bound
)
1274 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
1279 result
= make_hash_table (Qequal
,
1280 make_number (count
),
1281 make_float (DEFAULT_REHASH_SIZE
),
1282 make_float (DEFAULT_REHASH_THRESHOLD
),
1284 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
1294 result
= Fcons (tag
, result
);
1301 /***********************************************************************
1302 Emulation of the X Resource Manager
1303 ***********************************************************************/
1305 /* Parser functions for resource lines. Each function takes an
1306 address of a variable whose value points to the head of a string.
1307 The value will be advanced so that it points to the next character
1308 of the parsed part when the function returns.
1310 A resource name such as "Emacs*font" is parsed into a non-empty
1311 list called `quarks'. Each element is either a Lisp string that
1312 represents a concrete component, a Lisp symbol LOOSE_BINDING
1313 (actually Qlambda) that represents any number (>=0) of intervening
1314 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1315 that represents as any single component. */
1319 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1320 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1323 skip_white_space (p
)
1326 /* WhiteSpace = {<space> | <horizontal tab>} */
1327 while (*P
== ' ' || *P
== '\t')
1335 /* Comment = "!" {<any character except null or newline>} */
1348 /* Don't interpret filename. Just skip until the newline. */
1350 parse_include_file (p
)
1353 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1370 /* Binding = "." | "*" */
1371 if (*P
== '.' || *P
== '*')
1373 char binding
= *P
++;
1375 while (*P
== '.' || *P
== '*')
1388 /* Component = "?" | ComponentName
1389 ComponentName = NameChar {NameChar}
1390 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1394 return SINGLE_COMPONENT
;
1396 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
1398 const char *start
= P
++;
1400 while (isalnum (*P
) || *P
== '_' || *P
== '-')
1403 return make_unibyte_string (start
, P
- start
);
1410 parse_resource_name (p
)
1413 Lisp_Object result
= Qnil
, component
;
1416 /* ResourceName = [Binding] {Component Binding} ComponentName */
1417 if (parse_binding (p
) == '*')
1418 result
= Fcons (LOOSE_BINDING
, result
);
1420 component
= parse_component (p
);
1421 if (NILP (component
))
1424 result
= Fcons (component
, result
);
1425 while ((binding
= parse_binding (p
)) != '\0')
1428 result
= Fcons (LOOSE_BINDING
, result
);
1429 component
= parse_component (p
);
1430 if (NILP (component
))
1433 result
= Fcons (component
, result
);
1436 /* The final component should not be '?'. */
1437 if (EQ (component
, SINGLE_COMPONENT
))
1440 return Fnreverse (result
);
1448 Lisp_Object seq
= Qnil
, result
;
1449 int buf_len
, total_len
= 0, len
, continue_p
;
1451 q
= strchr (P
, '\n');
1452 buf_len
= q
? q
- P
: strlen (P
);
1453 buf
= xmalloc (buf_len
);
1466 else if (*P
== '\\')
1471 else if (*P
== '\n')
1482 else if ('0' <= P
[0] && P
[0] <= '7'
1483 && '0' <= P
[1] && P
[1] <= '7'
1484 && '0' <= P
[2] && P
[2] <= '7')
1486 *q
++ = ((P
[0] - '0') << 6) + ((P
[1] - '0') << 3) + (P
[2] - '0');
1496 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
1501 q
= strchr (P
, '\n');
1502 len
= q
? q
- P
: strlen (P
);
1507 buf
= xmalloc (buf_len
);
1515 if (SBYTES (XCAR (seq
)) == total_len
)
1516 return make_string (SDATA (XCAR (seq
)), total_len
);
1519 buf
= xmalloc (total_len
);
1520 q
= buf
+ total_len
;
1521 for (; CONSP (seq
); seq
= XCDR (seq
))
1523 len
= SBYTES (XCAR (seq
));
1525 memcpy (q
, SDATA (XCAR (seq
)), len
);
1527 result
= make_string (buf
, total_len
);
1534 parse_resource_line (p
)
1537 Lisp_Object quarks
, value
;
1539 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1540 if (parse_comment (p
) || parse_include_file (p
))
1543 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1544 skip_white_space (p
);
1545 quarks
= parse_resource_name (p
);
1548 skip_white_space (p
);
1552 skip_white_space (p
);
1553 value
= parse_value (p
);
1554 return Fcons (quarks
, value
);
1557 /* Skip the remaining data as a dummy value. */
1564 /* Equivalents of X Resource Manager functions.
1566 An X Resource Database acts as a collection of resource names and
1567 associated values. It is implemented as a trie on quarks. Namely,
1568 each edge is labeled by either a string, LOOSE_BINDING, or
1569 SINGLE_COMPONENT. Each node has a node id, which is a unique
1570 nonnegative integer, and the root node id is 0. A database is
1571 implemented as a hash table that maps a pair (SRC-NODE-ID .
1572 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1573 in the table as a value for HASHKEY_MAX_NID. A value associated to
1574 a node is recorded as a value for the node id.
1576 A database also has a cache for past queries as a value for
1577 HASHKEY_QUERY_CACHE. It is another hash table that maps
1578 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1580 #define HASHKEY_MAX_NID (make_number (0))
1581 #define HASHKEY_QUERY_CACHE (make_number (-1))
1584 xrm_create_database ()
1586 XrmDatabase database
;
1588 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1589 make_float (DEFAULT_REHASH_SIZE
),
1590 make_float (DEFAULT_REHASH_THRESHOLD
),
1592 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
1593 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1599 xrm_q_put_resource (database
, quarks
, value
)
1600 XrmDatabase database
;
1601 Lisp_Object quarks
, value
;
1603 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1606 Lisp_Object node_id
, key
;
1608 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
1610 XSETINT (node_id
, 0);
1611 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
1613 key
= Fcons (node_id
, XCAR (quarks
));
1614 i
= hash_lookup (h
, key
, &hash_code
);
1618 XSETINT (node_id
, max_nid
);
1619 hash_put (h
, key
, node_id
, hash_code
);
1622 node_id
= HASH_VALUE (h
, i
);
1624 Fputhash (node_id
, value
, database
);
1626 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
1627 Fputhash (HASHKEY_QUERY_CACHE
, Qnil
, database
);
1630 /* Merge multiple resource entries specified by DATA into a resource
1631 database DATABASE. DATA points to the head of a null-terminated
1632 string consisting of multiple resource lines. It's like a
1633 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1636 xrm_merge_string_database (database
, data
)
1637 XrmDatabase database
;
1640 Lisp_Object quarks_value
;
1644 quarks_value
= parse_resource_line (&data
);
1645 if (!NILP (quarks_value
))
1646 xrm_q_put_resource (database
,
1647 XCAR (quarks_value
), XCDR (quarks_value
));
1652 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
1653 XrmDatabase database
;
1654 Lisp_Object node_id
, quark_name
, quark_class
;
1656 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
1657 Lisp_Object key
, labels
[3], value
;
1660 if (!CONSP (quark_name
))
1661 return Fgethash (node_id
, database
, Qnil
);
1663 /* First, try tight bindings */
1664 labels
[0] = XCAR (quark_name
);
1665 labels
[1] = XCAR (quark_class
);
1666 labels
[2] = SINGLE_COMPONENT
;
1668 key
= Fcons (node_id
, Qnil
);
1669 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
1671 XSETCDR (key
, labels
[k
]);
1672 i
= hash_lookup (h
, key
, NULL
);
1675 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1676 XCDR (quark_name
), XCDR (quark_class
));
1682 /* Then, try loose bindings */
1683 XSETCDR (key
, LOOSE_BINDING
);
1684 i
= hash_lookup (h
, key
, NULL
);
1687 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
1688 quark_name
, quark_class
);
1692 return xrm_q_get_resource_1 (database
, node_id
,
1693 XCDR (quark_name
), XCDR (quark_class
));
1700 xrm_q_get_resource (database
, quark_name
, quark_class
)
1701 XrmDatabase database
;
1702 Lisp_Object quark_name
, quark_class
;
1704 return xrm_q_get_resource_1 (database
, make_number (0),
1705 quark_name
, quark_class
);
1708 /* Retrieve a resource value for the specified NAME and CLASS from the
1709 resource database DATABASE. It corresponds to XrmGetResource. */
1712 xrm_get_resource (database
, name
, class)
1713 XrmDatabase database
;
1714 const char *name
, *class;
1716 Lisp_Object key
, query_cache
, quark_name
, quark_class
, tmp
;
1718 struct Lisp_Hash_Table
*h
;
1722 nc
= strlen (class);
1723 key
= make_uninit_string (nn
+ nc
+ 1);
1724 strcpy (SDATA (key
), name
);
1725 strncpy (SDATA (key
) + nn
+ 1, class, nc
);
1727 query_cache
= Fgethash (HASHKEY_QUERY_CACHE
, database
, Qnil
);
1728 if (NILP (query_cache
))
1730 query_cache
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
1731 make_float (DEFAULT_REHASH_SIZE
),
1732 make_float (DEFAULT_REHASH_THRESHOLD
),
1734 Fputhash (HASHKEY_QUERY_CACHE
, query_cache
, database
);
1736 h
= XHASH_TABLE (query_cache
);
1737 i
= hash_lookup (h
, key
, &hash_code
);
1739 return HASH_VALUE (h
, i
);
1741 quark_name
= parse_resource_name (&name
);
1744 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1745 if (!STRINGP (XCAR (tmp
)))
1748 quark_class
= parse_resource_name (&class);
1751 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1752 if (!STRINGP (XCAR (tmp
)))
1759 tmp
= xrm_q_get_resource (database
, quark_name
, quark_class
);
1760 hash_put (h
, key
, tmp
, hash_code
);
1765 #if TARGET_API_MAC_CARBON
1767 xrm_cfproperty_list_to_value (plist
)
1768 CFPropertyListRef plist
;
1770 CFTypeID type_id
= CFGetTypeID (plist
);
1772 if (type_id
== CFStringGetTypeID ())
1773 return cfstring_to_lisp (plist
);
1774 else if (type_id
== CFNumberGetTypeID ())
1777 Lisp_Object result
= Qnil
;
1779 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1782 result
= cfstring_to_lisp (string
);
1787 else if (type_id
== CFBooleanGetTypeID ())
1788 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1789 else if (type_id
== CFDataGetTypeID ())
1790 return cfdata_to_lisp (plist
);
1796 /* Create a new resource database from the preferences for the
1797 application APPLICATION. APPLICATION is either a string that
1798 specifies an application ID, or NULL that represents the current
1802 xrm_get_preference_database (application
)
1803 const char *application
;
1805 #if TARGET_API_MAC_CARBON
1806 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1807 CFMutableSetRef key_set
= NULL
;
1808 CFArrayRef key_array
;
1809 CFIndex index
, count
;
1811 XrmDatabase database
;
1812 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1813 CFPropertyListRef plist
;
1815 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1817 user_doms
[0] = kCFPreferencesCurrentUser
;
1818 user_doms
[1] = kCFPreferencesAnyUser
;
1819 host_doms
[0] = kCFPreferencesCurrentHost
;
1820 host_doms
[1] = kCFPreferencesAnyHost
;
1822 database
= xrm_create_database ();
1824 GCPRO3 (database
, quarks
, value
);
1826 app_id
= kCFPreferencesCurrentApplication
;
1829 app_id
= cfstring_create_with_utf8_cstring (application
);
1833 if (!CFPreferencesAppSynchronize (app_id
))
1836 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1837 if (key_set
== NULL
)
1839 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1840 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1842 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1846 count
= CFArrayGetCount (key_array
);
1847 for (index
= 0; index
< count
; index
++)
1848 CFSetAddValue (key_set
,
1849 CFArrayGetValueAtIndex (key_array
, index
));
1850 CFRelease (key_array
);
1854 count
= CFSetGetCount (key_set
);
1855 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1856 CFSetGetValues (key_set
, (const void **)keys
);
1857 for (index
= 0; index
< count
; index
++)
1859 res_name
= SDATA (cfstring_to_lisp_nodecode (keys
[index
]));
1860 quarks
= parse_resource_name (&res_name
);
1861 if (!(NILP (quarks
) || *res_name
))
1863 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1864 value
= xrm_cfproperty_list_to_value (plist
);
1867 xrm_q_put_resource (database
, quarks
, value
);
1874 CFRelease (key_set
);
1881 return xrm_create_database ();
1888 /* The following functions with "sys_" prefix are stubs to Unix
1889 functions that have already been implemented by CW or MPW. The
1890 calls to them in Emacs source course are #define'd to call the sys_
1891 versions by the header files s-mac.h. In these stubs pathnames are
1892 converted between their Unix and Mac forms. */
1895 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1896 + 17 leap days. These are for adjusting time values returned by
1897 MacOS Toolbox functions. */
1899 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1902 #if __MSL__ < 0x6000
1903 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1904 a leap year! This is for adjusting time_t values returned by MSL
1906 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1907 #else /* __MSL__ >= 0x6000 */
1908 /* CW changes Pro 6 to follow Unix! */
1909 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1910 #endif /* __MSL__ >= 0x6000 */
1912 /* MPW library functions follow Unix (confused?). */
1913 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1914 #else /* not __MRC__ */
1916 #endif /* not __MRC__ */
1919 /* Define our own stat function for both MrC and CW. The reason for
1920 doing this: "stat" is both the name of a struct and function name:
1921 can't use the same trick like that for sys_open, sys_close, etc. to
1922 redirect Emacs's calls to our own version that converts Unix style
1923 filenames to Mac style filename because all sorts of compilation
1924 errors will be generated if stat is #define'd to be sys_stat. */
1927 stat_noalias (const char *path
, struct stat
*buf
)
1929 char mac_pathname
[MAXPATHLEN
+1];
1932 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1935 c2pstr (mac_pathname
);
1936 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1937 cipb
.hFileInfo
.ioVRefNum
= 0;
1938 cipb
.hFileInfo
.ioDirID
= 0;
1939 cipb
.hFileInfo
.ioFDirIndex
= 0;
1940 /* set to 0 to get information about specific dir or file */
1942 errno
= PBGetCatInfo (&cipb
, false);
1943 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1948 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1950 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1952 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1953 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1954 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1955 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1956 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1957 /* size of dir = number of files and dirs */
1960 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1961 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1965 buf
->st_mode
= S_IFREG
| S_IREAD
;
1966 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1967 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1968 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1969 buf
->st_mode
|= S_IEXEC
;
1970 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1971 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1972 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1975 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1976 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1979 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1981 /* identify alias files as symlinks */
1982 buf
->st_mode
&= ~S_IFREG
;
1983 buf
->st_mode
|= S_IFLNK
;
1987 buf
->st_uid
= getuid ();
1988 buf
->st_gid
= getgid ();
1996 lstat (const char *path
, struct stat
*buf
)
1999 char true_pathname
[MAXPATHLEN
+1];
2001 /* Try looking for the file without resolving aliases first. */
2002 if ((result
= stat_noalias (path
, buf
)) >= 0)
2005 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2008 return stat_noalias (true_pathname
, buf
);
2013 stat (const char *path
, struct stat
*sb
)
2016 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2019 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
2020 ! (sb
->st_mode
& S_IFLNK
))
2023 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2026 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2029 fully_resolved_name
[len
] = '\0';
2030 /* in fact our readlink terminates strings */
2031 return lstat (fully_resolved_name
, sb
);
2034 return lstat (true_pathname
, sb
);
2039 /* CW defines fstat in stat.mac.c while MPW does not provide this
2040 function. Without the information of how to get from a file
2041 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
2042 to implement this function. Fortunately, there is only one place
2043 where this function is called in our configuration: in fileio.c,
2044 where only the st_dev and st_ino fields are used to determine
2045 whether two fildes point to different i-nodes to prevent copying
2046 a file onto itself equal. What we have here probably needs
2050 fstat (int fildes
, struct stat
*buf
)
2053 buf
->st_ino
= fildes
;
2054 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
2055 return 0; /* success */
2057 #endif /* __MRC__ */
2061 mkdir (const char *dirname
, int mode
)
2063 #pragma unused(mode)
2066 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
2068 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
2071 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2074 c2pstr (mac_pathname
);
2075 hfpb
.ioNamePtr
= mac_pathname
;
2076 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2077 hfpb
.ioDirID
= 0; /* parent is the root */
2079 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
2080 /* just return the Mac OSErr code for now */
2081 return errno
== noErr
? 0 : -1;
2086 sys_rmdir (const char *dirname
)
2089 char mac_pathname
[MAXPATHLEN
+1];
2091 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
2094 c2pstr (mac_pathname
);
2095 hfpb
.ioNamePtr
= mac_pathname
;
2096 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
2097 hfpb
.ioDirID
= 0; /* parent is the root */
2099 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
2100 return errno
== noErr
? 0 : -1;
2105 /* No implementation yet. */
2107 execvp (const char *path
, ...)
2111 #endif /* __MRC__ */
2115 utime (const char *path
, const struct utimbuf
*times
)
2117 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2119 char mac_pathname
[MAXPATHLEN
+1];
2122 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2125 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2127 fully_resolved_name
[len
] = '\0';
2129 strcpy (fully_resolved_name
, true_pathname
);
2131 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2134 c2pstr (mac_pathname
);
2135 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2136 cipb
.hFileInfo
.ioVRefNum
= 0;
2137 cipb
.hFileInfo
.ioDirID
= 0;
2138 cipb
.hFileInfo
.ioFDirIndex
= 0;
2139 /* set to 0 to get information about specific dir or file */
2141 errno
= PBGetCatInfo (&cipb
, false);
2145 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
2148 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2150 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
2155 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
2157 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
2160 errno
= PBSetCatInfo (&cipb
, false);
2161 return errno
== noErr
? 0 : -1;
2175 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2177 access (const char *path
, int mode
)
2179 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2181 char mac_pathname
[MAXPATHLEN
+1];
2184 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2187 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2189 fully_resolved_name
[len
] = '\0';
2191 strcpy (fully_resolved_name
, true_pathname
);
2193 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2196 c2pstr (mac_pathname
);
2197 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
2198 cipb
.hFileInfo
.ioVRefNum
= 0;
2199 cipb
.hFileInfo
.ioDirID
= 0;
2200 cipb
.hFileInfo
.ioFDirIndex
= 0;
2201 /* set to 0 to get information about specific dir or file */
2203 errno
= PBGetCatInfo (&cipb
, false);
2207 if (mode
== F_OK
) /* got this far, file exists */
2211 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
2215 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
2222 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
2223 /* don't allow if lock bit is on */
2229 #define DEV_NULL_FD 0x10000
2233 sys_open (const char *path
, int oflag
)
2235 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2237 char mac_pathname
[MAXPATHLEN
+1];
2239 if (strcmp (path
, "/dev/null") == 0)
2240 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
2242 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2245 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2247 fully_resolved_name
[len
] = '\0';
2249 strcpy (fully_resolved_name
, true_pathname
);
2251 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2256 int res
= open (mac_pathname
, oflag
);
2257 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2258 if (oflag
& O_CREAT
)
2259 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2261 #else /* not __MRC__ */
2262 return open (mac_pathname
, oflag
);
2263 #endif /* not __MRC__ */
2270 sys_creat (const char *path
, mode_t mode
)
2272 char true_pathname
[MAXPATHLEN
+1];
2274 char mac_pathname
[MAXPATHLEN
+1];
2276 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2279 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
2284 int result
= creat (mac_pathname
);
2285 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2287 #else /* not __MRC__ */
2288 return creat (mac_pathname
, mode
);
2289 #endif /* not __MRC__ */
2296 sys_unlink (const char *path
)
2298 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2300 char mac_pathname
[MAXPATHLEN
+1];
2302 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
2305 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2307 fully_resolved_name
[len
] = '\0';
2309 strcpy (fully_resolved_name
, true_pathname
);
2311 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2314 return unlink (mac_pathname
);
2320 sys_read (int fildes
, char *buf
, int count
)
2322 if (fildes
== 0) /* this should not be used for console input */
2325 #if __MSL__ >= 0x6000
2326 return _read (fildes
, buf
, count
);
2328 return read (fildes
, buf
, count
);
2335 sys_write (int fildes
, const char *buf
, int count
)
2337 if (fildes
== DEV_NULL_FD
)
2340 #if __MSL__ >= 0x6000
2341 return _write (fildes
, buf
, count
);
2343 return write (fildes
, buf
, count
);
2350 sys_rename (const char * old_name
, const char * new_name
)
2352 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
2353 char fully_resolved_old_name
[MAXPATHLEN
+1];
2355 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
2357 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
2360 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
2362 fully_resolved_old_name
[len
] = '\0';
2364 strcpy (fully_resolved_old_name
, true_old_pathname
);
2366 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
2369 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
2372 if (!posix_to_mac_pathname (fully_resolved_old_name
,
2377 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
2380 /* If a file with new_name already exists, rename deletes the old
2381 file in Unix. CW version fails in these situation. So we add a
2382 call to unlink here. */
2383 (void) unlink (mac_new_name
);
2385 return rename (mac_old_name
, mac_new_name
);
2390 extern FILE *fopen (const char *name
, const char *mode
);
2392 sys_fopen (const char *name
, const char *mode
)
2394 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
2396 char mac_pathname
[MAXPATHLEN
+1];
2398 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
2401 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
2403 fully_resolved_name
[len
] = '\0';
2405 strcpy (fully_resolved_name
, true_pathname
);
2407 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
2412 if (mode
[0] == 'w' || mode
[0] == 'a')
2413 fsetfileinfo (mac_pathname
, MAC_EMACS_CREATOR_CODE
, 'TEXT');
2414 #endif /* not __MRC__ */
2415 return fopen (mac_pathname
, mode
);
2420 extern Boolean mac_wait_next_event
P_ ((EventRecord
*, UInt32
, Boolean
));
2423 select (nfds
, rfds
, wfds
, efds
, timeout
)
2425 SELECT_TYPE
*rfds
, *wfds
, *efds
;
2426 EMACS_TIME
*timeout
;
2428 OSStatus err
= noErr
;
2430 /* Can only handle wait for keyboard input. */
2431 if (nfds
> 1 || wfds
|| efds
)
2434 /* Try detect_input_pending before ReceiveNextEvent in the same
2435 BLOCK_INPUT block, in case that some input has already been read
2438 ENABLE_WAKEUP_FROM_RNE
;
2439 if (!detect_input_pending ())
2441 #if TARGET_API_MAC_CARBON
2442 EventTimeout timeoutval
=
2444 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
2445 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
2446 : kEventDurationForever
);
2448 if (timeoutval
== 0.0)
2449 err
= eventLoopTimedOutErr
;
2451 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
2452 kEventLeaveInQueue
, NULL
);
2453 #else /* not TARGET_API_MAC_CARBON */
2455 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
2456 ((EMACS_USECS (*timeout
) * 60) / 1000000);
2458 if (sleep_time
== 0)
2459 err
= -9875; /* eventLoopTimedOutErr */
2462 if (mac_wait_next_event (&e
, sleep_time
, false))
2465 err
= -9875; /* eventLoopTimedOutErr */
2467 #endif /* not TARGET_API_MAC_CARBON */
2469 DISABLE_WAKEUP_FROM_RNE
;
2474 /* Pretend that `select' is interrupted by a signal. */
2475 detect_input_pending ();
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
, MAC_EMACS_CREATOR_CODE
);
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
;
4620 struct gcpro gcpro1
, gcpro2
;
4623 key
= Fcons (key
, Qnil
);
4627 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
4628 CHECK_STRING_CAR (tmp
);
4629 CHECK_LIST_END (tmp
, key
);
4631 if (!NILP (application
))
4632 CHECK_STRING (application
);
4633 CHECK_SYMBOL (format
);
4634 if (!NILP (hash_bound
))
4635 CHECK_NUMBER (hash_bound
);
4637 GCPRO2 (key
, format
);
4641 app_id
= kCFPreferencesCurrentApplication
;
4642 if (!NILP (application
))
4644 app_id
= cfstring_create_with_string (application
);
4648 if (!CFPreferencesAppSynchronize (app_id
))
4651 key_str
= cfstring_create_with_string (XCAR (key
));
4652 if (key_str
== NULL
)
4654 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
4655 CFRelease (key_str
);
4656 if (app_plist
== NULL
)
4660 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
4662 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
4664 key_str
= cfstring_create_with_string (XCAR (key
));
4665 if (key_str
== NULL
)
4667 plist
= CFDictionaryGetValue (plist
, key_str
);
4668 CFRelease (key_str
);
4675 if (EQ (format
, Qxml
))
4677 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
4680 result
= cfdata_to_lisp (data
);
4685 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
4686 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
4691 CFRelease (app_plist
);
4702 static CFStringEncoding
4703 get_cfstring_encoding_from_lisp (obj
)
4706 CFStringRef iana_name
;
4707 CFStringEncoding encoding
= kCFStringEncodingInvalidId
;
4710 return kCFStringEncodingUnicode
;
4715 if (SYMBOLP (obj
) && !NILP (Fcoding_system_p (obj
)))
4717 Lisp_Object coding_spec
, plist
;
4719 coding_spec
= Fget (obj
, Qcoding_system
);
4720 plist
= XVECTOR (coding_spec
)->contents
[3];
4721 obj
= Fplist_get (XVECTOR (coding_spec
)->contents
[3], Qmime_charset
);
4725 obj
= SYMBOL_NAME (obj
);
4729 iana_name
= cfstring_create_with_string (obj
);
4732 encoding
= CFStringConvertIANACharSetNameToEncoding (iana_name
);
4733 CFRelease (iana_name
);
4740 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4742 cfstring_create_normalized (str
, symbol
)
4747 TextEncodingVariant variant
;
4748 float initial_mag
= 0.0;
4749 CFStringRef result
= NULL
;
4751 if (EQ (symbol
, QNFD
))
4752 form
= kCFStringNormalizationFormD
;
4753 else if (EQ (symbol
, QNFKD
))
4754 form
= kCFStringNormalizationFormKD
;
4755 else if (EQ (symbol
, QNFC
))
4756 form
= kCFStringNormalizationFormC
;
4757 else if (EQ (symbol
, QNFKC
))
4758 form
= kCFStringNormalizationFormKC
;
4759 else if (EQ (symbol
, QHFS_plus_D
))
4761 variant
= kUnicodeHFSPlusDecompVariant
;
4764 else if (EQ (symbol
, QHFS_plus_C
))
4766 variant
= kUnicodeHFSPlusCompVariant
;
4772 CFMutableStringRef mut_str
= CFStringCreateMutableCopy (NULL
, 0, str
);
4776 CFStringNormalize (mut_str
, form
);
4780 else if (initial_mag
> 0.0)
4782 UnicodeToTextInfo uni
= NULL
;
4785 UniChar
*in_text
, *buffer
= NULL
, *out_buf
= NULL
;
4786 OSStatus err
= noErr
;
4787 ByteCount out_read
, out_size
, out_len
;
4789 map
.unicodeEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4791 kTextEncodingDefaultFormat
);
4792 map
.otherEncoding
= CreateTextEncoding (kTextEncodingUnicodeDefault
,
4794 kTextEncodingDefaultFormat
);
4795 map
.mappingVersion
= kUnicodeUseLatestMapping
;
4797 length
= CFStringGetLength (str
);
4798 out_size
= (int)((float)length
* initial_mag
) * sizeof (UniChar
);
4802 in_text
= (UniChar
*)CFStringGetCharactersPtr (str
);
4803 if (in_text
== NULL
)
4805 buffer
= xmalloc (sizeof (UniChar
) * length
);
4806 CFStringGetCharacters (str
, CFRangeMake (0, length
), buffer
);
4811 err
= CreateUnicodeToTextInfo (&map
, &uni
);
4812 while (err
== noErr
)
4814 out_buf
= xmalloc (out_size
);
4815 err
= ConvertFromUnicodeToText (uni
, length
* sizeof (UniChar
),
4817 kUnicodeDefaultDirectionMask
,
4818 0, NULL
, NULL
, NULL
,
4819 out_size
, &out_read
, &out_len
,
4821 if (err
== noErr
&& out_read
< length
* sizeof (UniChar
))
4830 result
= CFStringCreateWithCharacters (NULL
, out_buf
,
4831 out_len
/ sizeof (UniChar
));
4833 DisposeUnicodeToTextInfo (&uni
);
4849 DEFUN ("mac-code-convert-string", Fmac_code_convert_string
, Smac_code_convert_string
, 3, 4, 0,
4850 doc
: /* Convert STRING from SOURCE encoding to TARGET encoding.
4851 The conversion is performed using the converter provided by the system.
4852 Each encoding is specified by either a coding system symbol, a mime
4853 charset string, or an integer as a CFStringEncoding value. An encoding
4854 of nil means UTF-16 in native byte order, no byte order mark.
4855 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4856 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4857 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4858 On successful conversion, return the result string, else return nil. */)
4859 (string
, source
, target
, normalization_form
)
4860 Lisp_Object string
, source
, target
, normalization_form
;
4862 Lisp_Object result
= Qnil
;
4863 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4864 CFStringEncoding src_encoding
, tgt_encoding
;
4865 CFStringRef str
= NULL
;
4867 CHECK_STRING (string
);
4868 if (!INTEGERP (source
) && !STRINGP (source
))
4869 CHECK_SYMBOL (source
);
4870 if (!INTEGERP (target
) && !STRINGP (target
))
4871 CHECK_SYMBOL (target
);
4872 CHECK_SYMBOL (normalization_form
);
4874 GCPRO4 (string
, source
, target
, normalization_form
);
4878 src_encoding
= get_cfstring_encoding_from_lisp (source
);
4879 tgt_encoding
= get_cfstring_encoding_from_lisp (target
);
4881 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4882 use string_as_unibyte which works as well, except for the fact that
4883 it's too permissive (it doesn't check that the multibyte string only
4884 contain single-byte chars). */
4885 string
= Fstring_as_unibyte (string
);
4886 if (src_encoding
!= kCFStringEncodingInvalidId
4887 && tgt_encoding
!= kCFStringEncodingInvalidId
)
4888 str
= CFStringCreateWithBytes (NULL
, SDATA (string
), SBYTES (string
),
4889 src_encoding
, !NILP (source
));
4890 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4893 CFStringRef saved_str
= str
;
4895 str
= cfstring_create_normalized (saved_str
, normalization_form
);
4896 CFRelease (saved_str
);
4901 CFIndex str_len
, buf_len
;
4903 str_len
= CFStringGetLength (str
);
4904 if (CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4905 !NILP (target
), NULL
, 0, &buf_len
) == str_len
)
4907 result
= make_uninit_string (buf_len
);
4908 CFStringGetBytes (str
, CFRangeMake (0, str_len
), tgt_encoding
, 0,
4909 !NILP (target
), SDATA (result
), buf_len
, NULL
);
4921 DEFUN ("mac-process-hi-command", Fmac_process_hi_command
, Smac_process_hi_command
, 1, 1, 0,
4922 doc
: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4923 COMMAND-ID must be a 4-character string. Some common command IDs are
4924 defined in the Carbon Event Manager. */)
4926 Lisp_Object command_id
;
4931 bzero (&command
, sizeof (HICommand
));
4932 command
.commandID
= mac_get_code_from_arg (command_id
, 0);
4935 err
= ProcessHICommand (&command
);
4939 error ("HI command (command ID: '%s') not handled.", SDATA (command_id
));
4944 #endif /* TARGET_API_MAC_CARBON */
4948 mac_get_system_locale ()
4956 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4957 region
= GetScriptManagerVariable (smRegionCode
);
4958 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4960 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4963 return build_string (str
);
4971 extern int inhibit_window_system
;
4972 extern int noninteractive
;
4974 /* Unlike in X11, window events in Carbon do not come from sockets.
4975 So we cannot simply use `select' to monitor two kinds of inputs:
4976 window events and process outputs. We emulate such functionality
4977 by regarding fd 0 as the window event channel and simultaneously
4978 monitoring both kinds of input channels. It is implemented by
4979 dividing into some cases:
4980 1. The window event channel is not involved.
4982 2. Sockets are not involved.
4983 -> Use ReceiveNextEvent.
4984 3. [If SELECT_USE_CFSOCKET is set]
4985 Only the window event channel and socket read/write channels are
4986 involved, and timeout is not too short (greater than
4987 SELECT_TIMEOUT_THRESHOLD_RUNLOOP seconds).
4988 -> Create CFSocket for each socket and add it into the current
4989 event RunLoop so that the current event loop gets quit when
4990 the socket becomes ready. Then ReceiveNextEvent can wait for
4991 both kinds of inputs.
4993 -> Periodically poll the window input channel while repeatedly
4994 executing `select' with a short timeout
4995 (SELECT_POLLING_PERIOD_USEC microseconds). */
4997 #ifndef SELECT_USE_CFSOCKET
4998 #define SELECT_USE_CFSOCKET 1
5001 #define SELECT_POLLING_PERIOD_USEC 100000
5002 #if SELECT_USE_CFSOCKET
5003 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
5006 socket_callback (s
, type
, address
, data
, info
)
5008 CFSocketCallBackType type
;
5013 int fd
= CFSocketGetNative (s
);
5014 SELECT_TYPE
*ofds
= (SELECT_TYPE
*)info
;
5016 if ((type
== kCFSocketReadCallBack
&& FD_ISSET (fd
, &ofds
[0]))
5017 || (type
== kCFSocketConnectCallBack
&& FD_ISSET (fd
, &ofds
[1])))
5018 QuitEventLoop (GetCurrentEventLoop ());
5020 #endif /* SELECT_USE_CFSOCKET */
5023 select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
)
5025 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5026 EMACS_TIME
*timeout
;
5028 OSStatus err
= noErr
;
5031 /* Try detect_input_pending before ReceiveNextEvent in the same
5032 BLOCK_INPUT block, in case that some input has already been read
5035 ENABLE_WAKEUP_FROM_RNE
;
5036 if (!detect_input_pending ())
5038 EMACS_TIME select_timeout
;
5039 EventTimeout timeoutval
=
5041 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5042 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5043 : kEventDurationForever
);
5045 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5046 r
= select (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5047 if (timeoutval
== 0.0)
5048 err
= eventLoopTimedOutErr
;
5052 mac_prepare_for_quickdraw (NULL
);
5054 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
5055 kEventLeaveInQueue
, NULL
);
5058 DISABLE_WAKEUP_FROM_RNE
;
5063 else if (err
== noErr
)
5065 /* Pretend that `select' is interrupted by a signal. */
5066 detect_input_pending ();
5075 sys_select (nfds
, rfds
, wfds
, efds
, timeout
)
5077 SELECT_TYPE
*rfds
, *wfds
, *efds
;
5078 EMACS_TIME
*timeout
;
5080 OSStatus err
= noErr
;
5082 EMACS_TIME select_timeout
;
5083 static SELECT_TYPE ofds
[3];
5085 if (inhibit_window_system
|| noninteractive
5086 || nfds
< 1 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
5087 return select (nfds
, rfds
, wfds
, efds
, timeout
);
5101 EventTimeout timeoutval
=
5103 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
5104 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
5105 : kEventDurationForever
);
5107 FD_SET (0, rfds
); /* sentinel */
5112 while (!(FD_ISSET (nfds
, rfds
) || (wfds
&& FD_ISSET (nfds
, wfds
))));
5117 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, timeout
);
5119 /* Avoid initial overhead of RunLoop setup for the case that
5120 some input is already available. */
5121 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5122 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5123 if (r
!= 0 || timeoutval
== 0.0)
5130 #if SELECT_USE_CFSOCKET
5131 if (timeoutval
> 0 && timeoutval
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
5132 goto poll_periodically
;
5134 /* Try detect_input_pending before ReceiveNextEvent in the same
5135 BLOCK_INPUT block, in case that some input has already been
5136 read asynchronously. */
5138 ENABLE_WAKEUP_FROM_RNE
;
5139 if (!detect_input_pending ())
5142 CFRunLoopRef runloop
=
5143 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5144 static const CFSocketContext context
= {0, ofds
, NULL
, NULL
, NULL
};
5145 static CFMutableDictionaryRef sources
;
5147 if (sources
== NULL
)
5149 CFDictionaryCreateMutable (NULL
, 0, NULL
,
5150 &kCFTypeDictionaryValueCallBacks
);
5152 for (minfd
= 1; ; minfd
++) /* nfds-1 works as a sentinel. */
5153 if (FD_ISSET (minfd
, rfds
) || (wfds
&& FD_ISSET (minfd
, wfds
)))
5156 for (fd
= minfd
; fd
< nfds
; fd
++)
5157 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5159 void *key
= (void *) fd
;
5160 CFRunLoopSourceRef source
=
5161 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5165 CFSocketRef socket
=
5166 CFSocketCreateWithNative (NULL
, fd
,
5167 (kCFSocketReadCallBack
5168 | kCFSocketConnectCallBack
),
5169 socket_callback
, &context
);
5173 source
= CFSocketCreateRunLoopSource (NULL
, socket
, 0);
5177 CFDictionaryAddValue (sources
, key
, source
);
5180 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
5184 mac_prepare_for_quickdraw (NULL
);
5186 err
= ReceiveNextEvent (0, NULL
, timeoutval
,
5187 kEventLeaveInQueue
, NULL
);
5189 for (fd
= minfd
; fd
< nfds
; fd
++)
5190 if (FD_ISSET (fd
, rfds
) || (wfds
&& FD_ISSET (fd
, wfds
)))
5192 void *key
= (void *) fd
;
5193 CFRunLoopSourceRef source
=
5194 (CFRunLoopSourceRef
) CFDictionaryGetValue (sources
, key
);
5196 CFRunLoopRemoveSource (runloop
, source
, kCFRunLoopDefaultMode
);
5199 DISABLE_WAKEUP_FROM_RNE
;
5202 if (err
== noErr
|| err
== eventLoopQuitErr
)
5204 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5205 return select_and_poll_event (nfds
, rfds
, wfds
, efds
,
5215 #endif /* SELECT_USE_CFSOCKET */
5220 EMACS_TIME end_time
, now
, remaining_time
;
5224 remaining_time
= *timeout
;
5225 EMACS_GET_TIME (now
);
5226 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
5231 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
5232 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
5233 select_timeout
= remaining_time
;
5234 r
= select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5246 EMACS_GET_TIME (now
);
5247 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
5250 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
5252 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
5253 return select_and_poll_event (nfds
, rfds
, wfds
, efds
, &select_timeout
);
5257 /* Set up environment variables so that Emacs can correctly find its
5258 support files when packaged as an application bundle. Directories
5259 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5260 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5261 by `make install' by default can instead be placed in
5262 .../Emacs.app/Contents/Resources/ and
5263 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5264 is changed only if it is not already set. Presumably if the user
5265 sets an environment variable, he will want to use files in his path
5266 instead of ones in the application bundle. */
5268 init_mac_osx_environment ()
5272 CFStringRef cf_app_bundle_pathname
;
5273 int app_bundle_pathname_len
;
5274 char *app_bundle_pathname
;
5278 /* Initialize locale related variables. */
5279 mac_system_script_code
=
5280 (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5281 Vmac_system_locale
= mac_get_system_locale ();
5283 /* Fetch the pathname of the application bundle as a C string into
5284 app_bundle_pathname. */
5286 bundle
= CFBundleGetMainBundle ();
5287 if (!bundle
|| CFBundleGetIdentifier (bundle
) == NULL
)
5289 /* We could not find the bundle identifier. For now, prevent
5290 the fatal error by bringing it up in the terminal. */
5291 inhibit_window_system
= 1;
5295 bundleURL
= CFBundleCopyBundleURL (bundle
);
5299 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
5300 kCFURLPOSIXPathStyle
);
5301 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
5302 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
5304 if (!CFStringGetCString (cf_app_bundle_pathname
,
5305 app_bundle_pathname
,
5306 app_bundle_pathname_len
+ 1,
5307 kCFStringEncodingISOLatin1
))
5309 CFRelease (cf_app_bundle_pathname
);
5313 CFRelease (cf_app_bundle_pathname
);
5315 /* P should have sufficient room for the pathname of the bundle plus
5316 the subpath in it leading to the respective directories. Q
5317 should have three times that much room because EMACSLOADPATH can
5318 have the value "<path to site-lisp dir>:<path to lisp dir>:<path
5320 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
5321 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
5322 if (!getenv ("EMACSLOADPATH"))
5326 strcpy (p
, app_bundle_pathname
);
5327 strcat (p
, "/Contents/Resources/site-lisp");
5328 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5331 strcpy (p
, app_bundle_pathname
);
5332 strcat (p
, "/Contents/Resources/lisp");
5333 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5340 strcpy (p
, app_bundle_pathname
);
5341 strcat (p
, "/Contents/Resources/leim");
5342 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5350 setenv ("EMACSLOADPATH", q
, 1);
5353 if (!getenv ("EMACSPATH"))
5357 strcpy (p
, app_bundle_pathname
);
5358 strcat (p
, "/Contents/MacOS/libexec");
5359 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5362 strcpy (p
, app_bundle_pathname
);
5363 strcat (p
, "/Contents/MacOS/bin");
5364 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5372 setenv ("EMACSPATH", q
, 1);
5375 if (!getenv ("EMACSDATA"))
5377 strcpy (p
, app_bundle_pathname
);
5378 strcat (p
, "/Contents/Resources/etc");
5379 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5380 setenv ("EMACSDATA", p
, 1);
5383 if (!getenv ("EMACSDOC"))
5385 strcpy (p
, app_bundle_pathname
);
5386 strcat (p
, "/Contents/Resources/etc");
5387 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5388 setenv ("EMACSDOC", p
, 1);
5391 if (!getenv ("INFOPATH"))
5393 strcpy (p
, app_bundle_pathname
);
5394 strcat (p
, "/Contents/Resources/info");
5395 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
5396 setenv ("INFOPATH", p
, 1);
5399 #endif /* MAC_OSX */
5401 #if TARGET_API_MAC_CARBON
5403 mac_wakeup_from_rne ()
5405 if (wakeup_from_rne_enabled_p
)
5406 /* Post a harmless event so as to wake up from
5407 ReceiveNextEvent. */
5408 mac_post_mouse_moved_event ();
5415 Qundecoded_file_name
= intern ("undecoded-file-name");
5416 staticpro (&Qundecoded_file_name
);
5418 #if TARGET_API_MAC_CARBON
5419 Qstring
= intern ("string"); staticpro (&Qstring
);
5420 Qnumber
= intern ("number"); staticpro (&Qnumber
);
5421 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
5422 Qdate
= intern ("date"); staticpro (&Qdate
);
5423 Qdata
= intern ("data"); staticpro (&Qdata
);
5424 Qarray
= intern ("array"); staticpro (&Qarray
);
5425 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
5427 Qxml
= intern ("xml");
5430 Qmime_charset
= intern ("mime-charset");
5431 staticpro (&Qmime_charset
);
5433 QNFD
= intern ("NFD"); staticpro (&QNFD
);
5434 QNFKD
= intern ("NFKD"); staticpro (&QNFKD
);
5435 QNFC
= intern ("NFC"); staticpro (&QNFC
);
5436 QNFKC
= intern ("NFKC"); staticpro (&QNFKC
);
5437 QHFS_plus_D
= intern ("HFS+D"); staticpro (&QHFS_plus_D
);
5438 QHFS_plus_C
= intern ("HFS+C"); staticpro (&QHFS_plus_C
);
5444 for (i
= 0; i
< sizeof (ae_attr_table
) / sizeof (ae_attr_table
[0]); i
++)
5446 ae_attr_table
[i
].symbol
= intern (ae_attr_table
[i
].name
);
5447 staticpro (&ae_attr_table
[i
].symbol
);
5451 defsubr (&Smac_coerce_ae_data
);
5452 #if TARGET_API_MAC_CARBON
5453 defsubr (&Smac_get_preference
);
5454 defsubr (&Smac_code_convert_string
);
5455 defsubr (&Smac_process_hi_command
);
5458 defsubr (&Smac_set_file_creator
);
5459 defsubr (&Smac_set_file_type
);
5460 defsubr (&Smac_get_file_creator
);
5461 defsubr (&Smac_get_file_type
);
5462 defsubr (&Sdo_applescript
);
5463 defsubr (&Smac_file_name_to_posix
);
5464 defsubr (&Sposix_file_name_to_mac
);
5466 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
5467 doc
: /* The system script code. */);
5468 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
5470 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
5471 doc
: /* The system locale identifier string.
5472 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5473 information is not included. */);
5474 Vmac_system_locale
= mac_get_system_locale ();
5477 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5478 (do not change this comment) */