Merge from gnus--rel--5.10
[emacs.git] / src / mac.c
blob22f34747ea8f53501a63ae5005076f84f548e1b7
1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; 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). */
24 #include <config.h>
26 #include <stdio.h>
27 #include <errno.h>
29 #include "lisp.h"
30 #include "process.h"
31 #ifdef MAC_OSX
32 #undef select
33 #endif
34 #include "systime.h"
35 #include "sysselect.h"
36 #include "blockinput.h"
38 #include "macterm.h"
40 #include "charset.h"
41 #include "coding.h"
42 #if !TARGET_API_MAC_CARBON
43 #include <Files.h>
44 #include <MacTypes.h>
45 #include <TextUtils.h>
46 #include <Folders.h>
47 #include <Resources.h>
48 #include <Aliases.h>
49 #include <Timer.h>
50 #include <OSA.h>
51 #include <AppleScript.h>
52 #include <Events.h>
53 #include <Processes.h>
54 #include <EPPC.h>
55 #include <MacLocales.h>
56 #include <Endian.h>
57 #endif /* not TARGET_API_MAC_CARBON */
59 #include <utime.h>
60 #include <dirent.h>
61 #include <sys/types.h>
62 #include <sys/stat.h>
63 #include <pwd.h>
64 #include <grp.h>
65 #include <sys/param.h>
66 #include <fcntl.h>
67 #if __MWERKS__
68 #include <unistd.h>
69 #endif
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 #ifndef MAC_OSX
83 #if TARGET_API_MAC_CARBON
84 static int wakeup_from_rne_enabled_p = 0;
85 #define ENABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 1)
86 #define DISABLE_WAKEUP_FROM_RNE (wakeup_from_rne_enabled_p = 0)
87 #else
88 #define ENABLE_WAKEUP_FROM_RNE 0
89 #define DISABLE_WAKEUP_FROM_RNE 0
90 #endif
91 #endif
93 #ifndef MAC_OSX
94 static OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *));
95 static OSErr fsspec_to_posix_pathname P_ ((const FSSpec *, char *, int));
96 #endif
98 /* When converting from Mac to Unix pathnames, /'s in folder names are
99 converted to :'s. This function, used in copying folder names,
100 performs a strncat and converts all character a to b in the copy of
101 the string s2 appended to the end of s1. */
103 void
104 string_cat_and_replace (char *s1, const char *s2, int n, char a, char b)
106 int l1 = strlen (s1);
107 int l2 = strlen (s2);
108 char *p = s1 + l1;
109 int i;
111 strncat (s1, s2, n);
112 for (i = 0; i < l2; i++)
114 if (*p == a)
115 *p = b;
116 p++;
121 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
122 that does not begin with a ':' and contains at least one ':'. A Mac
123 full pathname causes a '/' to be prepended to the Posix pathname.
124 The algorithm for the rest of the pathname is as follows:
125 For each segment between two ':',
126 if it is non-null, copy as is and then add a '/' at the end,
127 otherwise, insert a "../" into the Posix pathname.
128 Returns 1 if successful; 0 if fails. */
131 mac_to_posix_pathname (const char *mfn, char *ufn, int ufnbuflen)
133 const char *p, *q, *pe;
135 strcpy (ufn, "");
137 if (*mfn == '\0')
138 return 1;
140 p = strchr (mfn, ':');
141 if (p != 0 && p != mfn) /* full pathname */
142 strcat (ufn, "/");
144 p = mfn;
145 if (*p == ':')
146 p++;
148 pe = mfn + strlen (mfn);
149 while (p < pe)
151 q = strchr (p, ':');
152 if (q)
154 if (q == p)
155 { /* two consecutive ':' */
156 if (strlen (ufn) + 3 >= ufnbuflen)
157 return 0;
158 strcat (ufn, "../");
160 else
162 if (strlen (ufn) + (q - p) + 1 >= ufnbuflen)
163 return 0;
164 string_cat_and_replace (ufn, p, q - p, '/', ':');
165 strcat (ufn, "/");
167 p = q + 1;
169 else
171 if (strlen (ufn) + (pe - p) >= ufnbuflen)
172 return 0;
173 string_cat_and_replace (ufn, p, pe - p, '/', ':');
174 /* no separator for last one */
175 p = pe;
179 return 1;
183 extern char *get_temp_dir_name ();
186 /* Convert a Posix pathname to Mac form. Approximately reverse of the
187 above in algorithm. */
190 posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen)
192 const char *p, *q, *pe;
193 char expanded_pathname[MAXPATHLEN+1];
195 strcpy (mfn, "");
197 if (*ufn == '\0')
198 return 1;
200 p = ufn;
202 /* Check for and handle volume names. Last comparison: strangely
203 somewhere "/.emacs" is passed. A temporary fix for now. */
204 if (*p == '/' && strchr (p+1, '/') == NULL && strcmp (p, "/.emacs") != 0)
206 if (strlen (p) + 1 > mfnbuflen)
207 return 0;
208 strcpy (mfn, p+1);
209 strcat (mfn, ":");
210 return 1;
213 /* expand to emacs dir found by init_emacs_passwd_dir */
214 if (strncmp (p, "~emacs/", 7) == 0)
216 struct passwd *pw = getpwnam ("emacs");
217 p += 7;
218 if (strlen (pw->pw_dir) + strlen (p) > MAXPATHLEN)
219 return 0;
220 strcpy (expanded_pathname, pw->pw_dir);
221 strcat (expanded_pathname, p);
222 p = expanded_pathname;
223 /* now p points to the pathname with emacs dir prefix */
225 else if (strncmp (p, "/tmp/", 5) == 0)
227 char *t = get_temp_dir_name ();
228 p += 5;
229 if (strlen (t) + strlen (p) > MAXPATHLEN)
230 return 0;
231 strcpy (expanded_pathname, t);
232 strcat (expanded_pathname, p);
233 p = expanded_pathname;
234 /* now p points to the pathname with emacs dir prefix */
236 else if (*p != '/') /* relative pathname */
237 strcat (mfn, ":");
239 if (*p == '/')
240 p++;
242 pe = p + strlen (p);
243 while (p < pe)
245 q = strchr (p, '/');
246 if (q)
248 if (q - p == 2 && *p == '.' && *(p+1) == '.')
250 if (strlen (mfn) + 1 >= mfnbuflen)
251 return 0;
252 strcat (mfn, ":");
254 else
256 if (strlen (mfn) + (q - p) + 1 >= mfnbuflen)
257 return 0;
258 string_cat_and_replace (mfn, p, q - p, ':', '/');
259 strcat (mfn, ":");
261 p = q + 1;
263 else
265 if (strlen (mfn) + (pe - p) >= mfnbuflen)
266 return 0;
267 string_cat_and_replace (mfn, p, pe - p, ':', '/');
268 p = pe;
272 return 1;
276 /***********************************************************************
277 Conversions on Apple event objects
278 ***********************************************************************/
280 static Lisp_Object Qundecoded_file_name;
282 static struct {
283 AEKeyword keyword;
284 char *name;
285 Lisp_Object symbol;
286 } ae_attr_table [] =
287 {{keyTransactionIDAttr, "transaction-id"},
288 {keyReturnIDAttr, "return-id"},
289 {keyEventClassAttr, "event-class"},
290 {keyEventIDAttr, "event-id"},
291 {keyAddressAttr, "address"},
292 {keyOptionalKeywordAttr, "optional-keyword"},
293 {keyTimeoutAttr, "timeout"},
294 {keyInteractLevelAttr, "interact-level"},
295 {keyEventSourceAttr, "event-source"},
296 /* {keyMissedKeywordAttr, "missed-keyword"}, */
297 {keyOriginalAddressAttr, "original-address"},
298 {keyReplyRequestedAttr, "reply-requested"},
299 {KEY_EMACS_SUSPENSION_ID_ATTR, "emacs-suspension-id"}
302 static Lisp_Object
303 mac_aelist_to_lisp (desc_list)
304 const AEDescList *desc_list;
306 OSErr err;
307 long count;
308 Lisp_Object result, elem;
309 DescType desc_type;
310 Size size;
311 AEKeyword keyword;
312 AEDesc desc;
313 int attribute_p = 0;
315 err = AECountItems (desc_list, &count);
316 if (err != noErr)
317 return Qnil;
318 result = Qnil;
320 again:
321 while (count > 0)
323 if (attribute_p)
325 keyword = ae_attr_table[count - 1].keyword;
326 err = AESizeOfAttribute (desc_list, keyword, &desc_type, &size);
328 else
329 err = AESizeOfNthItem (desc_list, count, &desc_type, &size);
331 if (err == noErr)
332 switch (desc_type)
334 case typeAEList:
335 case typeAERecord:
336 case typeAppleEvent:
337 if (attribute_p)
338 err = AEGetAttributeDesc (desc_list, keyword, typeWildCard,
339 &desc);
340 else
341 err = AEGetNthDesc (desc_list, count, typeWildCard,
342 &keyword, &desc);
343 if (err != noErr)
344 break;
345 elem = mac_aelist_to_lisp (&desc);
346 AEDisposeDesc (&desc);
347 break;
349 default:
350 if (desc_type == typeNull)
351 elem = Qnil;
352 else
354 elem = make_uninit_string (size);
355 if (attribute_p)
356 err = AEGetAttributePtr (desc_list, keyword, typeWildCard,
357 &desc_type, SDATA (elem),
358 size, &size);
359 else
360 err = AEGetNthPtr (desc_list, count, typeWildCard, &keyword,
361 &desc_type, SDATA (elem), size, &size);
363 if (err != noErr)
364 break;
365 desc_type = EndianU32_NtoB (desc_type);
366 elem = Fcons (make_unibyte_string ((char *) &desc_type, 4), elem);
367 break;
370 if (err == noErr || desc_list->descriptorType == typeAEList)
372 if (err != noErr)
373 elem = Qnil; /* Don't skip elements in AEList. */
374 else if (desc_list->descriptorType != typeAEList)
376 if (attribute_p)
377 elem = Fcons (ae_attr_table[count-1].symbol, elem);
378 else
380 keyword = EndianU32_NtoB (keyword);
381 elem = Fcons (make_unibyte_string ((char *) &keyword, 4),
382 elem);
386 result = Fcons (elem, result);
389 count--;
392 if (desc_list->descriptorType == typeAppleEvent && !attribute_p)
394 attribute_p = 1;
395 count = sizeof (ae_attr_table) / sizeof (ae_attr_table[0]);
396 goto again;
399 desc_type = EndianU32_NtoB (desc_list->descriptorType);
400 return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
403 Lisp_Object
404 mac_aedesc_to_lisp (desc)
405 const AEDesc *desc;
407 OSErr err = noErr;
408 DescType desc_type = desc->descriptorType;
409 Lisp_Object result;
411 switch (desc_type)
413 case typeNull:
414 result = Qnil;
415 break;
417 case typeAEList:
418 case typeAERecord:
419 case typeAppleEvent:
420 return mac_aelist_to_lisp (desc);
421 #if 0
422 /* The following one is much simpler, but creates and disposes
423 of Apple event descriptors many times. */
425 long count;
426 Lisp_Object elem;
427 AEKeyword keyword;
428 AEDesc desc1;
430 err = AECountItems (desc, &count);
431 if (err != noErr)
432 break;
433 result = Qnil;
434 while (count > 0)
436 err = AEGetNthDesc (desc, count, typeWildCard, &keyword, &desc1);
437 if (err != noErr)
438 break;
439 elem = mac_aedesc_to_lisp (&desc1);
440 AEDisposeDesc (&desc1);
441 if (desc_type != typeAEList)
443 keyword = EndianU32_NtoB (keyword);
444 elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem);
446 result = Fcons (elem, result);
447 count--;
450 #endif
451 break;
453 default:
454 #if TARGET_API_MAC_CARBON
455 result = make_uninit_string (AEGetDescDataSize (desc));
456 err = AEGetDescData (desc, SDATA (result), SBYTES (result));
457 #else
458 result = make_uninit_string (GetHandleSize (desc->dataHandle));
459 memcpy (SDATA (result), *(desc->dataHandle), SBYTES (result));
460 #endif
461 break;
464 if (err != noErr)
465 return Qnil;
467 desc_type = EndianU32_NtoB (desc_type);
468 return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
471 OSErr
472 mac_ae_put_lisp (desc, keyword_or_index, obj)
473 AEDescList *desc;
474 UInt32 keyword_or_index;
475 Lisp_Object obj;
477 OSErr err;
479 if (!(desc->descriptorType == typeAppleEvent
480 || desc->descriptorType == typeAERecord
481 || desc->descriptorType == typeAEList))
482 return errAEWrongDataType;
484 if (CONSP (obj) && STRINGP (XCAR (obj)) && SBYTES (XCAR (obj)) == 4)
486 DescType desc_type1 = EndianU32_BtoN (*((UInt32 *) SDATA (XCAR (obj))));
487 Lisp_Object data = XCDR (obj), rest;
488 AEDesc desc1;
490 switch (desc_type1)
492 case typeNull:
493 case typeAppleEvent:
494 break;
496 case typeAEList:
497 case typeAERecord:
498 err = AECreateList (NULL, 0, desc_type1 == typeAERecord, &desc1);
499 if (err == noErr)
501 for (rest = data; CONSP (rest); rest = XCDR (rest))
503 UInt32 keyword_or_index1 = 0;
504 Lisp_Object elem = XCAR (rest);
506 if (desc_type1 == typeAERecord)
508 if (CONSP (elem) && STRINGP (XCAR (elem))
509 && SBYTES (XCAR (elem)) == 4)
511 keyword_or_index1 =
512 EndianU32_BtoN (*((UInt32 *)
513 SDATA (XCAR (elem))));
514 elem = XCDR (elem);
516 else
517 continue;
520 err = mac_ae_put_lisp (&desc1, keyword_or_index1, elem);
521 if (err != noErr)
522 break;
525 if (err == noErr)
527 if (desc->descriptorType == typeAEList)
528 err = AEPutDesc (desc, keyword_or_index, &desc1);
529 else
530 err = AEPutParamDesc (desc, keyword_or_index, &desc1);
533 AEDisposeDesc (&desc1);
535 return err;
537 default:
538 if (!STRINGP (data))
539 break;
540 if (desc->descriptorType == typeAEList)
541 err = AEPutPtr (desc, keyword_or_index, desc_type1,
542 SDATA (data), SBYTES (data));
543 else
544 err = AEPutParamPtr (desc, keyword_or_index, desc_type1,
545 SDATA (data), SBYTES (data));
546 return err;
550 if (desc->descriptorType == typeAEList)
551 err = AEPutPtr (desc, keyword_or_index, typeNull, NULL, 0);
552 else
553 err = AEPutParamPtr (desc, keyword_or_index, typeNull, NULL, 0);
555 return err;
558 static pascal OSErr
559 mac_coerce_file_name_ptr (type_code, data_ptr, data_size,
560 to_type, handler_refcon, result)
561 DescType type_code;
562 const void *data_ptr;
563 Size data_size;
564 DescType to_type;
565 long handler_refcon;
566 AEDesc *result;
568 OSErr err;
570 if (type_code == typeNull)
571 err = errAECoercionFail;
572 else if (type_code == to_type || to_type == typeWildCard)
573 err = AECreateDesc (TYPE_FILE_NAME, data_ptr, data_size, result);
574 else if (type_code == TYPE_FILE_NAME)
575 /* Coercion from undecoded file name. */
577 #ifdef MAC_OSX
578 CFStringRef str;
579 CFURLRef url = NULL;
580 CFDataRef data = NULL;
582 str = CFStringCreateWithBytes (NULL, data_ptr, data_size,
583 kCFStringEncodingUTF8, false);
584 if (str)
586 url = CFURLCreateWithFileSystemPath (NULL, str,
587 kCFURLPOSIXPathStyle, false);
588 CFRelease (str);
590 if (url)
592 data = CFURLCreateData (NULL, url, kCFStringEncodingUTF8, true);
593 CFRelease (url);
595 if (data)
597 err = AECoercePtr (typeFileURL, CFDataGetBytePtr (data),
598 CFDataGetLength (data), to_type, result);
599 CFRelease (data);
601 else
602 err = memFullErr;
604 if (err != noErr)
606 /* Just to be paranoid ... */
607 FSRef fref;
608 char *buf;
610 buf = xmalloc (data_size + 1);
611 memcpy (buf, data_ptr, data_size);
612 buf[data_size] = '\0';
613 err = FSPathMakeRef (buf, &fref, NULL);
614 xfree (buf);
615 if (err == noErr)
616 err = AECoercePtr (typeFSRef, &fref, sizeof (FSRef),
617 to_type, result);
619 #else
620 FSSpec fs;
621 char *buf;
623 buf = xmalloc (data_size + 1);
624 memcpy (buf, data_ptr, data_size);
625 buf[data_size] = '\0';
626 err = posix_pathname_to_fsspec (buf, &fs);
627 xfree (buf);
628 if (err == noErr)
629 err = AECoercePtr (typeFSS, &fs, sizeof (FSSpec), to_type, result);
630 #endif
632 else if (to_type == TYPE_FILE_NAME)
633 /* Coercion to undecoded file name. */
635 #ifdef MAC_OSX
636 CFURLRef url = NULL;
637 CFStringRef str = NULL;
638 CFDataRef data = NULL;
640 if (type_code == typeFileURL)
641 url = CFURLCreateWithBytes (NULL, data_ptr, data_size,
642 kCFStringEncodingUTF8, NULL);
643 else
645 AEDesc desc;
646 Size size;
647 char *buf;
649 err = AECoercePtr (type_code, data_ptr, data_size,
650 typeFileURL, &desc);
651 if (err == noErr)
653 size = AEGetDescDataSize (&desc);
654 buf = xmalloc (size);
655 err = AEGetDescData (&desc, buf, size);
656 if (err == noErr)
657 url = CFURLCreateWithBytes (NULL, buf, size,
658 kCFStringEncodingUTF8, NULL);
659 xfree (buf);
660 AEDisposeDesc (&desc);
663 if (url)
665 str = CFURLCopyFileSystemPath (url, kCFURLPOSIXPathStyle);
666 CFRelease (url);
668 if (str)
670 data = CFStringCreateExternalRepresentation (NULL, str,
671 kCFStringEncodingUTF8,
672 '\0');
673 CFRelease (str);
675 if (data)
677 err = AECreateDesc (TYPE_FILE_NAME, CFDataGetBytePtr (data),
678 CFDataGetLength (data), result);
679 CFRelease (data);
682 if (err != noErr)
684 /* Coercion from typeAlias to typeFileURL fails on Mac OS X
685 10.2. In such cases, try typeFSRef as a target type. */
686 char file_name[MAXPATHLEN];
688 if (type_code == typeFSRef && data_size == sizeof (FSRef))
689 err = FSRefMakePath (data_ptr, file_name, sizeof (file_name));
690 else
692 AEDesc desc;
693 FSRef fref;
695 err = AECoercePtr (type_code, data_ptr, data_size,
696 typeFSRef, &desc);
697 if (err == noErr)
699 err = AEGetDescData (&desc, &fref, sizeof (FSRef));
700 AEDisposeDesc (&desc);
702 if (err == noErr)
703 err = FSRefMakePath (&fref, file_name, sizeof (file_name));
705 if (err == noErr)
706 err = AECreateDesc (TYPE_FILE_NAME, file_name,
707 strlen (file_name), result);
709 #else
710 char file_name[MAXPATHLEN];
712 if (type_code == typeFSS && data_size == sizeof (FSSpec))
713 err = fsspec_to_posix_pathname (data_ptr, file_name,
714 sizeof (file_name) - 1);
715 else
717 AEDesc desc;
718 FSSpec fs;
720 err = AECoercePtr (type_code, data_ptr, data_size, typeFSS, &desc);
721 if (err == noErr)
723 #if TARGET_API_MAC_CARBON
724 err = AEGetDescData (&desc, &fs, sizeof (FSSpec));
725 #else
726 fs = *(FSSpec *)(*(desc.dataHandle));
727 #endif
728 AEDisposeDesc (&desc);
730 if (err == noErr)
731 err = fsspec_to_posix_pathname (&fs, file_name,
732 sizeof (file_name) - 1);
734 if (err == noErr)
735 err = AECreateDesc (TYPE_FILE_NAME, file_name,
736 strlen (file_name), result);
737 #endif
739 else
740 abort ();
742 if (err != noErr)
743 return errAECoercionFail;
744 return noErr;
747 static pascal OSErr
748 mac_coerce_file_name_desc (from_desc, to_type, handler_refcon, result)
749 const AEDesc *from_desc;
750 DescType to_type;
751 long handler_refcon;
752 AEDesc *result;
754 OSErr err = noErr;
755 DescType from_type = from_desc->descriptorType;
757 if (from_type == typeNull)
758 err = errAECoercionFail;
759 else if (from_type == to_type || to_type == typeWildCard)
760 err = AEDuplicateDesc (from_desc, result);
761 else
763 char *data_ptr;
764 Size data_size;
766 #if TARGET_API_MAC_CARBON
767 data_size = AEGetDescDataSize (from_desc);
768 #else
769 data_size = GetHandleSize (from_desc->dataHandle);
770 #endif
771 data_ptr = xmalloc (data_size);
772 #if TARGET_API_MAC_CARBON
773 err = AEGetDescData (from_desc, data_ptr, data_size);
774 #else
775 memcpy (data_ptr, *(from_desc->dataHandle), data_size);
776 #endif
777 if (err == noErr)
778 err = mac_coerce_file_name_ptr (from_type, data_ptr,
779 data_size, to_type,
780 handler_refcon, result);
781 xfree (data_ptr);
784 if (err != noErr)
785 return errAECoercionFail;
786 return noErr;
789 OSErr
790 init_coercion_handler ()
792 OSErr err;
794 static AECoercePtrUPP coerce_file_name_ptrUPP = NULL;
795 static AECoerceDescUPP coerce_file_name_descUPP = NULL;
797 if (coerce_file_name_ptrUPP == NULL)
799 coerce_file_name_ptrUPP = NewAECoercePtrUPP (mac_coerce_file_name_ptr);
800 coerce_file_name_descUPP = NewAECoerceDescUPP (mac_coerce_file_name_desc);
803 err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
804 (AECoercionHandlerUPP)
805 coerce_file_name_ptrUPP, 0, false, false);
806 if (err == noErr)
807 err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
808 (AECoercionHandlerUPP)
809 coerce_file_name_ptrUPP, 0, false, false);
810 if (err == noErr)
811 err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
812 coerce_file_name_descUPP, 0, true, false);
813 if (err == noErr)
814 err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
815 coerce_file_name_descUPP, 0, true, false);
816 return err;
819 #if TARGET_API_MAC_CARBON
820 OSErr
821 create_apple_event (class, id, result)
822 AEEventClass class;
823 AEEventID id;
824 AppleEvent *result;
826 OSErr err;
827 static const ProcessSerialNumber psn = {0, kCurrentProcess};
828 AEAddressDesc address_desc;
830 err = AECreateDesc (typeProcessSerialNumber, &psn,
831 sizeof (ProcessSerialNumber), &address_desc);
832 if (err == noErr)
834 err = AECreateAppleEvent (class, id,
835 &address_desc, /* NULL is not allowed
836 on Mac OS Classic. */
837 kAutoGenerateReturnID,
838 kAnyTransactionID, result);
839 AEDisposeDesc (&address_desc);
842 return err;
845 Lisp_Object
846 mac_event_parameters_to_lisp (event, num_params, names, types)
847 EventRef event;
848 UInt32 num_params;
849 const EventParamName *names;
850 const EventParamType *types;
852 OSStatus err;
853 Lisp_Object result = Qnil;
854 UInt32 i;
855 ByteCount size;
856 #ifdef MAC_OSX
857 CFStringRef string;
858 CFDataRef data;
859 #endif
860 char *buf = NULL;
862 for (i = 0; i < num_params; i++)
864 EventParamName name = names[i];
865 EventParamType type = types[i];
867 switch (type)
869 #ifdef MAC_OSX
870 case typeCFStringRef:
871 err = GetEventParameter (event, name, typeCFStringRef, NULL,
872 sizeof (CFStringRef), NULL, &string);
873 if (err != noErr)
874 break;
875 data = CFStringCreateExternalRepresentation (NULL, string,
876 kCFStringEncodingUTF8,
877 '?');
878 if (data == NULL)
879 break;
880 name = EndianU32_NtoB (name);
881 type = EndianU32_NtoB (typeUTF8Text);
882 result =
883 Fcons (Fcons (make_unibyte_string ((char *) &name, 4),
884 Fcons (make_unibyte_string ((char *) &type, 4),
885 make_unibyte_string (CFDataGetBytePtr (data),
886 CFDataGetLength (data)))),
887 result);
888 CFRelease (data);
889 break;
890 #endif
892 default:
893 err = GetEventParameter (event, name, type, NULL, 0, &size, NULL);
894 if (err != noErr)
895 break;
896 buf = xrealloc (buf, size);
897 err = GetEventParameter (event, name, type, NULL, size, NULL, buf);
898 if (err == noErr)
900 name = EndianU32_NtoB (name);
901 type = EndianU32_NtoB (type);
902 result =
903 Fcons (Fcons (make_unibyte_string ((char *) &name, 4),
904 Fcons (make_unibyte_string ((char *) &type, 4),
905 make_unibyte_string (buf, size))),
906 result);
908 break;
911 if (buf)
912 xfree (buf);
914 return result;
916 #endif /* TARGET_API_MAC_CARBON */
918 /***********************************************************************
919 Conversion between Lisp and Core Foundation objects
920 ***********************************************************************/
922 #if TARGET_API_MAC_CARBON
923 static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
924 static Lisp_Object Qarray, Qdictionary;
926 struct cfdict_context
928 Lisp_Object *result;
929 int with_tag, hash_bound;
932 /* C string to CFString. */
934 CFStringRef
935 cfstring_create_with_utf8_cstring (c_str)
936 const char *c_str;
938 CFStringRef str;
940 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingUTF8);
941 if (str == NULL)
942 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
943 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingMacRoman);
945 return str;
949 /* Lisp string to CFString. */
951 CFStringRef
952 cfstring_create_with_string (s)
953 Lisp_Object s;
955 CFStringRef string = NULL;
957 if (STRING_MULTIBYTE (s))
959 char *p, *end = SDATA (s) + SBYTES (s);
961 for (p = SDATA (s); p < end; p++)
962 if (!isascii (*p))
964 s = ENCODE_UTF_8 (s);
965 break;
967 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
968 kCFStringEncodingUTF8, false);
971 if (string == NULL)
972 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
973 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
974 kCFStringEncodingMacRoman, false);
976 return string;
980 /* From CFData to a lisp string. Always returns a unibyte string. */
982 Lisp_Object
983 cfdata_to_lisp (data)
984 CFDataRef data;
986 CFIndex len = CFDataGetLength (data);
987 Lisp_Object result = make_uninit_string (len);
989 CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
991 return result;
995 /* From CFString to a lisp string. Returns a unibyte string
996 containing a UTF-8 byte sequence. */
998 Lisp_Object
999 cfstring_to_lisp_nodecode (string)
1000 CFStringRef string;
1002 Lisp_Object result = Qnil;
1003 const char *s = CFStringGetCStringPtr (string, kCFStringEncodingUTF8);
1005 if (s)
1006 result = make_unibyte_string (s, strlen (s));
1007 else
1009 CFDataRef data =
1010 CFStringCreateExternalRepresentation (NULL, string,
1011 kCFStringEncodingUTF8, '?');
1013 if (data)
1015 result = cfdata_to_lisp (data);
1016 CFRelease (data);
1020 return result;
1024 /* From CFString to a lisp string. Never returns a unibyte string
1025 (even if it only contains ASCII characters).
1026 This may cause GC during code conversion. */
1028 Lisp_Object
1029 cfstring_to_lisp (string)
1030 CFStringRef string;
1032 Lisp_Object result = cfstring_to_lisp_nodecode (string);
1034 if (!NILP (result))
1036 result = code_convert_string_norecord (result, Qutf_8, 0);
1037 /* This may be superfluous. Just to make sure that the result
1038 is a multibyte string. */
1039 result = string_to_multibyte (result);
1042 return result;
1046 /* CFNumber to a lisp integer or a lisp float. */
1048 Lisp_Object
1049 cfnumber_to_lisp (number)
1050 CFNumberRef number;
1052 Lisp_Object result = Qnil;
1053 #if BITS_PER_EMACS_INT > 32
1054 SInt64 int_val;
1055 CFNumberType emacs_int_type = kCFNumberSInt64Type;
1056 #else
1057 SInt32 int_val;
1058 CFNumberType emacs_int_type = kCFNumberSInt32Type;
1059 #endif
1060 double float_val;
1062 if (CFNumberGetValue (number, emacs_int_type, &int_val)
1063 && !FIXNUM_OVERFLOW_P (int_val))
1064 result = make_number (int_val);
1065 else
1066 if (CFNumberGetValue (number, kCFNumberDoubleType, &float_val))
1067 result = make_float (float_val);
1068 return result;
1072 /* CFDate to a list of three integers as in a return value of
1073 `current-time'. */
1075 Lisp_Object
1076 cfdate_to_lisp (date)
1077 CFDateRef date;
1079 CFTimeInterval sec;
1080 int high, low, microsec;
1082 sec = CFDateGetAbsoluteTime (date) + kCFAbsoluteTimeIntervalSince1970;
1083 high = sec / 65536.0;
1084 low = sec - high * 65536.0;
1085 microsec = (sec - floor (sec)) * 1000000.0;
1087 return list3 (make_number (high), make_number (low), make_number (microsec));
1091 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1093 Lisp_Object
1094 cfboolean_to_lisp (boolean)
1095 CFBooleanRef boolean;
1097 return CFBooleanGetValue (boolean) ? Qt : Qnil;
1101 /* Any Core Foundation object to a (lengthy) lisp string. */
1103 Lisp_Object
1104 cfobject_desc_to_lisp (object)
1105 CFTypeRef object;
1107 Lisp_Object result = Qnil;
1108 CFStringRef desc = CFCopyDescription (object);
1110 if (desc)
1112 result = cfstring_to_lisp (desc);
1113 CFRelease (desc);
1116 return result;
1120 /* Callback functions for cfproperty_list_to_lisp. */
1122 static void
1123 cfdictionary_add_to_list (key, value, context)
1124 const void *key;
1125 const void *value;
1126 void *context;
1128 struct cfdict_context *cxt = (struct cfdict_context *)context;
1130 *cxt->result =
1131 Fcons (Fcons (cfstring_to_lisp (key),
1132 cfproperty_list_to_lisp (value, cxt->with_tag,
1133 cxt->hash_bound)),
1134 *cxt->result);
1137 static void
1138 cfdictionary_puthash (key, value, context)
1139 const void *key;
1140 const void *value;
1141 void *context;
1143 Lisp_Object lisp_key = cfstring_to_lisp (key);
1144 struct cfdict_context *cxt = (struct cfdict_context *)context;
1145 struct Lisp_Hash_Table *h = XHASH_TABLE (*(cxt->result));
1146 unsigned hash_code;
1148 hash_lookup (h, lisp_key, &hash_code);
1149 hash_put (h, lisp_key,
1150 cfproperty_list_to_lisp (value, cxt->with_tag, cxt->hash_bound),
1151 hash_code);
1155 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1156 non-zero, a symbol that represents the type of the original Core
1157 Foundation object is prepended. HASH_BOUND specifies which kinds
1158 of the lisp objects, alists or hash tables, are used as the targets
1159 of the conversion from CFDictionary. If HASH_BOUND is negative,
1160 always generate alists. If HASH_BOUND >= 0, generate an alist if
1161 the number of keys in the dictionary is smaller than HASH_BOUND,
1162 and a hash table otherwise. */
1164 Lisp_Object
1165 cfproperty_list_to_lisp (plist, with_tag, hash_bound)
1166 CFPropertyListRef plist;
1167 int with_tag, hash_bound;
1169 CFTypeID type_id = CFGetTypeID (plist);
1170 Lisp_Object tag = Qnil, result = Qnil;
1171 struct gcpro gcpro1, gcpro2;
1173 GCPRO2 (tag, result);
1175 if (type_id == CFStringGetTypeID ())
1177 tag = Qstring;
1178 result = cfstring_to_lisp (plist);
1180 else if (type_id == CFNumberGetTypeID ())
1182 tag = Qnumber;
1183 result = cfnumber_to_lisp (plist);
1185 else if (type_id == CFBooleanGetTypeID ())
1187 tag = Qboolean;
1188 result = cfboolean_to_lisp (plist);
1190 else if (type_id == CFDateGetTypeID ())
1192 tag = Qdate;
1193 result = cfdate_to_lisp (plist);
1195 else if (type_id == CFDataGetTypeID ())
1197 tag = Qdata;
1198 result = cfdata_to_lisp (plist);
1200 else if (type_id == CFArrayGetTypeID ())
1202 CFIndex index, count = CFArrayGetCount (plist);
1204 tag = Qarray;
1205 result = Fmake_vector (make_number (count), Qnil);
1206 for (index = 0; index < count; index++)
1207 XVECTOR (result)->contents[index] =
1208 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist, index),
1209 with_tag, hash_bound);
1211 else if (type_id == CFDictionaryGetTypeID ())
1213 struct cfdict_context context;
1214 CFIndex count = CFDictionaryGetCount (plist);
1216 tag = Qdictionary;
1217 context.result = &result;
1218 context.with_tag = with_tag;
1219 context.hash_bound = hash_bound;
1220 if (hash_bound < 0 || count < hash_bound)
1222 result = Qnil;
1223 CFDictionaryApplyFunction (plist, cfdictionary_add_to_list,
1224 &context);
1226 else
1228 result = make_hash_table (Qequal,
1229 make_number (count),
1230 make_float (DEFAULT_REHASH_SIZE),
1231 make_float (DEFAULT_REHASH_THRESHOLD),
1232 Qnil, Qnil, Qnil);
1233 CFDictionaryApplyFunction (plist, cfdictionary_puthash,
1234 &context);
1237 else
1238 abort ();
1240 UNGCPRO;
1242 if (with_tag)
1243 result = Fcons (tag, result);
1245 return result;
1247 #endif
1250 /***********************************************************************
1251 Emulation of the X Resource Manager
1252 ***********************************************************************/
1254 /* Parser functions for resource lines. Each function takes an
1255 address of a variable whose value points to the head of a string.
1256 The value will be advanced so that it points to the next character
1257 of the parsed part when the function returns.
1259 A resource name such as "Emacs*font" is parsed into a non-empty
1260 list called `quarks'. Each element is either a Lisp string that
1261 represents a concrete component, a Lisp symbol LOOSE_BINDING
1262 (actually Qlambda) that represents any number (>=0) of intervening
1263 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1264 that represents as any single component. */
1266 #define P (*p)
1268 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1269 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1271 static void
1272 skip_white_space (p)
1273 const char **p;
1275 /* WhiteSpace = {<space> | <horizontal tab>} */
1276 while (*P == ' ' || *P == '\t')
1277 P++;
1280 static int
1281 parse_comment (p)
1282 const char **p;
1284 /* Comment = "!" {<any character except null or newline>} */
1285 if (*P == '!')
1287 P++;
1288 while (*P)
1289 if (*P++ == '\n')
1290 break;
1291 return 1;
1293 else
1294 return 0;
1297 /* Don't interpret filename. Just skip until the newline. */
1298 static int
1299 parse_include_file (p)
1300 const char **p;
1302 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1303 if (*P == '#')
1305 P++;
1306 while (*P)
1307 if (*P++ == '\n')
1308 break;
1309 return 1;
1311 else
1312 return 0;
1315 static char
1316 parse_binding (p)
1317 const char **p;
1319 /* Binding = "." | "*" */
1320 if (*P == '.' || *P == '*')
1322 char binding = *P++;
1324 while (*P == '.' || *P == '*')
1325 if (*P++ == '*')
1326 binding = '*';
1327 return binding;
1329 else
1330 return '\0';
1333 static Lisp_Object
1334 parse_component (p)
1335 const char **p;
1337 /* Component = "?" | ComponentName
1338 ComponentName = NameChar {NameChar}
1339 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1340 if (*P == '?')
1342 P++;
1343 return SINGLE_COMPONENT;
1345 else if (isalnum (*P) || *P == '_' || *P == '-')
1347 const char *start = P++;
1349 while (isalnum (*P) || *P == '_' || *P == '-')
1350 P++;
1352 return make_unibyte_string (start, P - start);
1354 else
1355 return Qnil;
1358 static Lisp_Object
1359 parse_resource_name (p)
1360 const char **p;
1362 Lisp_Object result = Qnil, component;
1363 char binding;
1365 /* ResourceName = [Binding] {Component Binding} ComponentName */
1366 if (parse_binding (p) == '*')
1367 result = Fcons (LOOSE_BINDING, result);
1369 component = parse_component (p);
1370 if (NILP (component))
1371 return Qnil;
1373 result = Fcons (component, result);
1374 while ((binding = parse_binding (p)) != '\0')
1376 if (binding == '*')
1377 result = Fcons (LOOSE_BINDING, result);
1378 component = parse_component (p);
1379 if (NILP (component))
1380 return Qnil;
1381 else
1382 result = Fcons (component, result);
1385 /* The final component should not be '?'. */
1386 if (EQ (component, SINGLE_COMPONENT))
1387 return Qnil;
1389 return Fnreverse (result);
1392 static Lisp_Object
1393 parse_value (p)
1394 const char **p;
1396 char *q, *buf;
1397 Lisp_Object seq = Qnil, result;
1398 int buf_len, total_len = 0, len, continue_p;
1400 q = strchr (P, '\n');
1401 buf_len = q ? q - P : strlen (P);
1402 buf = xmalloc (buf_len);
1404 while (1)
1406 q = buf;
1407 continue_p = 0;
1408 while (*P)
1410 if (*P == '\n')
1412 P++;
1413 break;
1415 else if (*P == '\\')
1417 P++;
1418 if (*P == '\0')
1419 break;
1420 else if (*P == '\n')
1422 P++;
1423 continue_p = 1;
1424 break;
1426 else if (*P == 'n')
1428 *q++ = '\n';
1429 P++;
1431 else if ('0' <= P[0] && P[0] <= '7'
1432 && '0' <= P[1] && P[1] <= '7'
1433 && '0' <= P[2] && P[2] <= '7')
1435 *q++ = ((P[0] - '0') << 6) + ((P[1] - '0') << 3) + (P[2] - '0');
1436 P += 3;
1438 else
1439 *q++ = *P++;
1441 else
1442 *q++ = *P++;
1444 len = q - buf;
1445 seq = Fcons (make_unibyte_string (buf, len), seq);
1446 total_len += len;
1448 if (continue_p)
1450 q = strchr (P, '\n');
1451 len = q ? q - P : strlen (P);
1452 if (len > buf_len)
1454 xfree (buf);
1455 buf_len = len;
1456 buf = xmalloc (buf_len);
1459 else
1460 break;
1462 xfree (buf);
1464 if (SBYTES (XCAR (seq)) == total_len)
1465 return make_string (SDATA (XCAR (seq)), total_len);
1466 else
1468 buf = xmalloc (total_len);
1469 q = buf + total_len;
1470 for (; CONSP (seq); seq = XCDR (seq))
1472 len = SBYTES (XCAR (seq));
1473 q -= len;
1474 memcpy (q, SDATA (XCAR (seq)), len);
1476 result = make_string (buf, total_len);
1477 xfree (buf);
1478 return result;
1482 static Lisp_Object
1483 parse_resource_line (p)
1484 const char **p;
1486 Lisp_Object quarks, value;
1488 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1489 if (parse_comment (p) || parse_include_file (p))
1490 return Qnil;
1492 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1493 skip_white_space (p);
1494 quarks = parse_resource_name (p);
1495 if (NILP (quarks))
1496 goto cleanup;
1497 skip_white_space (p);
1498 if (*P != ':')
1499 goto cleanup;
1500 P++;
1501 skip_white_space (p);
1502 value = parse_value (p);
1503 return Fcons (quarks, value);
1505 cleanup:
1506 /* Skip the remaining data as a dummy value. */
1507 parse_value (p);
1508 return Qnil;
1511 #undef P
1513 /* Equivalents of X Resource Manager functions.
1515 An X Resource Database acts as a collection of resource names and
1516 associated values. It is implemented as a trie on quarks. Namely,
1517 each edge is labeled by either a string, LOOSE_BINDING, or
1518 SINGLE_COMPONENT. Each node has a node id, which is a unique
1519 nonnegative integer, and the root node id is 0. A database is
1520 implemented as a hash table that maps a pair (SRC-NODE-ID .
1521 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1522 in the table as a value for HASHKEY_MAX_NID. A value associated to
1523 a node is recorded as a value for the node id.
1525 A database also has a cache for past queries as a value for
1526 HASHKEY_QUERY_CACHE. It is another hash table that maps
1527 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1529 #define HASHKEY_MAX_NID (make_number (0))
1530 #define HASHKEY_QUERY_CACHE (make_number (-1))
1532 static XrmDatabase
1533 xrm_create_database ()
1535 XrmDatabase database;
1537 database = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1538 make_float (DEFAULT_REHASH_SIZE),
1539 make_float (DEFAULT_REHASH_THRESHOLD),
1540 Qnil, Qnil, Qnil);
1541 Fputhash (HASHKEY_MAX_NID, make_number (0), database);
1542 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
1544 return database;
1547 static void
1548 xrm_q_put_resource (database, quarks, value)
1549 XrmDatabase database;
1550 Lisp_Object quarks, value;
1552 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
1553 unsigned hash_code;
1554 int max_nid, i;
1555 Lisp_Object node_id, key;
1557 max_nid = XINT (Fgethash (HASHKEY_MAX_NID, database, Qnil));
1559 XSETINT (node_id, 0);
1560 for (; CONSP (quarks); quarks = XCDR (quarks))
1562 key = Fcons (node_id, XCAR (quarks));
1563 i = hash_lookup (h, key, &hash_code);
1564 if (i < 0)
1566 max_nid++;
1567 XSETINT (node_id, max_nid);
1568 hash_put (h, key, node_id, hash_code);
1570 else
1571 node_id = HASH_VALUE (h, i);
1573 Fputhash (node_id, value, database);
1575 Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
1576 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
1579 /* Merge multiple resource entries specified by DATA into a resource
1580 database DATABASE. DATA points to the head of a null-terminated
1581 string consisting of multiple resource lines. It's like a
1582 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1584 void
1585 xrm_merge_string_database (database, data)
1586 XrmDatabase database;
1587 const char *data;
1589 Lisp_Object quarks_value;
1591 while (*data)
1593 quarks_value = parse_resource_line (&data);
1594 if (!NILP (quarks_value))
1595 xrm_q_put_resource (database,
1596 XCAR (quarks_value), XCDR (quarks_value));
1600 static Lisp_Object
1601 xrm_q_get_resource_1 (database, node_id, quark_name, quark_class)
1602 XrmDatabase database;
1603 Lisp_Object node_id, quark_name, quark_class;
1605 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
1606 Lisp_Object key, labels[3], value;
1607 int i, k;
1609 if (!CONSP (quark_name))
1610 return Fgethash (node_id, database, Qnil);
1612 /* First, try tight bindings */
1613 labels[0] = XCAR (quark_name);
1614 labels[1] = XCAR (quark_class);
1615 labels[2] = SINGLE_COMPONENT;
1617 key = Fcons (node_id, Qnil);
1618 for (k = 0; k < sizeof (labels) / sizeof (*labels); k++)
1620 XSETCDR (key, labels[k]);
1621 i = hash_lookup (h, key, NULL);
1622 if (i >= 0)
1624 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1625 XCDR (quark_name), XCDR (quark_class));
1626 if (!NILP (value))
1627 return value;
1631 /* Then, try loose bindings */
1632 XSETCDR (key, LOOSE_BINDING);
1633 i = hash_lookup (h, key, NULL);
1634 if (i >= 0)
1636 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1637 quark_name, quark_class);
1638 if (!NILP (value))
1639 return value;
1640 else
1641 return xrm_q_get_resource_1 (database, node_id,
1642 XCDR (quark_name), XCDR (quark_class));
1644 else
1645 return Qnil;
1648 static Lisp_Object
1649 xrm_q_get_resource (database, quark_name, quark_class)
1650 XrmDatabase database;
1651 Lisp_Object quark_name, quark_class;
1653 return xrm_q_get_resource_1 (database, make_number (0),
1654 quark_name, quark_class);
1657 /* Retrieve a resource value for the specified NAME and CLASS from the
1658 resource database DATABASE. It corresponds to XrmGetResource. */
1660 Lisp_Object
1661 xrm_get_resource (database, name, class)
1662 XrmDatabase database;
1663 const char *name, *class;
1665 Lisp_Object key, query_cache, quark_name, quark_class, tmp;
1666 int i, nn, nc;
1667 struct Lisp_Hash_Table *h;
1668 unsigned hash_code;
1670 nn = strlen (name);
1671 nc = strlen (class);
1672 key = make_uninit_string (nn + nc + 1);
1673 strcpy (SDATA (key), name);
1674 strncpy (SDATA (key) + nn + 1, class, nc);
1676 query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil);
1677 if (NILP (query_cache))
1679 query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1680 make_float (DEFAULT_REHASH_SIZE),
1681 make_float (DEFAULT_REHASH_THRESHOLD),
1682 Qnil, Qnil, Qnil);
1683 Fputhash (HASHKEY_QUERY_CACHE, query_cache, database);
1685 h = XHASH_TABLE (query_cache);
1686 i = hash_lookup (h, key, &hash_code);
1687 if (i >= 0)
1688 return HASH_VALUE (h, i);
1690 quark_name = parse_resource_name (&name);
1691 if (*name != '\0')
1692 return Qnil;
1693 for (tmp = quark_name, nn = 0; CONSP (tmp); tmp = XCDR (tmp), nn++)
1694 if (!STRINGP (XCAR (tmp)))
1695 return Qnil;
1697 quark_class = parse_resource_name (&class);
1698 if (*class != '\0')
1699 return Qnil;
1700 for (tmp = quark_class, nc = 0; CONSP (tmp); tmp = XCDR (tmp), nc++)
1701 if (!STRINGP (XCAR (tmp)))
1702 return Qnil;
1704 if (nn != nc)
1705 return Qnil;
1706 else
1708 tmp = xrm_q_get_resource (database, quark_name, quark_class);
1709 hash_put (h, key, tmp, hash_code);
1710 return tmp;
1714 #if TARGET_API_MAC_CARBON
1715 static Lisp_Object
1716 xrm_cfproperty_list_to_value (plist)
1717 CFPropertyListRef plist;
1719 CFTypeID type_id = CFGetTypeID (plist);
1721 if (type_id == CFStringGetTypeID ())
1722 return cfstring_to_lisp (plist);
1723 else if (type_id == CFNumberGetTypeID ())
1725 CFStringRef string;
1726 Lisp_Object result = Qnil;
1728 string = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@"), plist);
1729 if (string)
1731 result = cfstring_to_lisp (string);
1732 CFRelease (string);
1734 return result;
1736 else if (type_id == CFBooleanGetTypeID ())
1737 return build_string (CFBooleanGetValue (plist) ? "true" : "false");
1738 else if (type_id == CFDataGetTypeID ())
1739 return cfdata_to_lisp (plist);
1740 else
1741 return Qnil;
1743 #endif
1745 /* Create a new resource database from the preferences for the
1746 application APPLICATION. APPLICATION is either a string that
1747 specifies an application ID, or NULL that represents the current
1748 application. */
1750 XrmDatabase
1751 xrm_get_preference_database (application)
1752 const char *application;
1754 #if TARGET_API_MAC_CARBON
1755 CFStringRef app_id, *keys, user_doms[2], host_doms[2];
1756 CFMutableSetRef key_set = NULL;
1757 CFArrayRef key_array;
1758 CFIndex index, count;
1759 char *res_name;
1760 XrmDatabase database;
1761 Lisp_Object quarks = Qnil, value = Qnil;
1762 CFPropertyListRef plist;
1763 int iu, ih;
1764 struct gcpro gcpro1, gcpro2, gcpro3;
1766 user_doms[0] = kCFPreferencesCurrentUser;
1767 user_doms[1] = kCFPreferencesAnyUser;
1768 host_doms[0] = kCFPreferencesCurrentHost;
1769 host_doms[1] = kCFPreferencesAnyHost;
1771 database = xrm_create_database ();
1773 GCPRO3 (database, quarks, value);
1775 app_id = kCFPreferencesCurrentApplication;
1776 if (application)
1778 app_id = cfstring_create_with_utf8_cstring (application);
1779 if (app_id == NULL)
1780 goto out;
1782 if (!CFPreferencesAppSynchronize (app_id))
1783 goto out;
1785 key_set = CFSetCreateMutable (NULL, 0, &kCFCopyStringSetCallBacks);
1786 if (key_set == NULL)
1787 goto out;
1788 for (iu = 0; iu < sizeof (user_doms) / sizeof (*user_doms) ; iu++)
1789 for (ih = 0; ih < sizeof (host_doms) / sizeof (*host_doms); ih++)
1791 key_array = CFPreferencesCopyKeyList (app_id, user_doms[iu],
1792 host_doms[ih]);
1793 if (key_array)
1795 count = CFArrayGetCount (key_array);
1796 for (index = 0; index < count; index++)
1797 CFSetAddValue (key_set,
1798 CFArrayGetValueAtIndex (key_array, index));
1799 CFRelease (key_array);
1803 count = CFSetGetCount (key_set);
1804 keys = xmalloc (sizeof (CFStringRef) * count);
1805 CFSetGetValues (key_set, (const void **)keys);
1806 for (index = 0; index < count; index++)
1808 res_name = SDATA (cfstring_to_lisp_nodecode (keys[index]));
1809 quarks = parse_resource_name (&res_name);
1810 if (!(NILP (quarks) || *res_name))
1812 plist = CFPreferencesCopyAppValue (keys[index], app_id);
1813 value = xrm_cfproperty_list_to_value (plist);
1814 CFRelease (plist);
1815 if (!NILP (value))
1816 xrm_q_put_resource (database, quarks, value);
1820 xfree (keys);
1821 out:
1822 if (key_set)
1823 CFRelease (key_set);
1824 CFRelease (app_id);
1826 UNGCPRO;
1828 return database;
1829 #else
1830 return xrm_create_database ();
1831 #endif
1835 #ifndef MAC_OSX
1837 /* The following functions with "sys_" prefix are stubs to Unix
1838 functions that have already been implemented by CW or MPW. The
1839 calls to them in Emacs source course are #define'd to call the sys_
1840 versions by the header files s-mac.h. In these stubs pathnames are
1841 converted between their Unix and Mac forms. */
1844 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1845 + 17 leap days. These are for adjusting time values returned by
1846 MacOS Toolbox functions. */
1848 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1850 #ifdef __MWERKS__
1851 #if __MSL__ < 0x6000
1852 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1853 a leap year! This is for adjusting time_t values returned by MSL
1854 functions. */
1855 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1856 #else /* __MSL__ >= 0x6000 */
1857 /* CW changes Pro 6 to follow Unix! */
1858 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1859 #endif /* __MSL__ >= 0x6000 */
1860 #elif __MRC__
1861 /* MPW library functions follow Unix (confused?). */
1862 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1863 #else /* not __MRC__ */
1864 You lose!!!
1865 #endif /* not __MRC__ */
1868 /* Define our own stat function for both MrC and CW. The reason for
1869 doing this: "stat" is both the name of a struct and function name:
1870 can't use the same trick like that for sys_open, sys_close, etc. to
1871 redirect Emacs's calls to our own version that converts Unix style
1872 filenames to Mac style filename because all sorts of compilation
1873 errors will be generated if stat is #define'd to be sys_stat. */
1876 stat_noalias (const char *path, struct stat *buf)
1878 char mac_pathname[MAXPATHLEN+1];
1879 CInfoPBRec cipb;
1881 if (posix_to_mac_pathname (path, mac_pathname, MAXPATHLEN+1) == 0)
1882 return -1;
1884 c2pstr (mac_pathname);
1885 cipb.hFileInfo.ioNamePtr = mac_pathname;
1886 cipb.hFileInfo.ioVRefNum = 0;
1887 cipb.hFileInfo.ioDirID = 0;
1888 cipb.hFileInfo.ioFDirIndex = 0;
1889 /* set to 0 to get information about specific dir or file */
1891 errno = PBGetCatInfo (&cipb, false);
1892 if (errno == -43) /* -43: fnfErr defined in Errors.h */
1893 errno = ENOENT;
1894 if (errno != noErr)
1895 return -1;
1897 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
1899 buf->st_mode = S_IFDIR | S_IREAD | S_IEXEC;
1901 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1902 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1903 buf->st_ino = cipb.dirInfo.ioDrDirID;
1904 buf->st_dev = cipb.dirInfo.ioVRefNum;
1905 buf->st_size = cipb.dirInfo.ioDrNmFls;
1906 /* size of dir = number of files and dirs */
1907 buf->st_atime
1908 = buf->st_mtime
1909 = cipb.dirInfo.ioDrMdDat - MAC_UNIX_EPOCH_DIFF;
1910 buf->st_ctime = cipb.dirInfo.ioDrCrDat - MAC_UNIX_EPOCH_DIFF;
1912 else
1914 buf->st_mode = S_IFREG | S_IREAD;
1915 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1916 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1917 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
1918 buf->st_mode |= S_IEXEC;
1919 buf->st_ino = cipb.hFileInfo.ioDirID;
1920 buf->st_dev = cipb.hFileInfo.ioVRefNum;
1921 buf->st_size = cipb.hFileInfo.ioFlLgLen;
1922 buf->st_atime
1923 = buf->st_mtime
1924 = cipb.hFileInfo.ioFlMdDat - MAC_UNIX_EPOCH_DIFF;
1925 buf->st_ctime = cipb.hFileInfo.ioFlCrDat - MAC_UNIX_EPOCH_DIFF;
1928 if (cipb.hFileInfo.ioFlFndrInfo.fdFlags & 0x8000)
1930 /* identify alias files as symlinks */
1931 buf->st_mode &= ~S_IFREG;
1932 buf->st_mode |= S_IFLNK;
1935 buf->st_nlink = 1;
1936 buf->st_uid = getuid ();
1937 buf->st_gid = getgid ();
1938 buf->st_rdev = 0;
1940 return 0;
1945 lstat (const char *path, struct stat *buf)
1947 int result;
1948 char true_pathname[MAXPATHLEN+1];
1950 /* Try looking for the file without resolving aliases first. */
1951 if ((result = stat_noalias (path, buf)) >= 0)
1952 return result;
1954 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1955 return -1;
1957 return stat_noalias (true_pathname, buf);
1962 stat (const char *path, struct stat *sb)
1964 int result;
1965 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1966 int len;
1968 if ((result = stat_noalias (path, sb)) >= 0 &&
1969 ! (sb->st_mode & S_IFLNK))
1970 return result;
1972 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1973 return -1;
1975 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
1976 if (len > -1)
1978 fully_resolved_name[len] = '\0';
1979 /* in fact our readlink terminates strings */
1980 return lstat (fully_resolved_name, sb);
1982 else
1983 return lstat (true_pathname, sb);
1987 #if __MRC__
1988 /* CW defines fstat in stat.mac.c while MPW does not provide this
1989 function. Without the information of how to get from a file
1990 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1991 to implement this function. Fortunately, there is only one place
1992 where this function is called in our configuration: in fileio.c,
1993 where only the st_dev and st_ino fields are used to determine
1994 whether two fildes point to different i-nodes to prevent copying
1995 a file onto itself equal. What we have here probably needs
1996 improvement. */
1999 fstat (int fildes, struct stat *buf)
2001 buf->st_dev = 0;
2002 buf->st_ino = fildes;
2003 buf->st_mode = S_IFREG; /* added by T.I. for the copy-file */
2004 return 0; /* success */
2006 #endif /* __MRC__ */
2010 mkdir (const char *dirname, int mode)
2012 #pragma unused(mode)
2014 HFileParam hfpb;
2015 char true_pathname[MAXPATHLEN+1], mac_pathname[MAXPATHLEN+1];
2017 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
2018 return -1;
2020 if (posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1) == 0)
2021 return -1;
2023 c2pstr (mac_pathname);
2024 hfpb.ioNamePtr = mac_pathname;
2025 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
2026 hfpb.ioDirID = 0; /* parent is the root */
2028 errno = PBDirCreate ((HParmBlkPtr) &hfpb, false);
2029 /* just return the Mac OSErr code for now */
2030 return errno == noErr ? 0 : -1;
2034 #undef rmdir
2035 sys_rmdir (const char *dirname)
2037 HFileParam hfpb;
2038 char mac_pathname[MAXPATHLEN+1];
2040 if (posix_to_mac_pathname (dirname, mac_pathname, MAXPATHLEN+1) == 0)
2041 return -1;
2043 c2pstr (mac_pathname);
2044 hfpb.ioNamePtr = mac_pathname;
2045 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
2046 hfpb.ioDirID = 0; /* parent is the root */
2048 errno = PBHDelete ((HParmBlkPtr) &hfpb, false);
2049 return errno == noErr ? 0 : -1;
2053 #ifdef __MRC__
2054 /* No implementation yet. */
2056 execvp (const char *path, ...)
2058 return -1;
2060 #endif /* __MRC__ */
2064 utime (const char *path, const struct utimbuf *times)
2066 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2067 int len;
2068 char mac_pathname[MAXPATHLEN+1];
2069 CInfoPBRec cipb;
2071 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2072 return -1;
2074 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2075 if (len > -1)
2076 fully_resolved_name[len] = '\0';
2077 else
2078 strcpy (fully_resolved_name, true_pathname);
2080 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2081 return -1;
2083 c2pstr (mac_pathname);
2084 cipb.hFileInfo.ioNamePtr = mac_pathname;
2085 cipb.hFileInfo.ioVRefNum = 0;
2086 cipb.hFileInfo.ioDirID = 0;
2087 cipb.hFileInfo.ioFDirIndex = 0;
2088 /* set to 0 to get information about specific dir or file */
2090 errno = PBGetCatInfo (&cipb, false);
2091 if (errno != noErr)
2092 return -1;
2094 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
2096 if (times)
2097 cipb.dirInfo.ioDrMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
2098 else
2099 GetDateTime (&cipb.dirInfo.ioDrMdDat);
2101 else
2103 if (times)
2104 cipb.hFileInfo.ioFlMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
2105 else
2106 GetDateTime (&cipb.hFileInfo.ioFlMdDat);
2109 errno = PBSetCatInfo (&cipb, false);
2110 return errno == noErr ? 0 : -1;
2114 #ifndef F_OK
2115 #define F_OK 0
2116 #endif
2117 #ifndef X_OK
2118 #define X_OK 1
2119 #endif
2120 #ifndef W_OK
2121 #define W_OK 2
2122 #endif
2124 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2126 access (const char *path, int mode)
2128 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2129 int len;
2130 char mac_pathname[MAXPATHLEN+1];
2131 CInfoPBRec cipb;
2133 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2134 return -1;
2136 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2137 if (len > -1)
2138 fully_resolved_name[len] = '\0';
2139 else
2140 strcpy (fully_resolved_name, true_pathname);
2142 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2143 return -1;
2145 c2pstr (mac_pathname);
2146 cipb.hFileInfo.ioNamePtr = mac_pathname;
2147 cipb.hFileInfo.ioVRefNum = 0;
2148 cipb.hFileInfo.ioDirID = 0;
2149 cipb.hFileInfo.ioFDirIndex = 0;
2150 /* set to 0 to get information about specific dir or file */
2152 errno = PBGetCatInfo (&cipb, false);
2153 if (errno != noErr)
2154 return -1;
2156 if (mode == F_OK) /* got this far, file exists */
2157 return 0;
2159 if (mode & X_OK)
2160 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* path refers to a directory */
2161 return 0;
2162 else
2164 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
2165 return 0;
2166 else
2167 return -1;
2170 if (mode & W_OK)
2171 return (cipb.hFileInfo.ioFlAttrib & 0x1) ? -1 : 0;
2172 /* don't allow if lock bit is on */
2174 return -1;
2178 #define DEV_NULL_FD 0x10000
2180 #undef open
2182 sys_open (const char *path, int oflag)
2184 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2185 int len;
2186 char mac_pathname[MAXPATHLEN+1];
2188 if (strcmp (path, "/dev/null") == 0)
2189 return DEV_NULL_FD; /* some bogus fd to be ignored in write */
2191 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2192 return -1;
2194 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2195 if (len > -1)
2196 fully_resolved_name[len] = '\0';
2197 else
2198 strcpy (fully_resolved_name, true_pathname);
2200 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2201 return -1;
2202 else
2204 #ifdef __MRC__
2205 int res = open (mac_pathname, oflag);
2206 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2207 if (oflag & O_CREAT)
2208 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2209 return res;
2210 #else /* not __MRC__ */
2211 return open (mac_pathname, oflag);
2212 #endif /* not __MRC__ */
2217 #undef creat
2219 sys_creat (const char *path, mode_t mode)
2221 char true_pathname[MAXPATHLEN+1];
2222 int len;
2223 char mac_pathname[MAXPATHLEN+1];
2225 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2226 return -1;
2228 if (!posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1))
2229 return -1;
2230 else
2232 #ifdef __MRC__
2233 int result = creat (mac_pathname);
2234 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2235 return result;
2236 #else /* not __MRC__ */
2237 return creat (mac_pathname, mode);
2238 #endif /* not __MRC__ */
2243 #undef unlink
2245 sys_unlink (const char *path)
2247 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2248 int len;
2249 char mac_pathname[MAXPATHLEN+1];
2251 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2252 return -1;
2254 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2255 if (len > -1)
2256 fully_resolved_name[len] = '\0';
2257 else
2258 strcpy (fully_resolved_name, true_pathname);
2260 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2261 return -1;
2262 else
2263 return unlink (mac_pathname);
2267 #undef read
2269 sys_read (int fildes, char *buf, int count)
2271 if (fildes == 0) /* this should not be used for console input */
2272 return -1;
2273 else
2274 #if __MSL__ >= 0x6000
2275 return _read (fildes, buf, count);
2276 #else
2277 return read (fildes, buf, count);
2278 #endif
2282 #undef write
2284 sys_write (int fildes, const char *buf, int count)
2286 if (fildes == DEV_NULL_FD)
2287 return count;
2288 else
2289 #if __MSL__ >= 0x6000
2290 return _write (fildes, buf, count);
2291 #else
2292 return write (fildes, buf, count);
2293 #endif
2297 #undef rename
2299 sys_rename (const char * old_name, const char * new_name)
2301 char true_old_pathname[MAXPATHLEN+1], true_new_pathname[MAXPATHLEN+1];
2302 char fully_resolved_old_name[MAXPATHLEN+1];
2303 int len;
2304 char mac_old_name[MAXPATHLEN+1], mac_new_name[MAXPATHLEN+1];
2306 if (find_true_pathname (old_name, true_old_pathname, MAXPATHLEN+1) == -1)
2307 return -1;
2309 len = readlink (true_old_pathname, fully_resolved_old_name, MAXPATHLEN);
2310 if (len > -1)
2311 fully_resolved_old_name[len] = '\0';
2312 else
2313 strcpy (fully_resolved_old_name, true_old_pathname);
2315 if (find_true_pathname (new_name, true_new_pathname, MAXPATHLEN+1) == -1)
2316 return -1;
2318 if (strcmp (fully_resolved_old_name, true_new_pathname) == 0)
2319 return 0;
2321 if (!posix_to_mac_pathname (fully_resolved_old_name,
2322 mac_old_name,
2323 MAXPATHLEN+1))
2324 return -1;
2326 if (!posix_to_mac_pathname(true_new_pathname, mac_new_name, MAXPATHLEN+1))
2327 return -1;
2329 /* If a file with new_name already exists, rename deletes the old
2330 file in Unix. CW version fails in these situation. So we add a
2331 call to unlink here. */
2332 (void) unlink (mac_new_name);
2334 return rename (mac_old_name, mac_new_name);
2338 #undef fopen
2339 extern FILE *fopen (const char *name, const char *mode);
2340 FILE *
2341 sys_fopen (const char *name, const char *mode)
2343 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2344 int len;
2345 char mac_pathname[MAXPATHLEN+1];
2347 if (find_true_pathname (name, true_pathname, MAXPATHLEN+1) == -1)
2348 return 0;
2350 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2351 if (len > -1)
2352 fully_resolved_name[len] = '\0';
2353 else
2354 strcpy (fully_resolved_name, true_pathname);
2356 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2357 return 0;
2358 else
2360 #ifdef __MRC__
2361 if (mode[0] == 'w' || mode[0] == 'a')
2362 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2363 #endif /* not __MRC__ */
2364 return fopen (mac_pathname, mode);
2369 extern Boolean mac_wait_next_event P_ ((EventRecord *, UInt32, Boolean));
2372 select (nfds, rfds, wfds, efds, timeout)
2373 int nfds;
2374 SELECT_TYPE *rfds, *wfds, *efds;
2375 EMACS_TIME *timeout;
2377 OSStatus err = noErr;
2379 /* Can only handle wait for keyboard input. */
2380 if (nfds > 1 || wfds || efds)
2381 return -1;
2383 /* Try detect_input_pending before ReceiveNextEvent in the same
2384 BLOCK_INPUT block, in case that some input has already been read
2385 asynchronously. */
2386 BLOCK_INPUT;
2387 ENABLE_WAKEUP_FROM_RNE;
2388 if (!detect_input_pending ())
2390 #if TARGET_API_MAC_CARBON
2391 EventTimeout timeoutval =
2392 (timeout
2393 ? (EMACS_SECS (*timeout) * kEventDurationSecond
2394 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
2395 : kEventDurationForever);
2397 if (timeoutval == 0.0)
2398 err = eventLoopTimedOutErr;
2399 else
2400 err = ReceiveNextEvent (0, NULL, timeoutval,
2401 kEventLeaveInQueue, NULL);
2402 #else /* not TARGET_API_MAC_CARBON */
2403 EventRecord e;
2404 UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
2405 ((EMACS_USECS (*timeout) * 60) / 1000000);
2407 if (sleep_time == 0)
2408 err = -9875; /* eventLoopTimedOutErr */
2409 else
2411 if (mac_wait_next_event (&e, sleep_time, false))
2412 err = noErr;
2413 else
2414 err = -9875; /* eventLoopTimedOutErr */
2416 #endif /* not TARGET_API_MAC_CARBON */
2418 DISABLE_WAKEUP_FROM_RNE;
2419 UNBLOCK_INPUT;
2421 if (err == noErr)
2423 /* Pretend that `select' is interrupted by a signal. */
2424 detect_input_pending ();
2425 errno = EINTR;
2426 return -1;
2428 else
2430 if (rfds)
2431 FD_ZERO (rfds);
2432 return 0;
2437 /* Simulation of SIGALRM. The stub for function signal stores the
2438 signal handler function in alarm_signal_func if a SIGALRM is
2439 encountered. */
2441 #include <signal.h>
2442 #include "syssignal.h"
2444 static TMTask mac_atimer_task;
2446 static QElemPtr mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
2448 static int signal_mask = 0;
2450 #ifdef __MRC__
2451 __sigfun alarm_signal_func = (__sigfun) 0;
2452 #elif __MWERKS__
2453 __signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0;
2454 #else /* not __MRC__ and not __MWERKS__ */
2455 You lose!!!
2456 #endif /* not __MRC__ and not __MWERKS__ */
2458 #undef signal
2459 #ifdef __MRC__
2460 extern __sigfun signal (int signal, __sigfun signal_func);
2461 __sigfun
2462 sys_signal (int signal_num, __sigfun signal_func)
2463 #elif __MWERKS__
2464 extern __signal_func_ptr signal (int signal, __signal_func_ptr signal_func);
2465 __signal_func_ptr
2466 sys_signal (int signal_num, __signal_func_ptr signal_func)
2467 #else /* not __MRC__ and not __MWERKS__ */
2468 You lose!!!
2469 #endif /* not __MRC__ and not __MWERKS__ */
2471 if (signal_num != SIGALRM)
2472 return signal (signal_num, signal_func);
2473 else
2475 #ifdef __MRC__
2476 __sigfun old_signal_func;
2477 #elif __MWERKS__
2478 __signal_func_ptr old_signal_func;
2479 #else
2480 You lose!!!
2481 #endif
2482 old_signal_func = alarm_signal_func;
2483 alarm_signal_func = signal_func;
2484 return old_signal_func;
2489 static pascal void
2490 mac_atimer_handler (qlink)
2491 TMTaskPtr qlink;
2493 if (alarm_signal_func)
2494 (alarm_signal_func) (SIGALRM);
2498 static void
2499 set_mac_atimer (count)
2500 long count;
2502 static TimerUPP mac_atimer_handlerUPP = NULL;
2504 if (mac_atimer_handlerUPP == NULL)
2505 mac_atimer_handlerUPP = NewTimerUPP (mac_atimer_handler);
2506 mac_atimer_task.tmCount = 0;
2507 mac_atimer_task.tmAddr = mac_atimer_handlerUPP;
2508 mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
2509 InsTime (mac_atimer_qlink);
2510 if (count)
2511 PrimeTime (mac_atimer_qlink, count);
2516 remove_mac_atimer (remaining_count)
2517 long *remaining_count;
2519 if (mac_atimer_qlink)
2521 RmvTime (mac_atimer_qlink);
2522 if (remaining_count)
2523 *remaining_count = mac_atimer_task.tmCount;
2524 mac_atimer_qlink = NULL;
2526 return 0;
2528 else
2529 return -1;
2534 sigblock (int mask)
2536 int old_mask = signal_mask;
2538 signal_mask |= mask;
2540 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2541 remove_mac_atimer (NULL);
2543 return old_mask;
2548 sigsetmask (int mask)
2550 int old_mask = signal_mask;
2552 signal_mask = mask;
2554 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2555 if (signal_mask & sigmask (SIGALRM))
2556 remove_mac_atimer (NULL);
2557 else
2558 set_mac_atimer (mac_atimer_task.tmCount);
2560 return old_mask;
2565 alarm (int seconds)
2567 long remaining_count;
2569 if (remove_mac_atimer (&remaining_count) == 0)
2571 set_mac_atimer (seconds * 1000);
2573 return remaining_count / 1000;
2575 else
2577 mac_atimer_task.tmCount = seconds * 1000;
2579 return 0;
2585 setitimer (which, value, ovalue)
2586 int which;
2587 const struct itimerval *value;
2588 struct itimerval *ovalue;
2590 long remaining_count;
2591 long count = (EMACS_SECS (value->it_value) * 1000
2592 + (EMACS_USECS (value->it_value) + 999) / 1000);
2594 if (remove_mac_atimer (&remaining_count) == 0)
2596 if (ovalue)
2598 bzero (ovalue, sizeof (*ovalue));
2599 EMACS_SET_SECS_USECS (ovalue->it_value, remaining_count / 1000,
2600 (remaining_count % 1000) * 1000);
2602 set_mac_atimer (count);
2604 else
2605 mac_atimer_task.tmCount = count;
2607 return 0;
2611 /* gettimeofday should return the amount of time (in a timeval
2612 structure) since midnight today. The toolbox function Microseconds
2613 returns the number of microseconds (in a UnsignedWide value) since
2614 the machine was booted. Also making this complicated is WideAdd,
2615 WideSubtract, etc. take wide values. */
2618 gettimeofday (tp)
2619 struct timeval *tp;
2621 static inited = 0;
2622 static wide wall_clock_at_epoch, clicks_at_epoch;
2623 UnsignedWide uw_microseconds;
2624 wide w_microseconds;
2625 time_t sys_time (time_t *);
2627 /* If this function is called for the first time, record the number
2628 of seconds since midnight and the number of microseconds since
2629 boot at the time of this first call. */
2630 if (!inited)
2632 time_t systime;
2633 inited = 1;
2634 systime = sys_time (NULL);
2635 /* Store microseconds since midnight in wall_clock_at_epoch. */
2636 WideMultiply (systime, 1000000L, &wall_clock_at_epoch);
2637 Microseconds (&uw_microseconds);
2638 /* Store microseconds since boot in clicks_at_epoch. */
2639 clicks_at_epoch.hi = uw_microseconds.hi;
2640 clicks_at_epoch.lo = uw_microseconds.lo;
2643 /* Get time since boot */
2644 Microseconds (&uw_microseconds);
2646 /* Convert to time since midnight*/
2647 w_microseconds.hi = uw_microseconds.hi;
2648 w_microseconds.lo = uw_microseconds.lo;
2649 WideSubtract (&w_microseconds, &clicks_at_epoch);
2650 WideAdd (&w_microseconds, &wall_clock_at_epoch);
2651 tp->tv_sec = WideDivide (&w_microseconds, 1000000L, &tp->tv_usec);
2653 return 0;
2657 #ifdef __MRC__
2658 unsigned int
2659 sleep (unsigned int seconds)
2661 unsigned long time_up;
2662 EventRecord e;
2664 time_up = TickCount () + seconds * 60;
2665 while (TickCount () < time_up)
2667 /* Accept no event; just wait. by T.I. */
2668 WaitNextEvent (0, &e, 30, NULL);
2671 return (0);
2673 #endif /* __MRC__ */
2676 /* The time functions adjust time values according to the difference
2677 between the Unix and CW epoches. */
2679 #undef gmtime
2680 extern struct tm *gmtime (const time_t *);
2681 struct tm *
2682 sys_gmtime (const time_t *timer)
2684 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2686 return gmtime (&unix_time);
2690 #undef localtime
2691 extern struct tm *localtime (const time_t *);
2692 struct tm *
2693 sys_localtime (const time_t *timer)
2695 #if __MSL__ >= 0x6000
2696 time_t unix_time = *timer;
2697 #else
2698 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2699 #endif
2701 return localtime (&unix_time);
2705 #undef ctime
2706 extern char *ctime (const time_t *);
2707 char *
2708 sys_ctime (const time_t *timer)
2710 #if __MSL__ >= 0x6000
2711 time_t unix_time = *timer;
2712 #else
2713 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2714 #endif
2716 return ctime (&unix_time);
2720 #undef time
2721 extern time_t time (time_t *);
2722 time_t
2723 sys_time (time_t *timer)
2725 #if __MSL__ >= 0x6000
2726 time_t mac_time = time (NULL);
2727 #else
2728 time_t mac_time = time (NULL) - CW_OR_MPW_UNIX_EPOCH_DIFF;
2729 #endif
2731 if (timer)
2732 *timer = mac_time;
2734 return mac_time;
2738 /* no subprocesses, empty wait */
2741 wait (int pid)
2743 return 0;
2747 void
2748 croak (char *badfunc)
2750 printf ("%s not yet implemented\r\n", badfunc);
2751 exit (1);
2755 char *
2756 mktemp (char *template)
2758 int len, k;
2759 static seqnum = 0;
2761 len = strlen (template);
2762 k = len - 1;
2763 while (k >= 0 && template[k] == 'X')
2764 k--;
2766 k++; /* make k index of first 'X' */
2768 if (k < len)
2770 /* Zero filled, number of digits equal to the number of X's. */
2771 sprintf (&template[k], "%0*d", len-k, seqnum++);
2773 return template;
2775 else
2776 return 0;
2780 /* Emulate getpwuid, getpwnam and others. */
2782 #define PASSWD_FIELD_SIZE 256
2784 static char my_passwd_name[PASSWD_FIELD_SIZE];
2785 static char my_passwd_dir[MAXPATHLEN+1];
2787 static struct passwd my_passwd =
2789 my_passwd_name,
2790 my_passwd_dir,
2793 static struct group my_group =
2795 /* There are no groups on the mac, so we just return "root" as the
2796 group name. */
2797 "root",
2801 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2803 char emacs_passwd_dir[MAXPATHLEN+1];
2805 char *
2806 getwd (char *);
2808 void
2809 init_emacs_passwd_dir ()
2811 int found = false;
2813 if (getwd (emacs_passwd_dir) && getwd (my_passwd_dir))
2815 /* Need pathname of first ancestor that begins with "emacs"
2816 since Mac emacs application is somewhere in the emacs-*
2817 tree. */
2818 int len = strlen (emacs_passwd_dir);
2819 int j = len - 1;
2820 /* j points to the "/" following the directory name being
2821 compared. */
2822 int i = j - 1;
2823 while (i >= 0 && !found)
2825 while (i >= 0 && emacs_passwd_dir[i] != '/')
2826 i--;
2827 if (emacs_passwd_dir[i] == '/' && i+5 < len)
2828 found = (strncmp (&(emacs_passwd_dir[i+1]), "emacs", 5) == 0);
2829 if (found)
2830 emacs_passwd_dir[j+1] = '\0';
2831 else
2833 j = i;
2834 i = j - 1;
2839 if (!found)
2841 /* Setting to "/" probably won't work but set it to something
2842 anyway. */
2843 strcpy (emacs_passwd_dir, "/");
2844 strcpy (my_passwd_dir, "/");
2849 static struct passwd emacs_passwd =
2851 "emacs",
2852 emacs_passwd_dir,
2855 static int my_passwd_inited = 0;
2858 static void
2859 init_my_passwd ()
2861 char **owner_name;
2863 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2864 directory where Emacs was started. */
2866 owner_name = (char **) GetResource ('STR ',-16096);
2867 if (owner_name)
2869 HLock (owner_name);
2870 BlockMove ((unsigned char *) *owner_name,
2871 (unsigned char *) my_passwd_name,
2872 *owner_name[0]+1);
2873 HUnlock (owner_name);
2874 p2cstr ((unsigned char *) my_passwd_name);
2876 else
2877 my_passwd_name[0] = 0;
2881 struct passwd *
2882 getpwuid (uid_t uid)
2884 if (!my_passwd_inited)
2886 init_my_passwd ();
2887 my_passwd_inited = 1;
2890 return &my_passwd;
2894 struct group *
2895 getgrgid (gid_t gid)
2897 return &my_group;
2901 struct passwd *
2902 getpwnam (const char *name)
2904 if (strcmp (name, "emacs") == 0)
2905 return &emacs_passwd;
2907 if (!my_passwd_inited)
2909 init_my_passwd ();
2910 my_passwd_inited = 1;
2913 return &my_passwd;
2917 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2918 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2919 as in msdos.c. */
2923 fork ()
2925 return -1;
2930 kill (int x, int y)
2932 return -1;
2936 void
2937 sys_subshell ()
2939 error ("Can't spawn subshell");
2943 void
2944 request_sigio (void)
2949 void
2950 unrequest_sigio (void)
2956 setpgrp ()
2958 return 0;
2962 /* No pipes yet. */
2965 pipe (int _fildes[2])
2967 errno = EACCES;
2968 return -1;
2972 /* Hard and symbolic links. */
2975 symlink (const char *name1, const char *name2)
2977 errno = ENOENT;
2978 return -1;
2983 link (const char *name1, const char *name2)
2985 errno = ENOENT;
2986 return -1;
2989 #endif /* ! MAC_OSX */
2991 /* Determine the path name of the file specified by VREFNUM, DIRID,
2992 and NAME and place that in the buffer PATH of length
2993 MAXPATHLEN. */
2994 static int
2995 path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num,
2996 long dir_id, ConstStr255Param name)
2998 Str255 dir_name;
2999 CInfoPBRec cipb;
3000 OSErr err;
3002 if (strlen (name) > man_path_len)
3003 return 0;
3005 memcpy (dir_name, name, name[0]+1);
3006 memcpy (path, name, name[0]+1);
3007 p2cstr (path);
3009 cipb.dirInfo.ioDrParID = dir_id;
3010 cipb.dirInfo.ioNamePtr = dir_name;
3014 cipb.dirInfo.ioVRefNum = vol_ref_num;
3015 cipb.dirInfo.ioFDirIndex = -1;
3016 cipb.dirInfo.ioDrDirID = cipb.dirInfo.ioDrParID;
3017 /* go up to parent each time */
3019 err = PBGetCatInfo (&cipb, false);
3020 if (err != noErr)
3021 return 0;
3023 p2cstr (dir_name);
3024 if (strlen (dir_name) + strlen (path) + 1 >= man_path_len)
3025 return 0;
3027 strcat (dir_name, ":");
3028 strcat (dir_name, path);
3029 /* attach to front since we're going up directory tree */
3030 strcpy (path, dir_name);
3032 while (cipb.dirInfo.ioDrDirID != fsRtDirID);
3033 /* stop when we see the volume's root directory */
3035 return 1; /* success */
3039 #ifndef MAC_OSX
3041 static OSErr
3042 posix_pathname_to_fsspec (ufn, fs)
3043 const char *ufn;
3044 FSSpec *fs;
3046 Str255 mac_pathname;
3048 if (posix_to_mac_pathname (ufn, mac_pathname, sizeof (mac_pathname)) == 0)
3049 return fnfErr;
3050 else
3052 c2pstr (mac_pathname);
3053 return FSMakeFSSpec (0, 0, mac_pathname, fs);
3057 static OSErr
3058 fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
3059 const FSSpec *fs;
3060 char *ufn;
3061 int ufnbuflen;
3063 char mac_pathname[MAXPATHLEN];
3065 if (path_from_vol_dir_name (mac_pathname, sizeof (mac_pathname) - 1,
3066 fs->vRefNum, fs->parID, fs->name)
3067 && mac_to_posix_pathname (mac_pathname, ufn, ufnbuflen))
3068 return noErr;
3069 else
3070 return fnfErr;
3074 readlink (const char *path, char *buf, int bufsiz)
3076 char mac_sym_link_name[MAXPATHLEN+1];
3077 OSErr err;
3078 FSSpec fsspec;
3079 Boolean target_is_folder, was_aliased;
3080 Str255 directory_name, mac_pathname;
3081 CInfoPBRec cipb;
3083 if (posix_to_mac_pathname (path, mac_sym_link_name, MAXPATHLEN+1) == 0)
3084 return -1;
3086 c2pstr (mac_sym_link_name);
3087 err = FSMakeFSSpec (0, 0, mac_sym_link_name, &fsspec);
3088 if (err != noErr)
3090 errno = ENOENT;
3091 return -1;
3094 err = ResolveAliasFile (&fsspec, true, &target_is_folder, &was_aliased);
3095 if (err != noErr || !was_aliased)
3097 errno = ENOENT;
3098 return -1;
3101 if (path_from_vol_dir_name (mac_pathname, 255, fsspec.vRefNum, fsspec.parID,
3102 fsspec.name) == 0)
3104 errno = ENOENT;
3105 return -1;
3108 if (mac_to_posix_pathname (mac_pathname, buf, bufsiz) == 0)
3110 errno = ENOENT;
3111 return -1;
3114 return strlen (buf);
3118 /* Convert a path to one with aliases fully expanded. */
3120 static int
3121 find_true_pathname (const char *path, char *buf, int bufsiz)
3123 char *q, temp[MAXPATHLEN+1];
3124 const char *p;
3125 int len;
3127 if (bufsiz <= 0 || path == 0 || path[0] == '\0')
3128 return -1;
3130 buf[0] = '\0';
3132 p = path;
3133 if (*p == '/')
3134 q = strchr (p + 1, '/');
3135 else
3136 q = strchr (p, '/');
3137 len = 0; /* loop may not be entered, e.g., for "/" */
3139 while (q)
3141 strcpy (temp, buf);
3142 strncat (temp, p, q - p);
3143 len = readlink (temp, buf, bufsiz);
3144 if (len <= -1)
3146 if (strlen (temp) + 1 > bufsiz)
3147 return -1;
3148 strcpy (buf, temp);
3150 strcat (buf, "/");
3151 len++;
3152 p = q + 1;
3153 q = strchr(p, '/');
3156 if (len + strlen (p) + 1 >= bufsiz)
3157 return -1;
3159 strcat (buf, p);
3160 return len + strlen (p);
3164 mode_t
3165 umask (mode_t numask)
3167 static mode_t mask = 022;
3168 mode_t oldmask = mask;
3169 mask = numask;
3170 return oldmask;
3175 chmod (const char *path, mode_t mode)
3177 /* say it always succeed for now */
3178 return 0;
3183 fchmod (int fd, mode_t mode)
3185 /* say it always succeed for now */
3186 return 0;
3191 fchown (int fd, uid_t owner, gid_t group)
3193 /* say it always succeed for now */
3194 return 0;
3199 dup (int oldd)
3201 #ifdef __MRC__
3202 return fcntl (oldd, F_DUPFD, 0);
3203 #elif __MWERKS__
3204 /* current implementation of fcntl in fcntl.mac.c simply returns old
3205 descriptor */
3206 return fcntl (oldd, F_DUPFD);
3207 #else
3208 You lose!!!
3209 #endif
3213 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3214 newd if it already exists. Then, attempt to dup oldd. If not
3215 successful, call dup2 recursively until we are, then close the
3216 unsuccessful ones. */
3219 dup2 (int oldd, int newd)
3221 int fd, ret;
3223 close (newd);
3225 fd = dup (oldd);
3226 if (fd == -1)
3227 return -1;
3228 if (fd == newd)
3229 return newd;
3230 ret = dup2 (oldd, newd);
3231 close (fd);
3232 return ret;
3236 /* let it fail for now */
3238 char *
3239 sbrk (int incr)
3241 return (char *) -1;
3246 fsync (int fd)
3248 return 0;
3253 ioctl (int d, int request, void *argp)
3255 return -1;
3259 #ifdef __MRC__
3261 isatty (int fildes)
3263 if (fildes >=0 && fildes <= 2)
3264 return 1;
3265 else
3266 return 0;
3271 getgid ()
3273 return 100;
3278 getegid ()
3280 return 100;
3285 getuid ()
3287 return 200;
3292 geteuid ()
3294 return 200;
3296 #endif /* __MRC__ */
3299 #ifdef __MWERKS__
3300 #if __MSL__ < 0x6000
3301 #undef getpid
3303 getpid ()
3305 return 9999;
3307 #endif
3308 #endif /* __MWERKS__ */
3310 #endif /* ! MAC_OSX */
3313 /* Return the path to the directory in which Emacs can create
3314 temporary files. The MacOS "temporary items" directory cannot be
3315 used because it removes the file written by a process when it
3316 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3317 again not exactly). And of course Emacs needs to read back the
3318 files written by its subprocesses. So here we write the files to a
3319 directory "Emacs" in the Preferences Folder. This directory is
3320 created if it does not exist. */
3322 char *
3323 get_temp_dir_name ()
3325 static char *temp_dir_name = NULL;
3326 short vol_ref_num;
3327 long dir_id;
3328 OSErr err;
3329 Str255 full_path;
3330 char unix_dir_name[MAXPATHLEN+1];
3331 DIR *dir;
3333 /* Cache directory name with pointer temp_dir_name.
3334 Look for it only the first time. */
3335 if (!temp_dir_name)
3337 err = FindFolder (kOnSystemDisk, kPreferencesFolderType, kCreateFolder,
3338 &vol_ref_num, &dir_id);
3339 if (err != noErr)
3340 return NULL;
3342 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3343 return NULL;
3345 if (strlen (full_path) + 6 <= MAXPATHLEN)
3346 strcat (full_path, "Emacs:");
3347 else
3348 return NULL;
3350 if (!mac_to_posix_pathname (full_path, unix_dir_name, MAXPATHLEN+1))
3351 return NULL;
3353 dir = opendir (unix_dir_name); /* check whether temp directory exists */
3354 if (dir)
3355 closedir (dir);
3356 else if (mkdir (unix_dir_name, 0700) != 0) /* create it if not */
3357 return NULL;
3359 temp_dir_name = (char *) malloc (strlen (unix_dir_name) + 1);
3360 strcpy (temp_dir_name, unix_dir_name);
3363 return temp_dir_name;
3366 #ifndef MAC_OSX
3368 /* Allocate and construct an array of pointers to strings from a list
3369 of strings stored in a 'STR#' resource. The returned pointer array
3370 is stored in the style of argv and environ: if the 'STR#' resource
3371 contains numString strings, a pointer array with numString+1
3372 elements is returned in which the last entry contains a null
3373 pointer. The pointer to the pointer array is passed by pointer in
3374 parameter t. The resource ID of the 'STR#' resource is passed in
3375 parameter StringListID.
3378 void
3379 get_string_list (char ***t, short string_list_id)
3381 Handle h;
3382 Ptr p;
3383 int i, num_strings;
3385 h = GetResource ('STR#', string_list_id);
3386 if (h)
3388 HLock (h);
3389 p = *h;
3390 num_strings = * (short *) p;
3391 p += sizeof(short);
3392 *t = (char **) malloc (sizeof (char *) * (num_strings + 1));
3393 for (i = 0; i < num_strings; i++)
3395 short length = *p++;
3396 (*t)[i] = (char *) malloc (length + 1);
3397 strncpy ((*t)[i], p, length);
3398 (*t)[i][length] = '\0';
3399 p += length;
3401 (*t)[num_strings] = 0;
3402 HUnlock (h);
3404 else
3406 /* Return no string in case GetResource fails. Bug fixed by
3407 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3408 option (no sym -on implies -opt local). */
3409 *t = (char **) malloc (sizeof (char *));
3410 (*t)[0] = 0;
3415 static char *
3416 get_path_to_system_folder ()
3418 short vol_ref_num;
3419 long dir_id;
3420 OSErr err;
3421 Str255 full_path;
3422 static char system_folder_unix_name[MAXPATHLEN+1];
3423 DIR *dir;
3425 err = FindFolder (kOnSystemDisk, kSystemFolderType, kDontCreateFolder,
3426 &vol_ref_num, &dir_id);
3427 if (err != noErr)
3428 return NULL;
3430 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3431 return NULL;
3433 if (!mac_to_posix_pathname (full_path, system_folder_unix_name,
3434 MAXPATHLEN+1))
3435 return NULL;
3437 return system_folder_unix_name;
3441 char **environ;
3443 #define ENVIRON_STRING_LIST_ID 128
3445 /* Get environment variable definitions from STR# resource. */
3447 void
3448 init_environ ()
3450 int i;
3452 get_string_list (&environ, ENVIRON_STRING_LIST_ID);
3454 i = 0;
3455 while (environ[i])
3456 i++;
3458 /* Make HOME directory the one Emacs starts up in if not specified
3459 by resource. */
3460 if (getenv ("HOME") == NULL)
3462 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3463 if (environ)
3465 environ[i] = (char *) malloc (strlen (my_passwd_dir) + 6);
3466 if (environ[i])
3468 strcpy (environ[i], "HOME=");
3469 strcat (environ[i], my_passwd_dir);
3471 environ[i+1] = 0;
3472 i++;
3476 /* Make HOME directory the one Emacs starts up in if not specified
3477 by resource. */
3478 if (getenv ("MAIL") == NULL)
3480 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3481 if (environ)
3483 char * path_to_system_folder = get_path_to_system_folder ();
3484 environ[i] = (char *) malloc (strlen (path_to_system_folder) + 22);
3485 if (environ[i])
3487 strcpy (environ[i], "MAIL=");
3488 strcat (environ[i], path_to_system_folder);
3489 strcat (environ[i], "Eudora Folder/In");
3491 environ[i+1] = 0;
3497 /* Return the value of the environment variable NAME. */
3499 char *
3500 getenv (const char *name)
3502 int length = strlen(name);
3503 char **e;
3505 for (e = environ; *e != 0; e++)
3506 if (strncmp(*e, name, length) == 0 && (*e)[length] == '=')
3507 return &(*e)[length + 1];
3509 if (strcmp (name, "TMPDIR") == 0)
3510 return get_temp_dir_name ();
3512 return 0;
3516 #ifdef __MRC__
3517 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3518 char *sys_siglist[] =
3520 "Zero is not a signal!!!",
3521 "Abort", /* 1 */
3522 "Interactive user interrupt", /* 2 */ "?",
3523 "Floating point exception", /* 4 */ "?", "?", "?",
3524 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3525 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3526 "?", "?", "?", "?", "?", "?", "?", "?",
3527 "Terminal" /* 32 */
3529 #elif __MWERKS__
3530 char *sys_siglist[] =
3532 "Zero is not a signal!!!",
3533 "Abort",
3534 "Floating point exception",
3535 "Illegal instruction",
3536 "Interactive user interrupt",
3537 "Segment violation",
3538 "Terminal"
3540 #else /* not __MRC__ and not __MWERKS__ */
3541 You lose!!!
3542 #endif /* not __MRC__ and not __MWERKS__ */
3545 #include <utsname.h>
3548 uname (struct utsname *name)
3550 char **system_name;
3551 system_name = GetString (-16413); /* IM - Resource Manager Reference */
3552 if (system_name)
3554 BlockMove (*system_name, name->nodename, (*system_name)[0]+1);
3555 p2cstr (name->nodename);
3556 return 0;
3558 else
3559 return -1;
3563 /* Event class of HLE sent to subprocess. */
3564 const OSType kEmacsSubprocessSend = 'ESND';
3566 /* Event class of HLE sent back from subprocess. */
3567 const OSType kEmacsSubprocessReply = 'ERPY';
3570 char *
3571 mystrchr (char *s, char c)
3573 while (*s && *s != c)
3575 if (*s == '\\')
3576 s++;
3577 s++;
3580 if (*s)
3582 *s = '\0';
3583 return s;
3585 else
3586 return NULL;
3590 char *
3591 mystrtok (char *s)
3593 while (*s)
3594 s++;
3596 return s + 1;
3600 void
3601 mystrcpy (char *to, char *from)
3603 while (*from)
3605 if (*from == '\\')
3606 from++;
3607 *to++ = *from++;
3609 *to = '\0';
3613 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3614 terminated). The process should run with the default directory
3615 "workdir", read input from "infn", and write output and error to
3616 "outfn" and "errfn", resp. The Process Manager call
3617 LaunchApplication is used to start the subprocess. We use high
3618 level events as the mechanism to pass arguments to the subprocess
3619 and to make Emacs wait for the subprocess to terminate and pass
3620 back a result code. The bulk of the code here packs the arguments
3621 into one message to be passed together with the high level event.
3622 Emacs also sometimes starts a subprocess using a shell to perform
3623 wildcard filename expansion. Since we don't really have a shell on
3624 the Mac, this case is detected and the starting of the shell is
3625 by-passed. We really need to add code here to do filename
3626 expansion to support such functionality.
3628 We can't use this strategy in Carbon because the High Level Event
3629 APIs are not available. */
3632 run_mac_command (argv, workdir, infn, outfn, errfn)
3633 unsigned char **argv;
3634 const char *workdir;
3635 const char *infn, *outfn, *errfn;
3637 #if TARGET_API_MAC_CARBON
3638 return -1;
3639 #else /* not TARGET_API_MAC_CARBON */
3640 char macappname[MAXPATHLEN+1], macworkdir[MAXPATHLEN+1];
3641 char macinfn[MAXPATHLEN+1], macoutfn[MAXPATHLEN+1], macerrfn[MAXPATHLEN+1];
3642 int paramlen, argc, newargc, j, retries;
3643 char **newargv, *param, *p;
3644 OSErr iErr;
3645 FSSpec spec;
3646 LaunchParamBlockRec lpbr;
3647 EventRecord send_event, reply_event;
3648 RgnHandle cursor_region_handle;
3649 TargetID targ;
3650 unsigned long ref_con, len;
3652 if (posix_to_mac_pathname (workdir, macworkdir, MAXPATHLEN+1) == 0)
3653 return -1;
3654 if (posix_to_mac_pathname (infn, macinfn, MAXPATHLEN+1) == 0)
3655 return -1;
3656 if (posix_to_mac_pathname (outfn, macoutfn, MAXPATHLEN+1) == 0)
3657 return -1;
3658 if (posix_to_mac_pathname (errfn, macerrfn, MAXPATHLEN+1) == 0)
3659 return -1;
3661 paramlen = strlen (macworkdir) + strlen (macinfn) + strlen (macoutfn)
3662 + strlen (macerrfn) + 4; /* count nulls at end of strings */
3664 argc = 0;
3665 while (argv[argc])
3666 argc++;
3668 if (argc == 0)
3669 return -1;
3671 /* If a subprocess is invoked with a shell, we receive 3 arguments
3672 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3673 bins>/<command> <command args>" */
3674 j = strlen (argv[0]);
3675 if (j >= 3 && strcmp (argv[0]+j-3, "/sh") == 0
3676 && argc == 3 && strcmp (argv[1], "-c") == 0)
3678 char *command, *t, tempmacpathname[MAXPATHLEN+1];
3680 /* The arguments for the command in argv[2] are separated by
3681 spaces. Count them and put the count in newargc. */
3682 command = (char *) alloca (strlen (argv[2])+2);
3683 strcpy (command, argv[2]);
3684 if (command[strlen (command) - 1] != ' ')
3685 strcat (command, " ");
3687 t = command;
3688 newargc = 0;
3689 t = mystrchr (t, ' ');
3690 while (t)
3692 newargc++;
3693 t = mystrchr (t+1, ' ');
3696 newargv = (char **) alloca (sizeof (char *) * newargc);
3698 t = command;
3699 for (j = 0; j < newargc; j++)
3701 newargv[j] = (char *) alloca (strlen (t) + 1);
3702 mystrcpy (newargv[j], t);
3704 t = mystrtok (t);
3705 paramlen += strlen (newargv[j]) + 1;
3708 if (strncmp (newargv[0], "~emacs/", 7) == 0)
3710 if (posix_to_mac_pathname (newargv[0], tempmacpathname, MAXPATHLEN+1)
3711 == 0)
3712 return -1;
3714 else
3715 { /* sometimes Emacs call "sh" without a path for the command */
3716 #if 0
3717 char *t = (char *) alloca (strlen (newargv[0]) + 7 + 1);
3718 strcpy (t, "~emacs/");
3719 strcat (t, newargv[0]);
3720 #endif /* 0 */
3721 Lisp_Object path;
3722 openp (Vexec_path, build_string (newargv[0]), Vexec_suffixes, &path,
3723 make_number (X_OK));
3725 if (NILP (path))
3726 return -1;
3727 if (posix_to_mac_pathname (SDATA (path), tempmacpathname,
3728 MAXPATHLEN+1) == 0)
3729 return -1;
3731 strcpy (macappname, tempmacpathname);
3733 else
3735 if (posix_to_mac_pathname (argv[0], macappname, MAXPATHLEN+1) == 0)
3736 return -1;
3738 newargv = (char **) alloca (sizeof (char *) * argc);
3739 newargc = argc;
3740 for (j = 1; j < argc; j++)
3742 if (strncmp (argv[j], "~emacs/", 7) == 0)
3744 char *t = strchr (argv[j], ' ');
3745 if (t)
3747 char tempcmdname[MAXPATHLEN+1], tempmaccmdname[MAXPATHLEN+1];
3748 strncpy (tempcmdname, argv[j], t-argv[j]);
3749 tempcmdname[t-argv[j]] = '\0';
3750 if (posix_to_mac_pathname (tempcmdname, tempmaccmdname,
3751 MAXPATHLEN+1) == 0)
3752 return -1;
3753 newargv[j] = (char *) alloca (strlen (tempmaccmdname)
3754 + strlen (t) + 1);
3755 strcpy (newargv[j], tempmaccmdname);
3756 strcat (newargv[j], t);
3758 else
3760 char tempmaccmdname[MAXPATHLEN+1];
3761 if (posix_to_mac_pathname (argv[j], tempmaccmdname,
3762 MAXPATHLEN+1) == 0)
3763 return -1;
3764 newargv[j] = (char *) alloca (strlen (tempmaccmdname)+1);
3765 strcpy (newargv[j], tempmaccmdname);
3768 else
3769 newargv[j] = argv[j];
3770 paramlen += strlen (newargv[j]) + 1;
3774 /* After expanding all the arguments, we now know the length of the
3775 parameter block to be sent to the subprocess as a message
3776 attached to the HLE. */
3777 param = (char *) malloc (paramlen + 1);
3778 if (!param)
3779 return -1;
3781 p = param;
3782 *p++ = newargc;
3783 /* first byte of message contains number of arguments for command */
3784 strcpy (p, macworkdir);
3785 p += strlen (macworkdir);
3786 *p++ = '\0';
3787 /* null terminate strings sent so it's possible to use strcpy over there */
3788 strcpy (p, macinfn);
3789 p += strlen (macinfn);
3790 *p++ = '\0';
3791 strcpy (p, macoutfn);
3792 p += strlen (macoutfn);
3793 *p++ = '\0';
3794 strcpy (p, macerrfn);
3795 p += strlen (macerrfn);
3796 *p++ = '\0';
3797 for (j = 1; j < newargc; j++)
3799 strcpy (p, newargv[j]);
3800 p += strlen (newargv[j]);
3801 *p++ = '\0';
3804 c2pstr (macappname);
3806 iErr = FSMakeFSSpec (0, 0, macappname, &spec);
3808 if (iErr != noErr)
3810 free (param);
3811 return -1;
3814 lpbr.launchBlockID = extendedBlock;
3815 lpbr.launchEPBLength = extendedBlockLen;
3816 lpbr.launchControlFlags = launchContinue + launchNoFileFlags;
3817 lpbr.launchAppSpec = &spec;
3818 lpbr.launchAppParameters = NULL;
3820 iErr = LaunchApplication (&lpbr); /* call the subprocess */
3821 if (iErr != noErr)
3823 free (param);
3824 return -1;
3827 send_event.what = kHighLevelEvent;
3828 send_event.message = kEmacsSubprocessSend;
3829 /* Event ID stored in "where" unused */
3831 retries = 3;
3832 /* OS may think current subprocess has terminated if previous one
3833 terminated recently. */
3836 iErr = PostHighLevelEvent (&send_event, &lpbr.launchProcessSN, 0, param,
3837 paramlen + 1, receiverIDisPSN);
3839 while (iErr == sessClosedErr && retries-- > 0);
3841 if (iErr != noErr)
3843 free (param);
3844 return -1;
3847 cursor_region_handle = NewRgn ();
3849 /* Wait for the subprocess to finish, when it will send us a ERPY
3850 high level event. */
3851 while (1)
3852 if (WaitNextEvent (highLevelEventMask, &reply_event, 180,
3853 cursor_region_handle)
3854 && reply_event.message == kEmacsSubprocessReply)
3855 break;
3857 /* The return code is sent through the refCon */
3858 iErr = AcceptHighLevelEvent (&targ, &ref_con, NULL, &len);
3859 if (iErr != noErr)
3861 DisposeHandle ((Handle) cursor_region_handle);
3862 free (param);
3863 return -1;
3866 DisposeHandle ((Handle) cursor_region_handle);
3867 free (param);
3869 return ref_con;
3870 #endif /* not TARGET_API_MAC_CARBON */
3874 DIR *
3875 opendir (const char *dirname)
3877 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
3878 char mac_pathname[MAXPATHLEN+1], vol_name[MAXPATHLEN+1];
3879 DIR *dirp;
3880 CInfoPBRec cipb;
3881 HVolumeParam vpb;
3882 int len, vol_name_len;
3884 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
3885 return 0;
3887 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
3888 if (len > -1)
3889 fully_resolved_name[len] = '\0';
3890 else
3891 strcpy (fully_resolved_name, true_pathname);
3893 dirp = (DIR *) malloc (sizeof(DIR));
3894 if (!dirp)
3895 return 0;
3897 /* Handle special case when dirname is "/": sets up for readir to
3898 get all mount volumes. */
3899 if (strcmp (fully_resolved_name, "/") == 0)
3901 dirp->getting_volumes = 1; /* special all mounted volumes DIR struct */
3902 dirp->current_index = 1; /* index for first volume */
3903 return dirp;
3906 /* Handle typical cases: not accessing all mounted volumes. */
3907 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
3908 return 0;
3910 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3911 len = strlen (mac_pathname);
3912 if (mac_pathname[len - 1] != ':' && len < MAXPATHLEN)
3913 strcat (mac_pathname, ":");
3915 /* Extract volume name */
3916 vol_name_len = strchr (mac_pathname, ':') - mac_pathname;
3917 strncpy (vol_name, mac_pathname, vol_name_len);
3918 vol_name[vol_name_len] = '\0';
3919 strcat (vol_name, ":");
3921 c2pstr (mac_pathname);
3922 cipb.hFileInfo.ioNamePtr = mac_pathname;
3923 /* using full pathname so vRefNum and DirID ignored */
3924 cipb.hFileInfo.ioVRefNum = 0;
3925 cipb.hFileInfo.ioDirID = 0;
3926 cipb.hFileInfo.ioFDirIndex = 0;
3927 /* set to 0 to get information about specific dir or file */
3929 errno = PBGetCatInfo (&cipb, false);
3930 if (errno != noErr)
3932 errno = ENOENT;
3933 return 0;
3936 if (!(cipb.hFileInfo.ioFlAttrib & 0x10)) /* bit 4 = 1 for directories */
3937 return 0; /* not a directory */
3939 dirp->dir_id = cipb.dirInfo.ioDrDirID; /* used later in readdir */
3940 dirp->getting_volumes = 0;
3941 dirp->current_index = 1; /* index for first file/directory */
3943 c2pstr (vol_name);
3944 vpb.ioNamePtr = vol_name;
3945 /* using full pathname so vRefNum and DirID ignored */
3946 vpb.ioVRefNum = 0;
3947 vpb.ioVolIndex = -1;
3948 errno = PBHGetVInfo ((union HParamBlockRec *) &vpb, false);
3949 if (errno != noErr)
3951 errno = ENOENT;
3952 return 0;
3955 dirp->vol_ref_num = vpb.ioVRefNum;
3957 return dirp;
3961 closedir (DIR *dp)
3963 free (dp);
3965 return 0;
3969 struct dirent *
3970 readdir (DIR *dp)
3972 HParamBlockRec hpblock;
3973 CInfoPBRec cipb;
3974 static struct dirent s_dirent;
3975 static Str255 s_name;
3976 int done;
3977 char *p;
3979 /* Handle the root directory containing the mounted volumes. Call
3980 PBHGetVInfo specifying an index to obtain the info for a volume.
3981 PBHGetVInfo returns an error when it receives an index beyond the
3982 last volume, at which time we should return a nil dirent struct
3983 pointer. */
3984 if (dp->getting_volumes)
3986 hpblock.volumeParam.ioNamePtr = s_name;
3987 hpblock.volumeParam.ioVRefNum = 0;
3988 hpblock.volumeParam.ioVolIndex = dp->current_index;
3990 errno = PBHGetVInfo (&hpblock, false);
3991 if (errno != noErr)
3993 errno = ENOENT;
3994 return 0;
3997 p2cstr (s_name);
3998 strcat (s_name, "/"); /* need "/" for stat to work correctly */
4000 dp->current_index++;
4002 s_dirent.d_ino = hpblock.volumeParam.ioVRefNum;
4003 s_dirent.d_name = s_name;
4005 return &s_dirent;
4007 else
4009 cipb.hFileInfo.ioVRefNum = dp->vol_ref_num;
4010 cipb.hFileInfo.ioNamePtr = s_name;
4011 /* location to receive filename returned */
4013 /* return only visible files */
4014 done = false;
4015 while (!done)
4017 cipb.hFileInfo.ioDirID = dp->dir_id;
4018 /* directory ID found by opendir */
4019 cipb.hFileInfo.ioFDirIndex = dp->current_index;
4021 errno = PBGetCatInfo (&cipb, false);
4022 if (errno != noErr)
4024 errno = ENOENT;
4025 return 0;
4028 /* insist on a visible entry */
4029 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* directory? */
4030 done = !(cipb.dirInfo.ioDrUsrWds.frFlags & fInvisible);
4031 else
4032 done = !(cipb.hFileInfo.ioFlFndrInfo.fdFlags & fInvisible);
4034 dp->current_index++;
4037 p2cstr (s_name);
4039 p = s_name;
4040 while (*p)
4042 if (*p == '/')
4043 *p = ':';
4044 p++;
4047 s_dirent.d_ino = cipb.dirInfo.ioDrDirID;
4048 /* value unimportant: non-zero for valid file */
4049 s_dirent.d_name = s_name;
4051 return &s_dirent;
4056 char *
4057 getwd (char *path)
4059 char mac_pathname[MAXPATHLEN+1];
4060 Str255 directory_name;
4061 OSErr errno;
4062 CInfoPBRec cipb;
4064 if (path_from_vol_dir_name (mac_pathname, 255, 0, 0, "\p") == 0)
4065 return NULL;
4067 if (mac_to_posix_pathname (mac_pathname, path, MAXPATHLEN+1) == 0)
4068 return 0;
4069 else
4070 return path;
4073 #endif /* ! MAC_OSX */
4076 void
4077 initialize_applescript ()
4079 AEDesc null_desc;
4080 OSAError osaerror;
4082 /* if open fails, as_scripting_component is set to NULL. Its
4083 subsequent use in OSA calls will fail with badComponentInstance
4084 error. */
4085 as_scripting_component = OpenDefaultComponent (kOSAComponentType,
4086 kAppleScriptSubtype);
4088 null_desc.descriptorType = typeNull;
4089 null_desc.dataHandle = 0;
4090 osaerror = OSAMakeContext (as_scripting_component, &null_desc,
4091 kOSANullScript, &as_script_context);
4092 if (osaerror)
4093 as_script_context = kOSANullScript;
4094 /* use default context if create fails */
4098 void
4099 terminate_applescript()
4101 OSADispose (as_scripting_component, as_script_context);
4102 CloseComponent (as_scripting_component);
4105 /* Convert a lisp string to the 4 byte character code. */
4107 OSType
4108 mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
4110 OSType result;
4111 if (NILP(arg))
4113 result = defCode;
4115 else
4117 /* check type string */
4118 CHECK_STRING(arg);
4119 if (SBYTES (arg) != 4)
4121 error ("Wrong argument: need string of length 4 for code");
4123 result = EndianU32_BtoN (*((UInt32 *) SDATA (arg)));
4125 return result;
4128 /* Convert the 4 byte character code into a 4 byte string. */
4130 Lisp_Object
4131 mac_get_object_from_code(OSType defCode)
4133 UInt32 code = EndianU32_NtoB (defCode);
4135 return make_unibyte_string ((char *)&code, 4);
4139 DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0,
4140 doc: /* Get the creator code of FILENAME as a four character string. */)
4141 (filename)
4142 Lisp_Object filename;
4144 OSStatus status;
4145 #ifdef MAC_OSX
4146 FSRef fref;
4147 #else
4148 FSSpec fss;
4149 #endif
4150 Lisp_Object result = Qnil;
4151 CHECK_STRING (filename);
4153 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4154 return Qnil;
4156 filename = Fexpand_file_name (filename, Qnil);
4158 BLOCK_INPUT;
4159 #ifdef MAC_OSX
4160 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4161 #else
4162 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4163 #endif
4165 if (status == noErr)
4167 #ifdef MAC_OSX
4168 FSCatalogInfo catalogInfo;
4170 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4171 &catalogInfo, NULL, NULL, NULL);
4172 #else
4173 FInfo finder_info;
4175 status = FSpGetFInfo (&fss, &finder_info);
4176 #endif
4177 if (status == noErr)
4179 #ifdef MAC_OSX
4180 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator);
4181 #else
4182 result = mac_get_object_from_code (finder_info.fdCreator);
4183 #endif
4186 UNBLOCK_INPUT;
4187 if (status != noErr) {
4188 error ("Error while getting file information.");
4190 return result;
4193 DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0,
4194 doc: /* Get the type code of FILENAME as a four character string. */)
4195 (filename)
4196 Lisp_Object filename;
4198 OSStatus status;
4199 #ifdef MAC_OSX
4200 FSRef fref;
4201 #else
4202 FSSpec fss;
4203 #endif
4204 Lisp_Object result = Qnil;
4205 CHECK_STRING (filename);
4207 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4208 return Qnil;
4210 filename = Fexpand_file_name (filename, Qnil);
4212 BLOCK_INPUT;
4213 #ifdef MAC_OSX
4214 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4215 #else
4216 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4217 #endif
4219 if (status == noErr)
4221 #ifdef MAC_OSX
4222 FSCatalogInfo catalogInfo;
4224 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4225 &catalogInfo, NULL, NULL, NULL);
4226 #else
4227 FInfo finder_info;
4229 status = FSpGetFInfo (&fss, &finder_info);
4230 #endif
4231 if (status == noErr)
4233 #ifdef MAC_OSX
4234 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType);
4235 #else
4236 result = mac_get_object_from_code (finder_info.fdType);
4237 #endif
4240 UNBLOCK_INPUT;
4241 if (status != noErr) {
4242 error ("Error while getting file information.");
4244 return result;
4247 DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0,
4248 doc: /* Set creator code of file FILENAME to CODE.
4249 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4250 assumed. Return non-nil if successful. */)
4251 (filename, code)
4252 Lisp_Object filename, code;
4254 OSStatus status;
4255 #ifdef MAC_OSX
4256 FSRef fref;
4257 #else
4258 FSSpec fss;
4259 #endif
4260 OSType cCode;
4261 CHECK_STRING (filename);
4263 cCode = mac_get_code_from_arg(code, MAC_EMACS_CREATOR_CODE);
4265 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4266 return Qnil;
4268 filename = Fexpand_file_name (filename, Qnil);
4270 BLOCK_INPUT;
4271 #ifdef MAC_OSX
4272 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4273 #else
4274 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4275 #endif
4277 if (status == noErr)
4279 #ifdef MAC_OSX
4280 FSCatalogInfo catalogInfo;
4281 FSRef parentDir;
4282 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4283 &catalogInfo, NULL, NULL, &parentDir);
4284 #else
4285 FInfo finder_info;
4287 status = FSpGetFInfo (&fss, &finder_info);
4288 #endif
4289 if (status == noErr)
4291 #ifdef MAC_OSX
4292 ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode;
4293 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
4294 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4295 #else
4296 finder_info.fdCreator = cCode;
4297 status = FSpSetFInfo (&fss, &finder_info);
4298 #endif
4301 UNBLOCK_INPUT;
4302 if (status != noErr) {
4303 error ("Error while setting creator information.");
4305 return Qt;
4308 DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0,
4309 doc: /* Set file code of file FILENAME to CODE.
4310 CODE must be a 4-character string. Return non-nil if successful. */)
4311 (filename, code)
4312 Lisp_Object filename, code;
4314 OSStatus status;
4315 #ifdef MAC_OSX
4316 FSRef fref;
4317 #else
4318 FSSpec fss;
4319 #endif
4320 OSType cCode;
4321 CHECK_STRING (filename);
4323 cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
4325 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4326 return Qnil;
4328 filename = Fexpand_file_name (filename, Qnil);
4330 BLOCK_INPUT;
4331 #ifdef MAC_OSX
4332 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4333 #else
4334 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4335 #endif
4337 if (status == noErr)
4339 #ifdef MAC_OSX
4340 FSCatalogInfo catalogInfo;
4341 FSRef parentDir;
4342 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4343 &catalogInfo, NULL, NULL, &parentDir);
4344 #else
4345 FInfo finder_info;
4347 status = FSpGetFInfo (&fss, &finder_info);
4348 #endif
4349 if (status == noErr)
4351 #ifdef MAC_OSX
4352 ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode;
4353 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
4354 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4355 #else
4356 finder_info.fdType = cCode;
4357 status = FSpSetFInfo (&fss, &finder_info);
4358 #endif
4361 UNBLOCK_INPUT;
4362 if (status != noErr) {
4363 error ("Error while setting creator information.");
4365 return Qt;
4369 /* Compile and execute the AppleScript SCRIPT and return the error
4370 status as function value. A zero is returned if compilation and
4371 execution is successful, in which case *RESULT is set to a Lisp
4372 string containing the resulting script value. Otherwise, the Mac
4373 error code is returned and *RESULT is set to an error Lisp string.
4374 For documentation on the MacOS scripting architecture, see Inside
4375 Macintosh - Interapplication Communications: Scripting
4376 Components. */
4378 static long
4379 do_applescript (script, result)
4380 Lisp_Object script, *result;
4382 AEDesc script_desc, result_desc, error_desc, *desc = NULL;
4383 OSErr error;
4384 OSAError osaerror;
4386 *result = Qnil;
4388 if (!as_scripting_component)
4389 initialize_applescript();
4391 error = AECreateDesc (typeChar, SDATA (script), SBYTES (script),
4392 &script_desc);
4393 if (error)
4394 return error;
4396 osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
4397 typeChar, kOSAModeNull, &result_desc);
4399 if (osaerror == noErr)
4400 /* success: retrieve resulting script value */
4401 desc = &result_desc;
4402 else if (osaerror == errOSAScriptError)
4403 /* error executing AppleScript: retrieve error message */
4404 if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar,
4405 &error_desc))
4406 desc = &error_desc;
4408 if (desc)
4410 #if TARGET_API_MAC_CARBON
4411 *result = make_uninit_string (AEGetDescDataSize (desc));
4412 AEGetDescData (desc, SDATA (*result), SBYTES (*result));
4413 #else /* not TARGET_API_MAC_CARBON */
4414 *result = make_uninit_string (GetHandleSize (desc->dataHandle));
4415 memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result));
4416 #endif /* not TARGET_API_MAC_CARBON */
4417 AEDisposeDesc (desc);
4420 AEDisposeDesc (&script_desc);
4422 return osaerror;
4426 DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
4427 doc: /* Compile and execute AppleScript SCRIPT and return the result.
4428 If compilation and execution are successful, the resulting script
4429 value is returned as a string. Otherwise the function aborts and
4430 displays the error message returned by the AppleScript scripting
4431 component. */)
4432 (script)
4433 Lisp_Object script;
4435 Lisp_Object result;
4436 long status;
4438 CHECK_STRING (script);
4440 BLOCK_INPUT;
4441 status = do_applescript (script, &result);
4442 UNBLOCK_INPUT;
4443 if (status == 0)
4444 return result;
4445 else if (!STRINGP (result))
4446 error ("AppleScript error %d", status);
4447 else
4448 error ("%s", SDATA (result));
4452 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
4453 Smac_file_name_to_posix, 1, 1, 0,
4454 doc: /* Convert Macintosh FILENAME to Posix form. */)
4455 (filename)
4456 Lisp_Object filename;
4458 char posix_filename[MAXPATHLEN+1];
4460 CHECK_STRING (filename);
4462 if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN))
4463 return build_string (posix_filename);
4464 else
4465 return Qnil;
4469 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac,
4470 Sposix_file_name_to_mac, 1, 1, 0,
4471 doc: /* Convert Posix FILENAME to Mac form. */)
4472 (filename)
4473 Lisp_Object filename;
4475 char mac_filename[MAXPATHLEN+1];
4477 CHECK_STRING (filename);
4479 if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN))
4480 return build_string (mac_filename);
4481 else
4482 return Qnil;
4486 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data, Smac_coerce_ae_data, 3, 3, 0,
4487 doc: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4488 Each type should be a string of length 4 or the symbol
4489 `undecoded-file-name'. */)
4490 (src_type, src_data, dst_type)
4491 Lisp_Object src_type, src_data, dst_type;
4493 OSErr err;
4494 Lisp_Object result = Qnil;
4495 DescType src_desc_type, dst_desc_type;
4496 AEDesc dst_desc;
4498 CHECK_STRING (src_data);
4499 if (EQ (src_type, Qundecoded_file_name))
4500 src_desc_type = TYPE_FILE_NAME;
4501 else
4502 src_desc_type = mac_get_code_from_arg (src_type, 0);
4504 if (EQ (dst_type, Qundecoded_file_name))
4505 dst_desc_type = TYPE_FILE_NAME;
4506 else
4507 dst_desc_type = mac_get_code_from_arg (dst_type, 0);
4509 BLOCK_INPUT;
4510 err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data),
4511 dst_desc_type, &dst_desc);
4512 if (err == noErr)
4514 result = Fcdr (mac_aedesc_to_lisp (&dst_desc));
4515 AEDisposeDesc (&dst_desc);
4517 UNBLOCK_INPUT;
4519 return result;
4523 #if TARGET_API_MAC_CARBON
4524 static Lisp_Object Qxml, Qmime_charset;
4525 static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
4527 DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
4528 doc: /* Return the application preference value for KEY.
4529 KEY is either a string specifying a preference key, or a list of key
4530 strings. If it is a list, the (i+1)-th element is used as a key for
4531 the CFDictionary value obtained by the i-th element. Return nil if
4532 lookup is failed at some stage.
4534 Optional arg APPLICATION is an application ID string. If omitted or
4535 nil, that stands for the current application.
4537 Optional arg FORMAT specifies the data format of the return value. If
4538 omitted or nil, each Core Foundation object is converted into a
4539 corresponding Lisp object as follows:
4541 Core Foundation Lisp Tag
4542 ------------------------------------------------------------
4543 CFString Multibyte string string
4544 CFNumber Integer or float number
4545 CFBoolean Symbol (t or nil) boolean
4546 CFDate List of three integers date
4547 (cf. `current-time')
4548 CFData Unibyte string data
4549 CFArray Vector array
4550 CFDictionary Alist or hash table dictionary
4551 (depending on HASH-BOUND)
4553 If it is t, a symbol that represents the type of the original Core
4554 Foundation object is prepended. If it is `xml', the value is returned
4555 as an XML representation.
4557 Optional arg HASH-BOUND specifies which kinds of the list objects,
4558 alists or hash tables, are used as the targets of the conversion from
4559 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4560 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4561 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4562 otherwise. */)
4563 (key, application, format, hash_bound)
4564 Lisp_Object key, application, format, hash_bound;
4566 CFStringRef app_id, key_str;
4567 CFPropertyListRef app_plist = NULL, plist;
4568 Lisp_Object result = Qnil, tmp;
4569 struct gcpro gcpro1, gcpro2;
4571 if (STRINGP (key))
4572 key = Fcons (key, Qnil);
4573 else
4575 CHECK_CONS (key);
4576 for (tmp = key; CONSP (tmp); tmp = XCDR (tmp))
4577 CHECK_STRING_CAR (tmp);
4578 CHECK_LIST_END (tmp, key);
4580 if (!NILP (application))
4581 CHECK_STRING (application);
4582 CHECK_SYMBOL (format);
4583 if (!NILP (hash_bound))
4584 CHECK_NUMBER (hash_bound);
4586 GCPRO2 (key, format);
4588 BLOCK_INPUT;
4590 app_id = kCFPreferencesCurrentApplication;
4591 if (!NILP (application))
4593 app_id = cfstring_create_with_string (application);
4594 if (app_id == NULL)
4595 goto out;
4597 if (!CFPreferencesAppSynchronize (app_id))
4598 goto out;
4600 key_str = cfstring_create_with_string (XCAR (key));
4601 if (key_str == NULL)
4602 goto out;
4603 app_plist = CFPreferencesCopyAppValue (key_str, app_id);
4604 CFRelease (key_str);
4605 if (app_plist == NULL)
4606 goto out;
4608 plist = app_plist;
4609 for (key = XCDR (key); CONSP (key); key = XCDR (key))
4611 if (CFGetTypeID (plist) != CFDictionaryGetTypeID ())
4612 break;
4613 key_str = cfstring_create_with_string (XCAR (key));
4614 if (key_str == NULL)
4615 goto out;
4616 plist = CFDictionaryGetValue (plist, key_str);
4617 CFRelease (key_str);
4618 if (plist == NULL)
4619 goto out;
4622 if (NILP (key))
4624 if (EQ (format, Qxml))
4626 CFDataRef data = CFPropertyListCreateXMLData (NULL, plist);
4627 if (data == NULL)
4628 goto out;
4629 result = cfdata_to_lisp (data);
4630 CFRelease (data);
4632 else
4633 result =
4634 cfproperty_list_to_lisp (plist, EQ (format, Qt),
4635 NILP (hash_bound) ? -1 : XINT (hash_bound));
4638 out:
4639 if (app_plist)
4640 CFRelease (app_plist);
4641 CFRelease (app_id);
4643 UNBLOCK_INPUT;
4645 UNGCPRO;
4647 return result;
4651 static CFStringEncoding
4652 get_cfstring_encoding_from_lisp (obj)
4653 Lisp_Object obj;
4655 CFStringRef iana_name;
4656 CFStringEncoding encoding = kCFStringEncodingInvalidId;
4658 if (NILP (obj))
4659 return kCFStringEncodingUnicode;
4661 if (INTEGERP (obj))
4662 return XINT (obj);
4664 if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj)))
4666 Lisp_Object coding_spec, plist;
4668 coding_spec = Fget (obj, Qcoding_system);
4669 plist = XVECTOR (coding_spec)->contents[3];
4670 obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset);
4673 if (SYMBOLP (obj))
4674 obj = SYMBOL_NAME (obj);
4676 if (STRINGP (obj))
4678 iana_name = cfstring_create_with_string (obj);
4679 if (iana_name)
4681 encoding = CFStringConvertIANACharSetNameToEncoding (iana_name);
4682 CFRelease (iana_name);
4686 return encoding;
4689 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4690 static CFStringRef
4691 cfstring_create_normalized (str, symbol)
4692 CFStringRef str;
4693 Lisp_Object symbol;
4695 int form = -1;
4696 TextEncodingVariant variant;
4697 float initial_mag = 0.0;
4698 CFStringRef result = NULL;
4700 if (EQ (symbol, QNFD))
4701 form = kCFStringNormalizationFormD;
4702 else if (EQ (symbol, QNFKD))
4703 form = kCFStringNormalizationFormKD;
4704 else if (EQ (symbol, QNFC))
4705 form = kCFStringNormalizationFormC;
4706 else if (EQ (symbol, QNFKC))
4707 form = kCFStringNormalizationFormKC;
4708 else if (EQ (symbol, QHFS_plus_D))
4710 variant = kUnicodeHFSPlusDecompVariant;
4711 initial_mag = 1.5;
4713 else if (EQ (symbol, QHFS_plus_C))
4715 variant = kUnicodeHFSPlusCompVariant;
4716 initial_mag = 1.0;
4719 if (form >= 0)
4721 CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str);
4723 if (mut_str)
4725 CFStringNormalize (mut_str, form);
4726 result = mut_str;
4729 else if (initial_mag > 0.0)
4731 UnicodeToTextInfo uni = NULL;
4732 UnicodeMapping map;
4733 CFIndex length;
4734 UniChar *in_text, *buffer = NULL, *out_buf = NULL;
4735 OSStatus err = noErr;
4736 ByteCount out_read, out_size, out_len;
4738 map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4739 kUnicodeNoSubset,
4740 kTextEncodingDefaultFormat);
4741 map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4742 variant,
4743 kTextEncodingDefaultFormat);
4744 map.mappingVersion = kUnicodeUseLatestMapping;
4746 length = CFStringGetLength (str);
4747 out_size = (int)((float)length * initial_mag) * sizeof (UniChar);
4748 if (out_size < 32)
4749 out_size = 32;
4751 in_text = (UniChar *)CFStringGetCharactersPtr (str);
4752 if (in_text == NULL)
4754 buffer = xmalloc (sizeof (UniChar) * length);
4755 CFStringGetCharacters (str, CFRangeMake (0, length), buffer);
4756 in_text = buffer;
4759 if (in_text)
4760 err = CreateUnicodeToTextInfo (&map, &uni);
4761 while (err == noErr)
4763 out_buf = xmalloc (out_size);
4764 err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar),
4765 in_text,
4766 kUnicodeDefaultDirectionMask,
4767 0, NULL, NULL, NULL,
4768 out_size, &out_read, &out_len,
4769 out_buf);
4770 if (err == noErr && out_read < length * sizeof (UniChar))
4772 xfree (out_buf);
4773 out_size += length;
4775 else
4776 break;
4778 if (err == noErr)
4779 result = CFStringCreateWithCharacters (NULL, out_buf,
4780 out_len / sizeof (UniChar));
4781 if (uni)
4782 DisposeUnicodeToTextInfo (&uni);
4783 if (out_buf)
4784 xfree (out_buf);
4785 if (buffer)
4786 xfree (buffer);
4788 else
4790 result = str;
4791 CFRetain (result);
4794 return result;
4796 #endif
4798 DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0,
4799 doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
4800 The conversion is performed using the converter provided by the system.
4801 Each encoding is specified by either a coding system symbol, a mime
4802 charset string, or an integer as a CFStringEncoding value. An encoding
4803 of nil means UTF-16 in native byte order, no byte order mark.
4804 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4805 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4806 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4807 On successful conversion, return the result string, else return nil. */)
4808 (string, source, target, normalization_form)
4809 Lisp_Object string, source, target, normalization_form;
4811 Lisp_Object result = Qnil;
4812 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4813 CFStringEncoding src_encoding, tgt_encoding;
4814 CFStringRef str = NULL;
4816 CHECK_STRING (string);
4817 if (!INTEGERP (source) && !STRINGP (source))
4818 CHECK_SYMBOL (source);
4819 if (!INTEGERP (target) && !STRINGP (target))
4820 CHECK_SYMBOL (target);
4821 CHECK_SYMBOL (normalization_form);
4823 GCPRO4 (string, source, target, normalization_form);
4825 BLOCK_INPUT;
4827 src_encoding = get_cfstring_encoding_from_lisp (source);
4828 tgt_encoding = get_cfstring_encoding_from_lisp (target);
4830 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4831 use string_as_unibyte which works as well, except for the fact that
4832 it's too permissive (it doesn't check that the multibyte string only
4833 contain single-byte chars). */
4834 string = Fstring_as_unibyte (string);
4835 if (src_encoding != kCFStringEncodingInvalidId
4836 && tgt_encoding != kCFStringEncodingInvalidId)
4837 str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
4838 src_encoding, !NILP (source));
4839 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4840 if (str)
4842 CFStringRef saved_str = str;
4844 str = cfstring_create_normalized (saved_str, normalization_form);
4845 CFRelease (saved_str);
4847 #endif
4848 if (str)
4850 CFIndex str_len, buf_len;
4852 str_len = CFStringGetLength (str);
4853 if (CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4854 !NILP (target), NULL, 0, &buf_len) == str_len)
4856 result = make_uninit_string (buf_len);
4857 CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4858 !NILP (target), SDATA (result), buf_len, NULL);
4860 CFRelease (str);
4863 UNBLOCK_INPUT;
4865 UNGCPRO;
4867 return result;
4870 DEFUN ("mac-process-hi-command", Fmac_process_hi_command, Smac_process_hi_command, 1, 1, 0,
4871 doc: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4872 COMMAND-ID must be a 4-character string. Some common command IDs are
4873 defined in the Carbon Event Manager. */)
4874 (command_id)
4875 Lisp_Object command_id;
4877 OSStatus err;
4878 HICommand command;
4880 bzero (&command, sizeof (HICommand));
4881 command.commandID = mac_get_code_from_arg (command_id, 0);
4883 BLOCK_INPUT;
4884 err = ProcessHICommand (&command);
4885 UNBLOCK_INPUT;
4887 if (err != noErr)
4888 error ("HI command (command ID: '%s') not handled.", SDATA (command_id));
4890 return Qnil;
4893 #endif /* TARGET_API_MAC_CARBON */
4896 static Lisp_Object
4897 mac_get_system_locale ()
4899 OSStatus err;
4900 LangCode lang;
4901 RegionCode region;
4902 LocaleRef locale;
4903 Str255 str;
4905 lang = GetScriptVariable (smSystemScript, smScriptLang);
4906 region = GetScriptManagerVariable (smRegionCode);
4907 err = LocaleRefFromLangOrRegionCode (lang, region, &locale);
4908 if (err == noErr)
4909 err = LocaleRefGetPartString (locale, kLocaleAllPartsMask,
4910 sizeof (str), str);
4911 if (err == noErr)
4912 return build_string (str);
4913 else
4914 return Qnil;
4918 #ifdef MAC_OSX
4920 extern int inhibit_window_system;
4921 extern int noninteractive;
4923 /* Unlike in X11, window events in Carbon do not come from sockets.
4924 So we cannot simply use `select' to monitor two kinds of inputs:
4925 window events and process outputs. We emulate such functionality
4926 by regarding fd 0 as the window event channel and simultaneously
4927 monitoring both kinds of input channels. It is implemented by
4928 dividing into some cases:
4929 1. The window event channel is not involved.
4930 -> Use `select'.
4931 2. Sockets are not involved.
4932 -> Use ReceiveNextEvent.
4933 3. [If SELECT_USE_CFSOCKET is set]
4934 Only the window event channel and socket read/write channels are
4935 involved, and timeout is not too short (greater than
4936 SELECT_TIMEOUT_THRESHOLD_RUNLOOP seconds).
4937 -> Create CFSocket for each socket and add it into the current
4938 event RunLoop so that the current event loop gets quit when
4939 the socket becomes ready. Then mac_run_loop_run_once can
4940 wait for both kinds of inputs.
4941 4. Otherwise.
4942 -> Periodically poll the window input channel while repeatedly
4943 executing `select' with a short timeout
4944 (SELECT_POLLING_PERIOD_USEC microseconds). */
4946 #ifndef SELECT_USE_CFSOCKET
4947 #define SELECT_USE_CFSOCKET 1
4948 #endif
4950 #define SELECT_POLLING_PERIOD_USEC 100000
4951 #if SELECT_USE_CFSOCKET
4952 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4954 /* Dictionary of file descriptors vs CFSocketRef's allocated in
4955 sys_select. */
4956 static CFMutableDictionaryRef cfsockets_for_select;
4958 /* Process ID of Emacs. */
4959 static pid_t mac_emacs_pid;
4961 static void
4962 socket_callback (s, type, address, data, info)
4963 CFSocketRef s;
4964 CFSocketCallBackType type;
4965 CFDataRef address;
4966 const void *data;
4967 void *info;
4970 #endif /* SELECT_USE_CFSOCKET */
4972 static int
4973 select_and_poll_event (nfds, rfds, wfds, efds, timeout)
4974 int nfds;
4975 SELECT_TYPE *rfds, *wfds, *efds;
4976 EMACS_TIME *timeout;
4978 int timedout_p = 0;
4979 int r = 0;
4980 EMACS_TIME select_timeout;
4981 EventTimeout timeoutval =
4982 (timeout
4983 ? (EMACS_SECS (*timeout) * kEventDurationSecond
4984 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
4985 : kEventDurationForever);
4986 SELECT_TYPE orfds, owfds, oefds;
4988 if (timeout == NULL)
4990 if (rfds) orfds = *rfds;
4991 if (wfds) owfds = *wfds;
4992 if (efds) oefds = *efds;
4995 /* Try detect_input_pending before mac_run_loop_run_once in the same
4996 BLOCK_INPUT block, in case that some input has already been read
4997 asynchronously. */
4998 BLOCK_INPUT;
4999 while (1)
5001 if (detect_input_pending ())
5002 break;
5004 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5005 r = select (nfds, rfds, wfds, efds, &select_timeout);
5006 if (r != 0)
5007 break;
5009 if (timeoutval == 0.0)
5010 timedout_p = 1;
5011 else
5012 timedout_p = mac_run_loop_run_once (timeoutval);
5014 if (timeout == NULL && timedout_p)
5016 if (rfds) *rfds = orfds;
5017 if (wfds) *wfds = owfds;
5018 if (efds) *efds = oefds;
5020 else
5021 break;
5023 UNBLOCK_INPUT;
5025 if (r != 0)
5026 return r;
5027 else if (!timedout_p)
5029 /* Pretend that `select' is interrupted by a signal. */
5030 detect_input_pending ();
5031 errno = EINTR;
5032 return -1;
5034 else
5035 return 0;
5038 /* Clean up the CFSocket associated with the file descriptor FD in
5039 case the same descriptor is used in other threads later. If no
5040 CFSocket is associated with FD, then return 0 without closing FD.
5041 Otherwise, return 1 with closing FD. */
5044 mac_try_close_socket (fd)
5045 int fd;
5047 #if SELECT_USE_CFSOCKET
5048 if (getpid () == mac_emacs_pid && cfsockets_for_select)
5050 void *key = (void *) fd;
5051 CFSocketRef socket =
5052 (CFSocketRef) CFDictionaryGetValue (cfsockets_for_select, key);
5054 if (socket)
5056 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
5057 CFOptionFlags flags = CFSocketGetSocketFlags (socket);
5059 if (!(flags & kCFSocketCloseOnInvalidate))
5060 CFSocketSetSocketFlags (socket, flags | kCFSocketCloseOnInvalidate);
5061 #endif
5062 BLOCK_INPUT;
5063 CFSocketInvalidate (socket);
5064 CFDictionaryRemoveValue (cfsockets_for_select, key);
5065 UNBLOCK_INPUT;
5067 return 1;
5070 #endif
5072 return 0;
5076 sys_select (nfds, rfds, wfds, efds, timeout)
5077 int nfds;
5078 SELECT_TYPE *rfds, *wfds, *efds;
5079 EMACS_TIME *timeout;
5081 int timedout_p = 0;
5082 int r;
5083 EMACS_TIME select_timeout;
5084 SELECT_TYPE orfds, owfds, oefds;
5086 if (inhibit_window_system || noninteractive
5087 || nfds < 1 || rfds == NULL || !FD_ISSET (0, rfds))
5088 return select (nfds, rfds, wfds, efds, timeout);
5090 FD_CLR (0, rfds);
5091 orfds = *rfds;
5093 if (wfds)
5094 owfds = *wfds;
5095 else
5096 FD_ZERO (&owfds);
5098 if (efds)
5099 oefds = *efds;
5100 else
5102 EventTimeout timeoutval =
5103 (timeout
5104 ? (EMACS_SECS (*timeout) * kEventDurationSecond
5105 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
5106 : kEventDurationForever);
5108 FD_SET (0, rfds); /* sentinel */
5111 nfds--;
5113 while (!(FD_ISSET (nfds, rfds) || (wfds && FD_ISSET (nfds, wfds))));
5114 nfds++;
5115 FD_CLR (0, rfds);
5117 if (nfds == 1)
5118 return select_and_poll_event (nfds, rfds, wfds, efds, timeout);
5120 /* Avoid initial overhead of RunLoop setup for the case that
5121 some input is already available. */
5122 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5123 r = select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
5124 if (r != 0 || timeoutval == 0.0)
5125 return r;
5127 *rfds = orfds;
5128 if (wfds)
5129 *wfds = owfds;
5131 #if SELECT_USE_CFSOCKET
5132 if (timeoutval > 0 && timeoutval <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
5133 goto poll_periodically;
5135 /* Try detect_input_pending before mac_run_loop_run_once in the
5136 same BLOCK_INPUT block, in case that some input has already
5137 been read asynchronously. */
5138 BLOCK_INPUT;
5139 if (!detect_input_pending ())
5141 int minfd, fd;
5142 CFRunLoopRef runloop =
5143 (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5144 static CFMutableDictionaryRef sources;
5146 if (sources == NULL)
5147 sources =
5148 CFDictionaryCreateMutable (NULL, 0, NULL,
5149 &kCFTypeDictionaryValueCallBacks);
5151 if (cfsockets_for_select == NULL)
5152 cfsockets_for_select =
5153 CFDictionaryCreateMutable (NULL, 0, NULL,
5154 &kCFTypeDictionaryValueCallBacks);
5156 for (minfd = 1; ; minfd++) /* nfds-1 works as a sentinel. */
5157 if (FD_ISSET (minfd, rfds) || (wfds && FD_ISSET (minfd, wfds)))
5158 break;
5160 for (fd = minfd; fd < nfds; fd++)
5161 if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
5163 void *key = (void *) fd;
5164 CFRunLoopSourceRef source =
5165 (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
5167 if (source == NULL || !CFRunLoopSourceIsValid (source))
5169 CFSocketRef socket =
5170 CFSocketCreateWithNative (NULL, fd,
5171 (kCFSocketReadCallBack
5172 | kCFSocketConnectCallBack),
5173 socket_callback, NULL);
5175 if (socket == NULL)
5176 continue;
5177 CFDictionarySetValue (cfsockets_for_select, key, socket);
5178 source = CFSocketCreateRunLoopSource (NULL, socket, 0);
5179 CFRelease (socket);
5180 if (source == NULL)
5181 continue;
5182 CFDictionarySetValue (sources, key, source);
5183 CFRelease (source);
5185 CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode);
5188 timedout_p = mac_run_loop_run_once (timeoutval);
5190 for (fd = minfd; fd < nfds; fd++)
5191 if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
5193 void *key = (void *) fd;
5194 CFRunLoopSourceRef source =
5195 (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
5197 CFRunLoopRemoveSource (runloop, source, kCFRunLoopDefaultMode);
5200 UNBLOCK_INPUT;
5202 if (!timedout_p)
5204 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5205 return select_and_poll_event (nfds, rfds, wfds, efds,
5206 &select_timeout);
5208 else
5210 FD_ZERO (rfds);
5211 if (wfds)
5212 FD_ZERO (wfds);
5213 return 0;
5215 #endif /* SELECT_USE_CFSOCKET */
5218 poll_periodically:
5220 EMACS_TIME end_time, now, remaining_time;
5222 if (timeout)
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);
5235 if (r != 0)
5236 return r;
5238 *rfds = orfds;
5239 if (wfds)
5240 *wfds = owfds;
5241 if (efds)
5242 *efds = oefds;
5244 if (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. */
5267 void
5268 init_mac_osx_environment ()
5270 CFBundleRef bundle;
5271 CFURLRef bundleURL;
5272 CFStringRef cf_app_bundle_pathname;
5273 int app_bundle_pathname_len;
5274 char *app_bundle_pathname;
5275 char *p, *q;
5276 struct stat st;
5278 mac_emacs_pid = getpid ();
5280 /* Initialize locale related variables. */
5281 mac_system_script_code =
5282 (ScriptCode) GetScriptManagerVariable (smSysScript);
5283 Vmac_system_locale = mac_get_system_locale ();
5285 /* Fetch the pathname of the application bundle as a C string into
5286 app_bundle_pathname. */
5288 bundle = CFBundleGetMainBundle ();
5289 if (!bundle || CFBundleGetIdentifier (bundle) == NULL)
5291 /* We could not find the bundle identifier. For now, prevent
5292 the fatal error by bringing it up in the terminal. */
5293 inhibit_window_system = 1;
5294 return;
5297 bundleURL = CFBundleCopyBundleURL (bundle);
5298 if (!bundleURL)
5299 return;
5301 cf_app_bundle_pathname = CFURLCopyFileSystemPath (bundleURL,
5302 kCFURLPOSIXPathStyle);
5303 app_bundle_pathname_len = CFStringGetLength (cf_app_bundle_pathname);
5304 app_bundle_pathname = (char *) alloca (app_bundle_pathname_len + 1);
5306 if (!CFStringGetCString (cf_app_bundle_pathname,
5307 app_bundle_pathname,
5308 app_bundle_pathname_len + 1,
5309 kCFStringEncodingISOLatin1))
5311 CFRelease (cf_app_bundle_pathname);
5312 return;
5315 CFRelease (cf_app_bundle_pathname);
5317 /* P should have sufficient room for the pathname of the bundle plus
5318 the subpath in it leading to the respective directories. Q
5319 should have three times that much room because EMACSLOADPATH can
5320 have the value "<path to site-lisp dir>:<path to lisp dir>:<path
5321 to leim dir>". */
5322 p = (char *) alloca (app_bundle_pathname_len + 50);
5323 q = (char *) alloca (3 * app_bundle_pathname_len + 150);
5324 if (!getenv ("EMACSLOADPATH"))
5326 q[0] = '\0';
5328 strcpy (p, app_bundle_pathname);
5329 strcat (p, "/Contents/Resources/site-lisp");
5330 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5331 strcat (q, p);
5333 strcpy (p, app_bundle_pathname);
5334 strcat (p, "/Contents/Resources/lisp");
5335 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5337 if (q[0] != '\0')
5338 strcat (q, ":");
5339 strcat (q, p);
5342 strcpy (p, app_bundle_pathname);
5343 strcat (p, "/Contents/Resources/leim");
5344 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5346 if (q[0] != '\0')
5347 strcat (q, ":");
5348 strcat (q, p);
5351 if (q[0] != '\0')
5352 setenv ("EMACSLOADPATH", q, 1);
5355 if (!getenv ("EMACSPATH"))
5357 q[0] = '\0';
5359 strcpy (p, app_bundle_pathname);
5360 strcat (p, "/Contents/MacOS/libexec");
5361 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5362 strcat (q, p);
5364 strcpy (p, app_bundle_pathname);
5365 strcat (p, "/Contents/MacOS/bin");
5366 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5368 if (q[0] != '\0')
5369 strcat (q, ":");
5370 strcat (q, p);
5373 if (q[0] != '\0')
5374 setenv ("EMACSPATH", q, 1);
5377 if (!getenv ("EMACSDATA"))
5379 strcpy (p, app_bundle_pathname);
5380 strcat (p, "/Contents/Resources/etc");
5381 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5382 setenv ("EMACSDATA", p, 1);
5385 if (!getenv ("EMACSDOC"))
5387 strcpy (p, app_bundle_pathname);
5388 strcat (p, "/Contents/Resources/etc");
5389 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5390 setenv ("EMACSDOC", p, 1);
5393 if (!getenv ("INFOPATH"))
5395 strcpy (p, app_bundle_pathname);
5396 strcat (p, "/Contents/Resources/info");
5397 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5398 setenv ("INFOPATH", p, 1);
5401 #endif /* MAC_OSX */
5403 #if TARGET_API_MAC_CARBON
5404 void
5405 mac_wakeup_from_rne ()
5407 #ifndef MAC_OSX
5408 if (wakeup_from_rne_enabled_p)
5409 /* Post a harmless event so as to wake up from
5410 ReceiveNextEvent. */
5411 mac_post_mouse_moved_event ();
5412 #endif
5414 #endif
5416 void
5417 syms_of_mac ()
5419 Qundecoded_file_name = intern ("undecoded-file-name");
5420 staticpro (&Qundecoded_file_name);
5422 #if TARGET_API_MAC_CARBON
5423 Qstring = intern ("string"); staticpro (&Qstring);
5424 Qnumber = intern ("number"); staticpro (&Qnumber);
5425 Qboolean = intern ("boolean"); staticpro (&Qboolean);
5426 Qdate = intern ("date"); staticpro (&Qdate);
5427 Qdata = intern ("data"); staticpro (&Qdata);
5428 Qarray = intern ("array"); staticpro (&Qarray);
5429 Qdictionary = intern ("dictionary"); staticpro (&Qdictionary);
5431 Qxml = intern ("xml");
5432 staticpro (&Qxml);
5434 Qmime_charset = intern ("mime-charset");
5435 staticpro (&Qmime_charset);
5437 QNFD = intern ("NFD"); staticpro (&QNFD);
5438 QNFKD = intern ("NFKD"); staticpro (&QNFKD);
5439 QNFC = intern ("NFC"); staticpro (&QNFC);
5440 QNFKC = intern ("NFKC"); staticpro (&QNFKC);
5441 QHFS_plus_D = intern ("HFS+D"); staticpro (&QHFS_plus_D);
5442 QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C);
5443 #endif
5446 int i;
5448 for (i = 0; i < sizeof (ae_attr_table) / sizeof (ae_attr_table[0]); i++)
5450 ae_attr_table[i].symbol = intern (ae_attr_table[i].name);
5451 staticpro (&ae_attr_table[i].symbol);
5455 defsubr (&Smac_coerce_ae_data);
5456 #if TARGET_API_MAC_CARBON
5457 defsubr (&Smac_get_preference);
5458 defsubr (&Smac_code_convert_string);
5459 defsubr (&Smac_process_hi_command);
5460 #endif
5462 defsubr (&Smac_set_file_creator);
5463 defsubr (&Smac_set_file_type);
5464 defsubr (&Smac_get_file_creator);
5465 defsubr (&Smac_get_file_type);
5466 defsubr (&Sdo_applescript);
5467 defsubr (&Smac_file_name_to_posix);
5468 defsubr (&Sposix_file_name_to_mac);
5470 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code,
5471 doc: /* The system script code. */);
5472 mac_system_script_code = (ScriptCode) GetScriptManagerVariable (smSysScript);
5474 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale,
5475 doc: /* The system locale identifier string.
5476 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5477 information is not included. */);
5478 Vmac_system_locale = mac_get_system_locale ();
5481 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5482 (do not change this comment) */