(emacs-uptime): Add optional `format' argument. Doc fix. Use `%z'
[emacs.git] / src / mac.c
blob5a8c8823ec4f1a51745493f7b715531792561b9b
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_OS_X
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 static 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 OSStatus
846 create_apple_event_from_event_ref (event, num_params, names, types, result)
847 EventRef event;
848 UInt32 num_params;
849 const EventParamName *names;
850 const EventParamType *types;
851 AppleEvent *result;
853 OSStatus err;
854 UInt32 i, size;
855 CFStringRef string;
856 CFDataRef data;
857 char *buf = NULL;
859 err = create_apple_event (0, 0, result); /* Dummy class and ID. */
860 if (err != noErr)
861 return err;
863 for (i = 0; i < num_params; i++)
864 switch (types[i])
866 #ifdef MAC_OSX
867 case typeCFStringRef:
868 err = GetEventParameter (event, names[i], typeCFStringRef, NULL,
869 sizeof (CFStringRef), NULL, &string);
870 if (err != noErr)
871 break;
872 data = CFStringCreateExternalRepresentation (NULL, string,
873 kCFStringEncodingUTF8,
874 '?');
875 if (data == NULL)
876 break;
877 AEPutParamPtr (result, names[i], typeUTF8Text,
878 CFDataGetBytePtr (data), CFDataGetLength (data));
879 CFRelease (data);
880 break;
881 #endif
883 default:
884 err = GetEventParameter (event, names[i], types[i], NULL,
885 0, &size, NULL);
886 if (err != noErr)
887 break;
888 buf = xrealloc (buf, size);
889 err = GetEventParameter (event, names[i], types[i], NULL,
890 size, NULL, buf);
891 if (err == noErr)
892 AEPutParamPtr (result, names[i], types[i], buf, size);
893 break;
895 if (buf)
896 xfree (buf);
898 return noErr;
901 OSErr
902 create_apple_event_from_drag_ref (drag, num_types, types, result)
903 DragRef drag;
904 UInt32 num_types;
905 const FlavorType *types;
906 AppleEvent *result;
908 OSErr err;
909 UInt16 num_items;
910 AppleEvent items;
911 long index;
912 char *buf = NULL;
914 err = CountDragItems (drag, &num_items);
915 if (err != noErr)
916 return err;
917 err = AECreateList (NULL, 0, false, &items);
918 if (err != noErr)
919 return err;
921 for (index = 1; index <= num_items; index++)
923 ItemReference item;
924 DescType desc_type = typeNull;
925 Size size;
927 err = GetDragItemReferenceNumber (drag, index, &item);
928 if (err == noErr)
930 int i;
932 for (i = 0; i < num_types; i++)
934 err = GetFlavorDataSize (drag, item, types[i], &size);
935 if (err == noErr)
937 buf = xrealloc (buf, size);
938 err = GetFlavorData (drag, item, types[i], buf, &size, 0);
940 if (err == noErr)
942 desc_type = types[i];
943 break;
947 err = AEPutPtr (&items, index, desc_type,
948 desc_type != typeNull ? buf : NULL,
949 desc_type != typeNull ? size : 0);
950 if (err != noErr)
951 break;
953 if (buf)
954 xfree (buf);
956 if (err == noErr)
958 err = create_apple_event (0, 0, result); /* Dummy class and ID. */
959 if (err == noErr)
960 err = AEPutParamDesc (result, keyDirectObject, &items);
961 if (err != noErr)
962 AEDisposeDesc (result);
965 AEDisposeDesc (&items);
967 return err;
969 #endif /* TARGET_API_MAC_CARBON */
971 /***********************************************************************
972 Conversion between Lisp and Core Foundation objects
973 ***********************************************************************/
975 #if TARGET_API_MAC_CARBON
976 static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
977 static Lisp_Object Qarray, Qdictionary;
979 struct cfdict_context
981 Lisp_Object *result;
982 int with_tag, hash_bound;
985 /* C string to CFString. */
987 CFStringRef
988 cfstring_create_with_utf8_cstring (c_str)
989 const char *c_str;
991 CFStringRef str;
993 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingUTF8);
994 if (str == NULL)
995 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
996 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingMacRoman);
998 return str;
1002 /* Lisp string to CFString. */
1004 CFStringRef
1005 cfstring_create_with_string (s)
1006 Lisp_Object s;
1008 CFStringRef string = NULL;
1010 if (STRING_MULTIBYTE (s))
1012 char *p, *end = SDATA (s) + SBYTES (s);
1014 for (p = SDATA (s); p < end; p++)
1015 if (!isascii (*p))
1017 s = ENCODE_UTF_8 (s);
1018 break;
1020 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
1021 kCFStringEncodingUTF8, false);
1024 if (string == NULL)
1025 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
1026 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
1027 kCFStringEncodingMacRoman, false);
1029 return string;
1033 /* From CFData to a lisp string. Always returns a unibyte string. */
1035 Lisp_Object
1036 cfdata_to_lisp (data)
1037 CFDataRef data;
1039 CFIndex len = CFDataGetLength (data);
1040 Lisp_Object result = make_uninit_string (len);
1042 CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
1044 return result;
1048 /* From CFString to a lisp string. Returns a unibyte string
1049 containing a UTF-8 byte sequence. */
1051 Lisp_Object
1052 cfstring_to_lisp_nodecode (string)
1053 CFStringRef string;
1055 Lisp_Object result = Qnil;
1056 const char *s = CFStringGetCStringPtr (string, kCFStringEncodingUTF8);
1058 if (s)
1059 result = make_unibyte_string (s, strlen (s));
1060 else
1062 CFDataRef data =
1063 CFStringCreateExternalRepresentation (NULL, string,
1064 kCFStringEncodingUTF8, '?');
1066 if (data)
1068 result = cfdata_to_lisp (data);
1069 CFRelease (data);
1073 return result;
1077 /* From CFString to a lisp string. Never returns a unibyte string
1078 (even if it only contains ASCII characters).
1079 This may cause GC during code conversion. */
1081 Lisp_Object
1082 cfstring_to_lisp (string)
1083 CFStringRef string;
1085 Lisp_Object result = cfstring_to_lisp_nodecode (string);
1087 if (!NILP (result))
1089 result = code_convert_string_norecord (result, Qutf_8, 0);
1090 /* This may be superfluous. Just to make sure that the result
1091 is a multibyte string. */
1092 result = string_to_multibyte (result);
1095 return result;
1099 /* CFNumber to a lisp integer or a lisp float. */
1101 Lisp_Object
1102 cfnumber_to_lisp (number)
1103 CFNumberRef number;
1105 Lisp_Object result = Qnil;
1106 #if BITS_PER_EMACS_INT > 32
1107 SInt64 int_val;
1108 CFNumberType emacs_int_type = kCFNumberSInt64Type;
1109 #else
1110 SInt32 int_val;
1111 CFNumberType emacs_int_type = kCFNumberSInt32Type;
1112 #endif
1113 double float_val;
1115 if (CFNumberGetValue (number, emacs_int_type, &int_val)
1116 && !FIXNUM_OVERFLOW_P (int_val))
1117 result = make_number (int_val);
1118 else
1119 if (CFNumberGetValue (number, kCFNumberDoubleType, &float_val))
1120 result = make_float (float_val);
1121 return result;
1125 /* CFDate to a list of three integers as in a return value of
1126 `current-time'. */
1128 Lisp_Object
1129 cfdate_to_lisp (date)
1130 CFDateRef date;
1132 CFTimeInterval sec;
1133 int high, low, microsec;
1135 sec = CFDateGetAbsoluteTime (date) + kCFAbsoluteTimeIntervalSince1970;
1136 high = sec / 65536.0;
1137 low = sec - high * 65536.0;
1138 microsec = (sec - floor (sec)) * 1000000.0;
1140 return list3 (make_number (high), make_number (low), make_number (microsec));
1144 /* CFBoolean to a lisp symbol, `t' or `nil'. */
1146 Lisp_Object
1147 cfboolean_to_lisp (boolean)
1148 CFBooleanRef boolean;
1150 return CFBooleanGetValue (boolean) ? Qt : Qnil;
1154 /* Any Core Foundation object to a (lengthy) lisp string. */
1156 Lisp_Object
1157 cfobject_desc_to_lisp (object)
1158 CFTypeRef object;
1160 Lisp_Object result = Qnil;
1161 CFStringRef desc = CFCopyDescription (object);
1163 if (desc)
1165 result = cfstring_to_lisp (desc);
1166 CFRelease (desc);
1169 return result;
1173 /* Callback functions for cfproperty_list_to_lisp. */
1175 static void
1176 cfdictionary_add_to_list (key, value, context)
1177 const void *key;
1178 const void *value;
1179 void *context;
1181 struct cfdict_context *cxt = (struct cfdict_context *)context;
1183 *cxt->result =
1184 Fcons (Fcons (cfstring_to_lisp (key),
1185 cfproperty_list_to_lisp (value, cxt->with_tag,
1186 cxt->hash_bound)),
1187 *cxt->result);
1190 static void
1191 cfdictionary_puthash (key, value, context)
1192 const void *key;
1193 const void *value;
1194 void *context;
1196 Lisp_Object lisp_key = cfstring_to_lisp (key);
1197 struct cfdict_context *cxt = (struct cfdict_context *)context;
1198 struct Lisp_Hash_Table *h = XHASH_TABLE (*(cxt->result));
1199 unsigned hash_code;
1201 hash_lookup (h, lisp_key, &hash_code);
1202 hash_put (h, lisp_key,
1203 cfproperty_list_to_lisp (value, cxt->with_tag, cxt->hash_bound),
1204 hash_code);
1208 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
1209 non-zero, a symbol that represents the type of the original Core
1210 Foundation object is prepended. HASH_BOUND specifies which kinds
1211 of the lisp objects, alists or hash tables, are used as the targets
1212 of the conversion from CFDictionary. If HASH_BOUND is negative,
1213 always generate alists. If HASH_BOUND >= 0, generate an alist if
1214 the number of keys in the dictionary is smaller than HASH_BOUND,
1215 and a hash table otherwise. */
1217 Lisp_Object
1218 cfproperty_list_to_lisp (plist, with_tag, hash_bound)
1219 CFPropertyListRef plist;
1220 int with_tag, hash_bound;
1222 CFTypeID type_id = CFGetTypeID (plist);
1223 Lisp_Object tag = Qnil, result = Qnil;
1224 struct gcpro gcpro1, gcpro2;
1226 GCPRO2 (tag, result);
1228 if (type_id == CFStringGetTypeID ())
1230 tag = Qstring;
1231 result = cfstring_to_lisp (plist);
1233 else if (type_id == CFNumberGetTypeID ())
1235 tag = Qnumber;
1236 result = cfnumber_to_lisp (plist);
1238 else if (type_id == CFBooleanGetTypeID ())
1240 tag = Qboolean;
1241 result = cfboolean_to_lisp (plist);
1243 else if (type_id == CFDateGetTypeID ())
1245 tag = Qdate;
1246 result = cfdate_to_lisp (plist);
1248 else if (type_id == CFDataGetTypeID ())
1250 tag = Qdata;
1251 result = cfdata_to_lisp (plist);
1253 else if (type_id == CFArrayGetTypeID ())
1255 CFIndex index, count = CFArrayGetCount (plist);
1257 tag = Qarray;
1258 result = Fmake_vector (make_number (count), Qnil);
1259 for (index = 0; index < count; index++)
1260 XVECTOR (result)->contents[index] =
1261 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist, index),
1262 with_tag, hash_bound);
1264 else if (type_id == CFDictionaryGetTypeID ())
1266 struct cfdict_context context;
1267 CFIndex count = CFDictionaryGetCount (plist);
1269 tag = Qdictionary;
1270 context.result = &result;
1271 context.with_tag = with_tag;
1272 context.hash_bound = hash_bound;
1273 if (hash_bound < 0 || count < hash_bound)
1275 result = Qnil;
1276 CFDictionaryApplyFunction (plist, cfdictionary_add_to_list,
1277 &context);
1279 else
1281 result = make_hash_table (Qequal,
1282 make_number (count),
1283 make_float (DEFAULT_REHASH_SIZE),
1284 make_float (DEFAULT_REHASH_THRESHOLD),
1285 Qnil, Qnil, Qnil);
1286 CFDictionaryApplyFunction (plist, cfdictionary_puthash,
1287 &context);
1290 else
1291 abort ();
1293 UNGCPRO;
1295 if (with_tag)
1296 result = Fcons (tag, result);
1298 return result;
1300 #endif
1303 /***********************************************************************
1304 Emulation of the X Resource Manager
1305 ***********************************************************************/
1307 /* Parser functions for resource lines. Each function takes an
1308 address of a variable whose value points to the head of a string.
1309 The value will be advanced so that it points to the next character
1310 of the parsed part when the function returns.
1312 A resource name such as "Emacs*font" is parsed into a non-empty
1313 list called `quarks'. Each element is either a Lisp string that
1314 represents a concrete component, a Lisp symbol LOOSE_BINDING
1315 (actually Qlambda) that represents any number (>=0) of intervening
1316 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1317 that represents as any single component. */
1319 #define P (*p)
1321 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1322 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1324 static void
1325 skip_white_space (p)
1326 const char **p;
1328 /* WhiteSpace = {<space> | <horizontal tab>} */
1329 while (*P == ' ' || *P == '\t')
1330 P++;
1333 static int
1334 parse_comment (p)
1335 const char **p;
1337 /* Comment = "!" {<any character except null or newline>} */
1338 if (*P == '!')
1340 P++;
1341 while (*P)
1342 if (*P++ == '\n')
1343 break;
1344 return 1;
1346 else
1347 return 0;
1350 /* Don't interpret filename. Just skip until the newline. */
1351 static int
1352 parse_include_file (p)
1353 const char **p;
1355 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1356 if (*P == '#')
1358 P++;
1359 while (*P)
1360 if (*P++ == '\n')
1361 break;
1362 return 1;
1364 else
1365 return 0;
1368 static char
1369 parse_binding (p)
1370 const char **p;
1372 /* Binding = "." | "*" */
1373 if (*P == '.' || *P == '*')
1375 char binding = *P++;
1377 while (*P == '.' || *P == '*')
1378 if (*P++ == '*')
1379 binding = '*';
1380 return binding;
1382 else
1383 return '\0';
1386 static Lisp_Object
1387 parse_component (p)
1388 const char **p;
1390 /* Component = "?" | ComponentName
1391 ComponentName = NameChar {NameChar}
1392 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1393 if (*P == '?')
1395 P++;
1396 return SINGLE_COMPONENT;
1398 else if (isalnum (*P) || *P == '_' || *P == '-')
1400 const char *start = P++;
1402 while (isalnum (*P) || *P == '_' || *P == '-')
1403 P++;
1405 return make_unibyte_string (start, P - start);
1407 else
1408 return Qnil;
1411 static Lisp_Object
1412 parse_resource_name (p)
1413 const char **p;
1415 Lisp_Object result = Qnil, component;
1416 char binding;
1418 /* ResourceName = [Binding] {Component Binding} ComponentName */
1419 if (parse_binding (p) == '*')
1420 result = Fcons (LOOSE_BINDING, result);
1422 component = parse_component (p);
1423 if (NILP (component))
1424 return Qnil;
1426 result = Fcons (component, result);
1427 while ((binding = parse_binding (p)) != '\0')
1429 if (binding == '*')
1430 result = Fcons (LOOSE_BINDING, result);
1431 component = parse_component (p);
1432 if (NILP (component))
1433 return Qnil;
1434 else
1435 result = Fcons (component, result);
1438 /* The final component should not be '?'. */
1439 if (EQ (component, SINGLE_COMPONENT))
1440 return Qnil;
1442 return Fnreverse (result);
1445 static Lisp_Object
1446 parse_value (p)
1447 const char **p;
1449 char *q, *buf;
1450 Lisp_Object seq = Qnil, result;
1451 int buf_len, total_len = 0, len, continue_p;
1453 q = strchr (P, '\n');
1454 buf_len = q ? q - P : strlen (P);
1455 buf = xmalloc (buf_len);
1457 while (1)
1459 q = buf;
1460 continue_p = 0;
1461 while (*P)
1463 if (*P == '\n')
1465 P++;
1466 break;
1468 else if (*P == '\\')
1470 P++;
1471 if (*P == '\0')
1472 break;
1473 else if (*P == '\n')
1475 P++;
1476 continue_p = 1;
1477 break;
1479 else if (*P == 'n')
1481 *q++ = '\n';
1482 P++;
1484 else if ('0' <= P[0] && P[0] <= '7'
1485 && '0' <= P[1] && P[1] <= '7'
1486 && '0' <= P[2] && P[2] <= '7')
1488 *q++ = ((P[0] - '0') << 6) + ((P[1] - '0') << 3) + (P[2] - '0');
1489 P += 3;
1491 else
1492 *q++ = *P++;
1494 else
1495 *q++ = *P++;
1497 len = q - buf;
1498 seq = Fcons (make_unibyte_string (buf, len), seq);
1499 total_len += len;
1501 if (continue_p)
1503 q = strchr (P, '\n');
1504 len = q ? q - P : strlen (P);
1505 if (len > buf_len)
1507 xfree (buf);
1508 buf_len = len;
1509 buf = xmalloc (buf_len);
1512 else
1513 break;
1515 xfree (buf);
1517 if (SBYTES (XCAR (seq)) == total_len)
1518 return make_string (SDATA (XCAR (seq)), total_len);
1519 else
1521 buf = xmalloc (total_len);
1522 q = buf + total_len;
1523 for (; CONSP (seq); seq = XCDR (seq))
1525 len = SBYTES (XCAR (seq));
1526 q -= len;
1527 memcpy (q, SDATA (XCAR (seq)), len);
1529 result = make_string (buf, total_len);
1530 xfree (buf);
1531 return result;
1535 static Lisp_Object
1536 parse_resource_line (p)
1537 const char **p;
1539 Lisp_Object quarks, value;
1541 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1542 if (parse_comment (p) || parse_include_file (p))
1543 return Qnil;
1545 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
1546 skip_white_space (p);
1547 quarks = parse_resource_name (p);
1548 if (NILP (quarks))
1549 goto cleanup;
1550 skip_white_space (p);
1551 if (*P != ':')
1552 goto cleanup;
1553 P++;
1554 skip_white_space (p);
1555 value = parse_value (p);
1556 return Fcons (quarks, value);
1558 cleanup:
1559 /* Skip the remaining data as a dummy value. */
1560 parse_value (p);
1561 return Qnil;
1564 #undef P
1566 /* Equivalents of X Resource Manager functions.
1568 An X Resource Database acts as a collection of resource names and
1569 associated values. It is implemented as a trie on quarks. Namely,
1570 each edge is labeled by either a string, LOOSE_BINDING, or
1571 SINGLE_COMPONENT. Each node has a node id, which is a unique
1572 nonnegative integer, and the root node id is 0. A database is
1573 implemented as a hash table that maps a pair (SRC-NODE-ID .
1574 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1575 in the table as a value for HASHKEY_MAX_NID. A value associated to
1576 a node is recorded as a value for the node id.
1578 A database also has a cache for past queries as a value for
1579 HASHKEY_QUERY_CACHE. It is another hash table that maps
1580 "NAME-STRING\0CLASS-STRING" to the result of the query. */
1582 #define HASHKEY_MAX_NID (make_number (0))
1583 #define HASHKEY_QUERY_CACHE (make_number (-1))
1585 static XrmDatabase
1586 xrm_create_database ()
1588 XrmDatabase database;
1590 database = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1591 make_float (DEFAULT_REHASH_SIZE),
1592 make_float (DEFAULT_REHASH_THRESHOLD),
1593 Qnil, Qnil, Qnil);
1594 Fputhash (HASHKEY_MAX_NID, make_number (0), database);
1595 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
1597 return database;
1600 static void
1601 xrm_q_put_resource (database, quarks, value)
1602 XrmDatabase database;
1603 Lisp_Object quarks, value;
1605 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
1606 unsigned hash_code;
1607 int max_nid, i;
1608 Lisp_Object node_id, key;
1610 max_nid = XINT (Fgethash (HASHKEY_MAX_NID, database, Qnil));
1612 XSETINT (node_id, 0);
1613 for (; CONSP (quarks); quarks = XCDR (quarks))
1615 key = Fcons (node_id, XCAR (quarks));
1616 i = hash_lookup (h, key, &hash_code);
1617 if (i < 0)
1619 max_nid++;
1620 XSETINT (node_id, max_nid);
1621 hash_put (h, key, node_id, hash_code);
1623 else
1624 node_id = HASH_VALUE (h, i);
1626 Fputhash (node_id, value, database);
1628 Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
1629 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
1632 /* Merge multiple resource entries specified by DATA into a resource
1633 database DATABASE. DATA points to the head of a null-terminated
1634 string consisting of multiple resource lines. It's like a
1635 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1637 void
1638 xrm_merge_string_database (database, data)
1639 XrmDatabase database;
1640 const char *data;
1642 Lisp_Object quarks_value;
1644 while (*data)
1646 quarks_value = parse_resource_line (&data);
1647 if (!NILP (quarks_value))
1648 xrm_q_put_resource (database,
1649 XCAR (quarks_value), XCDR (quarks_value));
1653 static Lisp_Object
1654 xrm_q_get_resource_1 (database, node_id, quark_name, quark_class)
1655 XrmDatabase database;
1656 Lisp_Object node_id, quark_name, quark_class;
1658 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
1659 Lisp_Object key, labels[3], value;
1660 int i, k;
1662 if (!CONSP (quark_name))
1663 return Fgethash (node_id, database, Qnil);
1665 /* First, try tight bindings */
1666 labels[0] = XCAR (quark_name);
1667 labels[1] = XCAR (quark_class);
1668 labels[2] = SINGLE_COMPONENT;
1670 key = Fcons (node_id, Qnil);
1671 for (k = 0; k < sizeof (labels) / sizeof (*labels); k++)
1673 XSETCDR (key, labels[k]);
1674 i = hash_lookup (h, key, NULL);
1675 if (i >= 0)
1677 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1678 XCDR (quark_name), XCDR (quark_class));
1679 if (!NILP (value))
1680 return value;
1684 /* Then, try loose bindings */
1685 XSETCDR (key, LOOSE_BINDING);
1686 i = hash_lookup (h, key, NULL);
1687 if (i >= 0)
1689 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1690 quark_name, quark_class);
1691 if (!NILP (value))
1692 return value;
1693 else
1694 return xrm_q_get_resource_1 (database, node_id,
1695 XCDR (quark_name), XCDR (quark_class));
1697 else
1698 return Qnil;
1701 static Lisp_Object
1702 xrm_q_get_resource (database, quark_name, quark_class)
1703 XrmDatabase database;
1704 Lisp_Object quark_name, quark_class;
1706 return xrm_q_get_resource_1 (database, make_number (0),
1707 quark_name, quark_class);
1710 /* Retrieve a resource value for the specified NAME and CLASS from the
1711 resource database DATABASE. It corresponds to XrmGetResource. */
1713 Lisp_Object
1714 xrm_get_resource (database, name, class)
1715 XrmDatabase database;
1716 const char *name, *class;
1718 Lisp_Object key, query_cache, quark_name, quark_class, tmp;
1719 int i, nn, nc;
1720 struct Lisp_Hash_Table *h;
1721 unsigned hash_code;
1723 nn = strlen (name);
1724 nc = strlen (class);
1725 key = make_uninit_string (nn + nc + 1);
1726 strcpy (SDATA (key), name);
1727 strncpy (SDATA (key) + nn + 1, class, nc);
1729 query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil);
1730 if (NILP (query_cache))
1732 query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1733 make_float (DEFAULT_REHASH_SIZE),
1734 make_float (DEFAULT_REHASH_THRESHOLD),
1735 Qnil, Qnil, Qnil);
1736 Fputhash (HASHKEY_QUERY_CACHE, query_cache, database);
1738 h = XHASH_TABLE (query_cache);
1739 i = hash_lookup (h, key, &hash_code);
1740 if (i >= 0)
1741 return HASH_VALUE (h, i);
1743 quark_name = parse_resource_name (&name);
1744 if (*name != '\0')
1745 return Qnil;
1746 for (tmp = quark_name, nn = 0; CONSP (tmp); tmp = XCDR (tmp), nn++)
1747 if (!STRINGP (XCAR (tmp)))
1748 return Qnil;
1750 quark_class = parse_resource_name (&class);
1751 if (*class != '\0')
1752 return Qnil;
1753 for (tmp = quark_class, nc = 0; CONSP (tmp); tmp = XCDR (tmp), nc++)
1754 if (!STRINGP (XCAR (tmp)))
1755 return Qnil;
1757 if (nn != nc)
1758 return Qnil;
1759 else
1761 tmp = xrm_q_get_resource (database, quark_name, quark_class);
1762 hash_put (h, key, tmp, hash_code);
1763 return tmp;
1767 #if TARGET_API_MAC_CARBON
1768 static Lisp_Object
1769 xrm_cfproperty_list_to_value (plist)
1770 CFPropertyListRef plist;
1772 CFTypeID type_id = CFGetTypeID (plist);
1774 if (type_id == CFStringGetTypeID ())
1775 return cfstring_to_lisp (plist);
1776 else if (type_id == CFNumberGetTypeID ())
1778 CFStringRef string;
1779 Lisp_Object result = Qnil;
1781 string = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@"), plist);
1782 if (string)
1784 result = cfstring_to_lisp (string);
1785 CFRelease (string);
1787 return result;
1789 else if (type_id == CFBooleanGetTypeID ())
1790 return build_string (CFBooleanGetValue (plist) ? "true" : "false");
1791 else if (type_id == CFDataGetTypeID ())
1792 return cfdata_to_lisp (plist);
1793 else
1794 return Qnil;
1796 #endif
1798 /* Create a new resource database from the preferences for the
1799 application APPLICATION. APPLICATION is either a string that
1800 specifies an application ID, or NULL that represents the current
1801 application. */
1803 XrmDatabase
1804 xrm_get_preference_database (application)
1805 const char *application;
1807 #if TARGET_API_MAC_CARBON
1808 CFStringRef app_id, *keys, user_doms[2], host_doms[2];
1809 CFMutableSetRef key_set = NULL;
1810 CFArrayRef key_array;
1811 CFIndex index, count;
1812 char *res_name;
1813 XrmDatabase database;
1814 Lisp_Object quarks = Qnil, value = Qnil;
1815 CFPropertyListRef plist;
1816 int iu, ih;
1817 struct gcpro gcpro1, gcpro2, gcpro3;
1819 user_doms[0] = kCFPreferencesCurrentUser;
1820 user_doms[1] = kCFPreferencesAnyUser;
1821 host_doms[0] = kCFPreferencesCurrentHost;
1822 host_doms[1] = kCFPreferencesAnyHost;
1824 database = xrm_create_database ();
1826 GCPRO3 (database, quarks, value);
1828 app_id = kCFPreferencesCurrentApplication;
1829 if (application)
1831 app_id = cfstring_create_with_utf8_cstring (application);
1832 if (app_id == NULL)
1833 goto out;
1835 if (!CFPreferencesAppSynchronize (app_id))
1836 goto out;
1838 key_set = CFSetCreateMutable (NULL, 0, &kCFCopyStringSetCallBacks);
1839 if (key_set == NULL)
1840 goto out;
1841 for (iu = 0; iu < sizeof (user_doms) / sizeof (*user_doms) ; iu++)
1842 for (ih = 0; ih < sizeof (host_doms) / sizeof (*host_doms); ih++)
1844 key_array = CFPreferencesCopyKeyList (app_id, user_doms[iu],
1845 host_doms[ih]);
1846 if (key_array)
1848 count = CFArrayGetCount (key_array);
1849 for (index = 0; index < count; index++)
1850 CFSetAddValue (key_set,
1851 CFArrayGetValueAtIndex (key_array, index));
1852 CFRelease (key_array);
1856 count = CFSetGetCount (key_set);
1857 keys = xmalloc (sizeof (CFStringRef) * count);
1858 CFSetGetValues (key_set, (const void **)keys);
1859 for (index = 0; index < count; index++)
1861 res_name = SDATA (cfstring_to_lisp_nodecode (keys[index]));
1862 quarks = parse_resource_name (&res_name);
1863 if (!(NILP (quarks) || *res_name))
1865 plist = CFPreferencesCopyAppValue (keys[index], app_id);
1866 value = xrm_cfproperty_list_to_value (plist);
1867 CFRelease (plist);
1868 if (!NILP (value))
1869 xrm_q_put_resource (database, quarks, value);
1873 xfree (keys);
1874 out:
1875 if (key_set)
1876 CFRelease (key_set);
1877 CFRelease (app_id);
1879 UNGCPRO;
1881 return database;
1882 #else
1883 return xrm_create_database ();
1884 #endif
1888 #ifndef MAC_OSX
1890 /* The following functions with "sys_" prefix are stubs to Unix
1891 functions that have already been implemented by CW or MPW. The
1892 calls to them in Emacs source course are #define'd to call the sys_
1893 versions by the header files s-mac.h. In these stubs pathnames are
1894 converted between their Unix and Mac forms. */
1897 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1898 + 17 leap days. These are for adjusting time values returned by
1899 MacOS Toolbox functions. */
1901 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1903 #ifdef __MWERKS__
1904 #if __MSL__ < 0x6000
1905 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1906 a leap year! This is for adjusting time_t values returned by MSL
1907 functions. */
1908 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1909 #else /* __MSL__ >= 0x6000 */
1910 /* CW changes Pro 6 to follow Unix! */
1911 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1912 #endif /* __MSL__ >= 0x6000 */
1913 #elif __MRC__
1914 /* MPW library functions follow Unix (confused?). */
1915 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1916 #else /* not __MRC__ */
1917 You lose!!!
1918 #endif /* not __MRC__ */
1921 /* Define our own stat function for both MrC and CW. The reason for
1922 doing this: "stat" is both the name of a struct and function name:
1923 can't use the same trick like that for sys_open, sys_close, etc. to
1924 redirect Emacs's calls to our own version that converts Unix style
1925 filenames to Mac style filename because all sorts of compilation
1926 errors will be generated if stat is #define'd to be sys_stat. */
1929 stat_noalias (const char *path, struct stat *buf)
1931 char mac_pathname[MAXPATHLEN+1];
1932 CInfoPBRec cipb;
1934 if (posix_to_mac_pathname (path, mac_pathname, MAXPATHLEN+1) == 0)
1935 return -1;
1937 c2pstr (mac_pathname);
1938 cipb.hFileInfo.ioNamePtr = mac_pathname;
1939 cipb.hFileInfo.ioVRefNum = 0;
1940 cipb.hFileInfo.ioDirID = 0;
1941 cipb.hFileInfo.ioFDirIndex = 0;
1942 /* set to 0 to get information about specific dir or file */
1944 errno = PBGetCatInfo (&cipb, false);
1945 if (errno == -43) /* -43: fnfErr defined in Errors.h */
1946 errno = ENOENT;
1947 if (errno != noErr)
1948 return -1;
1950 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
1952 buf->st_mode = S_IFDIR | S_IREAD | S_IEXEC;
1954 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1955 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1956 buf->st_ino = cipb.dirInfo.ioDrDirID;
1957 buf->st_dev = cipb.dirInfo.ioVRefNum;
1958 buf->st_size = cipb.dirInfo.ioDrNmFls;
1959 /* size of dir = number of files and dirs */
1960 buf->st_atime
1961 = buf->st_mtime
1962 = cipb.dirInfo.ioDrMdDat - MAC_UNIX_EPOCH_DIFF;
1963 buf->st_ctime = cipb.dirInfo.ioDrCrDat - MAC_UNIX_EPOCH_DIFF;
1965 else
1967 buf->st_mode = S_IFREG | S_IREAD;
1968 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1969 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1970 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
1971 buf->st_mode |= S_IEXEC;
1972 buf->st_ino = cipb.hFileInfo.ioDirID;
1973 buf->st_dev = cipb.hFileInfo.ioVRefNum;
1974 buf->st_size = cipb.hFileInfo.ioFlLgLen;
1975 buf->st_atime
1976 = buf->st_mtime
1977 = cipb.hFileInfo.ioFlMdDat - MAC_UNIX_EPOCH_DIFF;
1978 buf->st_ctime = cipb.hFileInfo.ioFlCrDat - MAC_UNIX_EPOCH_DIFF;
1981 if (cipb.hFileInfo.ioFlFndrInfo.fdFlags & 0x8000)
1983 /* identify alias files as symlinks */
1984 buf->st_mode &= ~S_IFREG;
1985 buf->st_mode |= S_IFLNK;
1988 buf->st_nlink = 1;
1989 buf->st_uid = getuid ();
1990 buf->st_gid = getgid ();
1991 buf->st_rdev = 0;
1993 return 0;
1998 lstat (const char *path, struct stat *buf)
2000 int result;
2001 char true_pathname[MAXPATHLEN+1];
2003 /* Try looking for the file without resolving aliases first. */
2004 if ((result = stat_noalias (path, buf)) >= 0)
2005 return result;
2007 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2008 return -1;
2010 return stat_noalias (true_pathname, buf);
2015 stat (const char *path, struct stat *sb)
2017 int result;
2018 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2019 int len;
2021 if ((result = stat_noalias (path, sb)) >= 0 &&
2022 ! (sb->st_mode & S_IFLNK))
2023 return result;
2025 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2026 return -1;
2028 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2029 if (len > -1)
2031 fully_resolved_name[len] = '\0';
2032 /* in fact our readlink terminates strings */
2033 return lstat (fully_resolved_name, sb);
2035 else
2036 return lstat (true_pathname, sb);
2040 #if __MRC__
2041 /* CW defines fstat in stat.mac.c while MPW does not provide this
2042 function. Without the information of how to get from a file
2043 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
2044 to implement this function. Fortunately, there is only one place
2045 where this function is called in our configuration: in fileio.c,
2046 where only the st_dev and st_ino fields are used to determine
2047 whether two fildes point to different i-nodes to prevent copying
2048 a file onto itself equal. What we have here probably needs
2049 improvement. */
2052 fstat (int fildes, struct stat *buf)
2054 buf->st_dev = 0;
2055 buf->st_ino = fildes;
2056 buf->st_mode = S_IFREG; /* added by T.I. for the copy-file */
2057 return 0; /* success */
2059 #endif /* __MRC__ */
2063 mkdir (const char *dirname, int mode)
2065 #pragma unused(mode)
2067 HFileParam hfpb;
2068 char true_pathname[MAXPATHLEN+1], mac_pathname[MAXPATHLEN+1];
2070 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
2071 return -1;
2073 if (posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1) == 0)
2074 return -1;
2076 c2pstr (mac_pathname);
2077 hfpb.ioNamePtr = mac_pathname;
2078 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
2079 hfpb.ioDirID = 0; /* parent is the root */
2081 errno = PBDirCreate ((HParmBlkPtr) &hfpb, false);
2082 /* just return the Mac OSErr code for now */
2083 return errno == noErr ? 0 : -1;
2087 #undef rmdir
2088 sys_rmdir (const char *dirname)
2090 HFileParam hfpb;
2091 char mac_pathname[MAXPATHLEN+1];
2093 if (posix_to_mac_pathname (dirname, mac_pathname, MAXPATHLEN+1) == 0)
2094 return -1;
2096 c2pstr (mac_pathname);
2097 hfpb.ioNamePtr = mac_pathname;
2098 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
2099 hfpb.ioDirID = 0; /* parent is the root */
2101 errno = PBHDelete ((HParmBlkPtr) &hfpb, false);
2102 return errno == noErr ? 0 : -1;
2106 #ifdef __MRC__
2107 /* No implementation yet. */
2109 execvp (const char *path, ...)
2111 return -1;
2113 #endif /* __MRC__ */
2117 utime (const char *path, const struct utimbuf *times)
2119 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2120 int len;
2121 char mac_pathname[MAXPATHLEN+1];
2122 CInfoPBRec cipb;
2124 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2125 return -1;
2127 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2128 if (len > -1)
2129 fully_resolved_name[len] = '\0';
2130 else
2131 strcpy (fully_resolved_name, true_pathname);
2133 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2134 return -1;
2136 c2pstr (mac_pathname);
2137 cipb.hFileInfo.ioNamePtr = mac_pathname;
2138 cipb.hFileInfo.ioVRefNum = 0;
2139 cipb.hFileInfo.ioDirID = 0;
2140 cipb.hFileInfo.ioFDirIndex = 0;
2141 /* set to 0 to get information about specific dir or file */
2143 errno = PBGetCatInfo (&cipb, false);
2144 if (errno != noErr)
2145 return -1;
2147 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
2149 if (times)
2150 cipb.dirInfo.ioDrMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
2151 else
2152 GetDateTime (&cipb.dirInfo.ioDrMdDat);
2154 else
2156 if (times)
2157 cipb.hFileInfo.ioFlMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
2158 else
2159 GetDateTime (&cipb.hFileInfo.ioFlMdDat);
2162 errno = PBSetCatInfo (&cipb, false);
2163 return errno == noErr ? 0 : -1;
2167 #ifndef F_OK
2168 #define F_OK 0
2169 #endif
2170 #ifndef X_OK
2171 #define X_OK 1
2172 #endif
2173 #ifndef W_OK
2174 #define W_OK 2
2175 #endif
2177 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
2179 access (const char *path, int mode)
2181 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2182 int len;
2183 char mac_pathname[MAXPATHLEN+1];
2184 CInfoPBRec cipb;
2186 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2187 return -1;
2189 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2190 if (len > -1)
2191 fully_resolved_name[len] = '\0';
2192 else
2193 strcpy (fully_resolved_name, true_pathname);
2195 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2196 return -1;
2198 c2pstr (mac_pathname);
2199 cipb.hFileInfo.ioNamePtr = mac_pathname;
2200 cipb.hFileInfo.ioVRefNum = 0;
2201 cipb.hFileInfo.ioDirID = 0;
2202 cipb.hFileInfo.ioFDirIndex = 0;
2203 /* set to 0 to get information about specific dir or file */
2205 errno = PBGetCatInfo (&cipb, false);
2206 if (errno != noErr)
2207 return -1;
2209 if (mode == F_OK) /* got this far, file exists */
2210 return 0;
2212 if (mode & X_OK)
2213 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* path refers to a directory */
2214 return 0;
2215 else
2217 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
2218 return 0;
2219 else
2220 return -1;
2223 if (mode & W_OK)
2224 return (cipb.hFileInfo.ioFlAttrib & 0x1) ? -1 : 0;
2225 /* don't allow if lock bit is on */
2227 return -1;
2231 #define DEV_NULL_FD 0x10000
2233 #undef open
2235 sys_open (const char *path, int oflag)
2237 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2238 int len;
2239 char mac_pathname[MAXPATHLEN+1];
2241 if (strcmp (path, "/dev/null") == 0)
2242 return DEV_NULL_FD; /* some bogus fd to be ignored in write */
2244 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2245 return -1;
2247 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2248 if (len > -1)
2249 fully_resolved_name[len] = '\0';
2250 else
2251 strcpy (fully_resolved_name, true_pathname);
2253 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2254 return -1;
2255 else
2257 #ifdef __MRC__
2258 int res = open (mac_pathname, oflag);
2259 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
2260 if (oflag & O_CREAT)
2261 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2262 return res;
2263 #else /* not __MRC__ */
2264 return open (mac_pathname, oflag);
2265 #endif /* not __MRC__ */
2270 #undef creat
2272 sys_creat (const char *path, mode_t mode)
2274 char true_pathname[MAXPATHLEN+1];
2275 int len;
2276 char mac_pathname[MAXPATHLEN+1];
2278 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2279 return -1;
2281 if (!posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1))
2282 return -1;
2283 else
2285 #ifdef __MRC__
2286 int result = creat (mac_pathname);
2287 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2288 return result;
2289 #else /* not __MRC__ */
2290 return creat (mac_pathname, mode);
2291 #endif /* not __MRC__ */
2296 #undef unlink
2298 sys_unlink (const char *path)
2300 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2301 int len;
2302 char mac_pathname[MAXPATHLEN+1];
2304 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2305 return -1;
2307 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2308 if (len > -1)
2309 fully_resolved_name[len] = '\0';
2310 else
2311 strcpy (fully_resolved_name, true_pathname);
2313 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2314 return -1;
2315 else
2316 return unlink (mac_pathname);
2320 #undef read
2322 sys_read (int fildes, char *buf, int count)
2324 if (fildes == 0) /* this should not be used for console input */
2325 return -1;
2326 else
2327 #if __MSL__ >= 0x6000
2328 return _read (fildes, buf, count);
2329 #else
2330 return read (fildes, buf, count);
2331 #endif
2335 #undef write
2337 sys_write (int fildes, const char *buf, int count)
2339 if (fildes == DEV_NULL_FD)
2340 return count;
2341 else
2342 #if __MSL__ >= 0x6000
2343 return _write (fildes, buf, count);
2344 #else
2345 return write (fildes, buf, count);
2346 #endif
2350 #undef rename
2352 sys_rename (const char * old_name, const char * new_name)
2354 char true_old_pathname[MAXPATHLEN+1], true_new_pathname[MAXPATHLEN+1];
2355 char fully_resolved_old_name[MAXPATHLEN+1];
2356 int len;
2357 char mac_old_name[MAXPATHLEN+1], mac_new_name[MAXPATHLEN+1];
2359 if (find_true_pathname (old_name, true_old_pathname, MAXPATHLEN+1) == -1)
2360 return -1;
2362 len = readlink (true_old_pathname, fully_resolved_old_name, MAXPATHLEN);
2363 if (len > -1)
2364 fully_resolved_old_name[len] = '\0';
2365 else
2366 strcpy (fully_resolved_old_name, true_old_pathname);
2368 if (find_true_pathname (new_name, true_new_pathname, MAXPATHLEN+1) == -1)
2369 return -1;
2371 if (strcmp (fully_resolved_old_name, true_new_pathname) == 0)
2372 return 0;
2374 if (!posix_to_mac_pathname (fully_resolved_old_name,
2375 mac_old_name,
2376 MAXPATHLEN+1))
2377 return -1;
2379 if (!posix_to_mac_pathname(true_new_pathname, mac_new_name, MAXPATHLEN+1))
2380 return -1;
2382 /* If a file with new_name already exists, rename deletes the old
2383 file in Unix. CW version fails in these situation. So we add a
2384 call to unlink here. */
2385 (void) unlink (mac_new_name);
2387 return rename (mac_old_name, mac_new_name);
2391 #undef fopen
2392 extern FILE *fopen (const char *name, const char *mode);
2393 FILE *
2394 sys_fopen (const char *name, const char *mode)
2396 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
2397 int len;
2398 char mac_pathname[MAXPATHLEN+1];
2400 if (find_true_pathname (name, true_pathname, MAXPATHLEN+1) == -1)
2401 return 0;
2403 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2404 if (len > -1)
2405 fully_resolved_name[len] = '\0';
2406 else
2407 strcpy (fully_resolved_name, true_pathname);
2409 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
2410 return 0;
2411 else
2413 #ifdef __MRC__
2414 if (mode[0] == 'w' || mode[0] == 'a')
2415 fsetfileinfo (mac_pathname, MAC_EMACS_CREATOR_CODE, 'TEXT');
2416 #endif /* not __MRC__ */
2417 return fopen (mac_pathname, mode);
2422 extern Boolean mac_wait_next_event P_ ((EventRecord *, UInt32, Boolean));
2425 select (nfds, rfds, wfds, efds, timeout)
2426 int nfds;
2427 SELECT_TYPE *rfds, *wfds, *efds;
2428 EMACS_TIME *timeout;
2430 OSStatus err = noErr;
2432 /* Can only handle wait for keyboard input. */
2433 if (nfds > 1 || wfds || efds)
2434 return -1;
2436 /* Try detect_input_pending before ReceiveNextEvent in the same
2437 BLOCK_INPUT block, in case that some input has already been read
2438 asynchronously. */
2439 BLOCK_INPUT;
2440 ENABLE_WAKEUP_FROM_RNE;
2441 if (!detect_input_pending ())
2443 #if TARGET_API_MAC_CARBON
2444 EventTimeout timeoutval =
2445 (timeout
2446 ? (EMACS_SECS (*timeout) * kEventDurationSecond
2447 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
2448 : kEventDurationForever);
2450 if (timeoutval == 0.0)
2451 err = eventLoopTimedOutErr;
2452 else
2453 err = ReceiveNextEvent (0, NULL, timeoutval,
2454 kEventLeaveInQueue, NULL);
2455 #else /* not TARGET_API_MAC_CARBON */
2456 EventRecord e;
2457 UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
2458 ((EMACS_USECS (*timeout) * 60) / 1000000);
2460 if (sleep_time == 0)
2461 err = -9875; /* eventLoopTimedOutErr */
2462 else
2464 if (mac_wait_next_event (&e, sleep_time, false))
2465 err = noErr;
2466 else
2467 err = -9875; /* eventLoopTimedOutErr */
2469 #endif /* not TARGET_API_MAC_CARBON */
2471 DISABLE_WAKEUP_FROM_RNE;
2472 UNBLOCK_INPUT;
2474 if (err == noErr)
2476 /* Pretend that `select' is interrupted by a signal. */
2477 detect_input_pending ();
2478 errno = EINTR;
2479 return -1;
2481 else
2483 if (rfds)
2484 FD_ZERO (rfds);
2485 return 0;
2490 /* Simulation of SIGALRM. The stub for function signal stores the
2491 signal handler function in alarm_signal_func if a SIGALRM is
2492 encountered. */
2494 #include <signal.h>
2495 #include "syssignal.h"
2497 static TMTask mac_atimer_task;
2499 static QElemPtr mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
2501 static int signal_mask = 0;
2503 #ifdef __MRC__
2504 __sigfun alarm_signal_func = (__sigfun) 0;
2505 #elif __MWERKS__
2506 __signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0;
2507 #else /* not __MRC__ and not __MWERKS__ */
2508 You lose!!!
2509 #endif /* not __MRC__ and not __MWERKS__ */
2511 #undef signal
2512 #ifdef __MRC__
2513 extern __sigfun signal (int signal, __sigfun signal_func);
2514 __sigfun
2515 sys_signal (int signal_num, __sigfun signal_func)
2516 #elif __MWERKS__
2517 extern __signal_func_ptr signal (int signal, __signal_func_ptr signal_func);
2518 __signal_func_ptr
2519 sys_signal (int signal_num, __signal_func_ptr signal_func)
2520 #else /* not __MRC__ and not __MWERKS__ */
2521 You lose!!!
2522 #endif /* not __MRC__ and not __MWERKS__ */
2524 if (signal_num != SIGALRM)
2525 return signal (signal_num, signal_func);
2526 else
2528 #ifdef __MRC__
2529 __sigfun old_signal_func;
2530 #elif __MWERKS__
2531 __signal_func_ptr old_signal_func;
2532 #else
2533 You lose!!!
2534 #endif
2535 old_signal_func = alarm_signal_func;
2536 alarm_signal_func = signal_func;
2537 return old_signal_func;
2542 static pascal void
2543 mac_atimer_handler (qlink)
2544 TMTaskPtr qlink;
2546 if (alarm_signal_func)
2547 (alarm_signal_func) (SIGALRM);
2551 static void
2552 set_mac_atimer (count)
2553 long count;
2555 static TimerUPP mac_atimer_handlerUPP = NULL;
2557 if (mac_atimer_handlerUPP == NULL)
2558 mac_atimer_handlerUPP = NewTimerUPP (mac_atimer_handler);
2559 mac_atimer_task.tmCount = 0;
2560 mac_atimer_task.tmAddr = mac_atimer_handlerUPP;
2561 mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
2562 InsTime (mac_atimer_qlink);
2563 if (count)
2564 PrimeTime (mac_atimer_qlink, count);
2569 remove_mac_atimer (remaining_count)
2570 long *remaining_count;
2572 if (mac_atimer_qlink)
2574 RmvTime (mac_atimer_qlink);
2575 if (remaining_count)
2576 *remaining_count = mac_atimer_task.tmCount;
2577 mac_atimer_qlink = NULL;
2579 return 0;
2581 else
2582 return -1;
2587 sigblock (int mask)
2589 int old_mask = signal_mask;
2591 signal_mask |= mask;
2593 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2594 remove_mac_atimer (NULL);
2596 return old_mask;
2601 sigsetmask (int mask)
2603 int old_mask = signal_mask;
2605 signal_mask = mask;
2607 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2608 if (signal_mask & sigmask (SIGALRM))
2609 remove_mac_atimer (NULL);
2610 else
2611 set_mac_atimer (mac_atimer_task.tmCount);
2613 return old_mask;
2618 alarm (int seconds)
2620 long remaining_count;
2622 if (remove_mac_atimer (&remaining_count) == 0)
2624 set_mac_atimer (seconds * 1000);
2626 return remaining_count / 1000;
2628 else
2630 mac_atimer_task.tmCount = seconds * 1000;
2632 return 0;
2638 setitimer (which, value, ovalue)
2639 int which;
2640 const struct itimerval *value;
2641 struct itimerval *ovalue;
2643 long remaining_count;
2644 long count = (EMACS_SECS (value->it_value) * 1000
2645 + (EMACS_USECS (value->it_value) + 999) / 1000);
2647 if (remove_mac_atimer (&remaining_count) == 0)
2649 if (ovalue)
2651 bzero (ovalue, sizeof (*ovalue));
2652 EMACS_SET_SECS_USECS (ovalue->it_value, remaining_count / 1000,
2653 (remaining_count % 1000) * 1000);
2655 set_mac_atimer (count);
2657 else
2658 mac_atimer_task.tmCount = count;
2660 return 0;
2664 /* gettimeofday should return the amount of time (in a timeval
2665 structure) since midnight today. The toolbox function Microseconds
2666 returns the number of microseconds (in a UnsignedWide value) since
2667 the machine was booted. Also making this complicated is WideAdd,
2668 WideSubtract, etc. take wide values. */
2671 gettimeofday (tp)
2672 struct timeval *tp;
2674 static inited = 0;
2675 static wide wall_clock_at_epoch, clicks_at_epoch;
2676 UnsignedWide uw_microseconds;
2677 wide w_microseconds;
2678 time_t sys_time (time_t *);
2680 /* If this function is called for the first time, record the number
2681 of seconds since midnight and the number of microseconds since
2682 boot at the time of this first call. */
2683 if (!inited)
2685 time_t systime;
2686 inited = 1;
2687 systime = sys_time (NULL);
2688 /* Store microseconds since midnight in wall_clock_at_epoch. */
2689 WideMultiply (systime, 1000000L, &wall_clock_at_epoch);
2690 Microseconds (&uw_microseconds);
2691 /* Store microseconds since boot in clicks_at_epoch. */
2692 clicks_at_epoch.hi = uw_microseconds.hi;
2693 clicks_at_epoch.lo = uw_microseconds.lo;
2696 /* Get time since boot */
2697 Microseconds (&uw_microseconds);
2699 /* Convert to time since midnight*/
2700 w_microseconds.hi = uw_microseconds.hi;
2701 w_microseconds.lo = uw_microseconds.lo;
2702 WideSubtract (&w_microseconds, &clicks_at_epoch);
2703 WideAdd (&w_microseconds, &wall_clock_at_epoch);
2704 tp->tv_sec = WideDivide (&w_microseconds, 1000000L, &tp->tv_usec);
2706 return 0;
2710 #ifdef __MRC__
2711 unsigned int
2712 sleep (unsigned int seconds)
2714 unsigned long time_up;
2715 EventRecord e;
2717 time_up = TickCount () + seconds * 60;
2718 while (TickCount () < time_up)
2720 /* Accept no event; just wait. by T.I. */
2721 WaitNextEvent (0, &e, 30, NULL);
2724 return (0);
2726 #endif /* __MRC__ */
2729 /* The time functions adjust time values according to the difference
2730 between the Unix and CW epoches. */
2732 #undef gmtime
2733 extern struct tm *gmtime (const time_t *);
2734 struct tm *
2735 sys_gmtime (const time_t *timer)
2737 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2739 return gmtime (&unix_time);
2743 #undef localtime
2744 extern struct tm *localtime (const time_t *);
2745 struct tm *
2746 sys_localtime (const time_t *timer)
2748 #if __MSL__ >= 0x6000
2749 time_t unix_time = *timer;
2750 #else
2751 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2752 #endif
2754 return localtime (&unix_time);
2758 #undef ctime
2759 extern char *ctime (const time_t *);
2760 char *
2761 sys_ctime (const time_t *timer)
2763 #if __MSL__ >= 0x6000
2764 time_t unix_time = *timer;
2765 #else
2766 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2767 #endif
2769 return ctime (&unix_time);
2773 #undef time
2774 extern time_t time (time_t *);
2775 time_t
2776 sys_time (time_t *timer)
2778 #if __MSL__ >= 0x6000
2779 time_t mac_time = time (NULL);
2780 #else
2781 time_t mac_time = time (NULL) - CW_OR_MPW_UNIX_EPOCH_DIFF;
2782 #endif
2784 if (timer)
2785 *timer = mac_time;
2787 return mac_time;
2791 /* no subprocesses, empty wait */
2794 wait (int pid)
2796 return 0;
2800 void
2801 croak (char *badfunc)
2803 printf ("%s not yet implemented\r\n", badfunc);
2804 exit (1);
2808 char *
2809 mktemp (char *template)
2811 int len, k;
2812 static seqnum = 0;
2814 len = strlen (template);
2815 k = len - 1;
2816 while (k >= 0 && template[k] == 'X')
2817 k--;
2819 k++; /* make k index of first 'X' */
2821 if (k < len)
2823 /* Zero filled, number of digits equal to the number of X's. */
2824 sprintf (&template[k], "%0*d", len-k, seqnum++);
2826 return template;
2828 else
2829 return 0;
2833 /* Emulate getpwuid, getpwnam and others. */
2835 #define PASSWD_FIELD_SIZE 256
2837 static char my_passwd_name[PASSWD_FIELD_SIZE];
2838 static char my_passwd_dir[MAXPATHLEN+1];
2840 static struct passwd my_passwd =
2842 my_passwd_name,
2843 my_passwd_dir,
2846 static struct group my_group =
2848 /* There are no groups on the mac, so we just return "root" as the
2849 group name. */
2850 "root",
2854 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2856 char emacs_passwd_dir[MAXPATHLEN+1];
2858 char *
2859 getwd (char *);
2861 void
2862 init_emacs_passwd_dir ()
2864 int found = false;
2866 if (getwd (emacs_passwd_dir) && getwd (my_passwd_dir))
2868 /* Need pathname of first ancestor that begins with "emacs"
2869 since Mac emacs application is somewhere in the emacs-*
2870 tree. */
2871 int len = strlen (emacs_passwd_dir);
2872 int j = len - 1;
2873 /* j points to the "/" following the directory name being
2874 compared. */
2875 int i = j - 1;
2876 while (i >= 0 && !found)
2878 while (i >= 0 && emacs_passwd_dir[i] != '/')
2879 i--;
2880 if (emacs_passwd_dir[i] == '/' && i+5 < len)
2881 found = (strncmp (&(emacs_passwd_dir[i+1]), "emacs", 5) == 0);
2882 if (found)
2883 emacs_passwd_dir[j+1] = '\0';
2884 else
2886 j = i;
2887 i = j - 1;
2892 if (!found)
2894 /* Setting to "/" probably won't work but set it to something
2895 anyway. */
2896 strcpy (emacs_passwd_dir, "/");
2897 strcpy (my_passwd_dir, "/");
2902 static struct passwd emacs_passwd =
2904 "emacs",
2905 emacs_passwd_dir,
2908 static int my_passwd_inited = 0;
2911 static void
2912 init_my_passwd ()
2914 char **owner_name;
2916 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2917 directory where Emacs was started. */
2919 owner_name = (char **) GetResource ('STR ',-16096);
2920 if (owner_name)
2922 HLock (owner_name);
2923 BlockMove ((unsigned char *) *owner_name,
2924 (unsigned char *) my_passwd_name,
2925 *owner_name[0]+1);
2926 HUnlock (owner_name);
2927 p2cstr ((unsigned char *) my_passwd_name);
2929 else
2930 my_passwd_name[0] = 0;
2934 struct passwd *
2935 getpwuid (uid_t uid)
2937 if (!my_passwd_inited)
2939 init_my_passwd ();
2940 my_passwd_inited = 1;
2943 return &my_passwd;
2947 struct group *
2948 getgrgid (gid_t gid)
2950 return &my_group;
2954 struct passwd *
2955 getpwnam (const char *name)
2957 if (strcmp (name, "emacs") == 0)
2958 return &emacs_passwd;
2960 if (!my_passwd_inited)
2962 init_my_passwd ();
2963 my_passwd_inited = 1;
2966 return &my_passwd;
2970 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2971 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2972 as in msdos.c. */
2976 fork ()
2978 return -1;
2983 kill (int x, int y)
2985 return -1;
2989 void
2990 sys_subshell ()
2992 error ("Can't spawn subshell");
2996 void
2997 request_sigio (void)
3002 void
3003 unrequest_sigio (void)
3009 setpgrp ()
3011 return 0;
3015 /* No pipes yet. */
3018 pipe (int _fildes[2])
3020 errno = EACCES;
3021 return -1;
3025 /* Hard and symbolic links. */
3028 symlink (const char *name1, const char *name2)
3030 errno = ENOENT;
3031 return -1;
3036 link (const char *name1, const char *name2)
3038 errno = ENOENT;
3039 return -1;
3042 #endif /* ! MAC_OSX */
3044 /* Determine the path name of the file specified by VREFNUM, DIRID,
3045 and NAME and place that in the buffer PATH of length
3046 MAXPATHLEN. */
3047 static int
3048 path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num,
3049 long dir_id, ConstStr255Param name)
3051 Str255 dir_name;
3052 CInfoPBRec cipb;
3053 OSErr err;
3055 if (strlen (name) > man_path_len)
3056 return 0;
3058 memcpy (dir_name, name, name[0]+1);
3059 memcpy (path, name, name[0]+1);
3060 p2cstr (path);
3062 cipb.dirInfo.ioDrParID = dir_id;
3063 cipb.dirInfo.ioNamePtr = dir_name;
3067 cipb.dirInfo.ioVRefNum = vol_ref_num;
3068 cipb.dirInfo.ioFDirIndex = -1;
3069 cipb.dirInfo.ioDrDirID = cipb.dirInfo.ioDrParID;
3070 /* go up to parent each time */
3072 err = PBGetCatInfo (&cipb, false);
3073 if (err != noErr)
3074 return 0;
3076 p2cstr (dir_name);
3077 if (strlen (dir_name) + strlen (path) + 1 >= man_path_len)
3078 return 0;
3080 strcat (dir_name, ":");
3081 strcat (dir_name, path);
3082 /* attach to front since we're going up directory tree */
3083 strcpy (path, dir_name);
3085 while (cipb.dirInfo.ioDrDirID != fsRtDirID);
3086 /* stop when we see the volume's root directory */
3088 return 1; /* success */
3092 #ifndef MAC_OSX
3094 static OSErr
3095 posix_pathname_to_fsspec (ufn, fs)
3096 const char *ufn;
3097 FSSpec *fs;
3099 Str255 mac_pathname;
3101 if (posix_to_mac_pathname (ufn, mac_pathname, sizeof (mac_pathname)) == 0)
3102 return fnfErr;
3103 else
3105 c2pstr (mac_pathname);
3106 return FSMakeFSSpec (0, 0, mac_pathname, fs);
3110 static OSErr
3111 fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
3112 const FSSpec *fs;
3113 char *ufn;
3114 int ufnbuflen;
3116 char mac_pathname[MAXPATHLEN];
3118 if (path_from_vol_dir_name (mac_pathname, sizeof (mac_pathname) - 1,
3119 fs->vRefNum, fs->parID, fs->name)
3120 && mac_to_posix_pathname (mac_pathname, ufn, ufnbuflen))
3121 return noErr;
3122 else
3123 return fnfErr;
3127 readlink (const char *path, char *buf, int bufsiz)
3129 char mac_sym_link_name[MAXPATHLEN+1];
3130 OSErr err;
3131 FSSpec fsspec;
3132 Boolean target_is_folder, was_aliased;
3133 Str255 directory_name, mac_pathname;
3134 CInfoPBRec cipb;
3136 if (posix_to_mac_pathname (path, mac_sym_link_name, MAXPATHLEN+1) == 0)
3137 return -1;
3139 c2pstr (mac_sym_link_name);
3140 err = FSMakeFSSpec (0, 0, mac_sym_link_name, &fsspec);
3141 if (err != noErr)
3143 errno = ENOENT;
3144 return -1;
3147 err = ResolveAliasFile (&fsspec, true, &target_is_folder, &was_aliased);
3148 if (err != noErr || !was_aliased)
3150 errno = ENOENT;
3151 return -1;
3154 if (path_from_vol_dir_name (mac_pathname, 255, fsspec.vRefNum, fsspec.parID,
3155 fsspec.name) == 0)
3157 errno = ENOENT;
3158 return -1;
3161 if (mac_to_posix_pathname (mac_pathname, buf, bufsiz) == 0)
3163 errno = ENOENT;
3164 return -1;
3167 return strlen (buf);
3171 /* Convert a path to one with aliases fully expanded. */
3173 static int
3174 find_true_pathname (const char *path, char *buf, int bufsiz)
3176 char *q, temp[MAXPATHLEN+1];
3177 const char *p;
3178 int len;
3180 if (bufsiz <= 0 || path == 0 || path[0] == '\0')
3181 return -1;
3183 buf[0] = '\0';
3185 p = path;
3186 if (*p == '/')
3187 q = strchr (p + 1, '/');
3188 else
3189 q = strchr (p, '/');
3190 len = 0; /* loop may not be entered, e.g., for "/" */
3192 while (q)
3194 strcpy (temp, buf);
3195 strncat (temp, p, q - p);
3196 len = readlink (temp, buf, bufsiz);
3197 if (len <= -1)
3199 if (strlen (temp) + 1 > bufsiz)
3200 return -1;
3201 strcpy (buf, temp);
3203 strcat (buf, "/");
3204 len++;
3205 p = q + 1;
3206 q = strchr(p, '/');
3209 if (len + strlen (p) + 1 >= bufsiz)
3210 return -1;
3212 strcat (buf, p);
3213 return len + strlen (p);
3217 mode_t
3218 umask (mode_t numask)
3220 static mode_t mask = 022;
3221 mode_t oldmask = mask;
3222 mask = numask;
3223 return oldmask;
3228 chmod (const char *path, mode_t mode)
3230 /* say it always succeed for now */
3231 return 0;
3236 fchmod (int fd, mode_t mode)
3238 /* say it always succeed for now */
3239 return 0;
3244 fchown (int fd, uid_t owner, gid_t group)
3246 /* say it always succeed for now */
3247 return 0;
3252 dup (int oldd)
3254 #ifdef __MRC__
3255 return fcntl (oldd, F_DUPFD, 0);
3256 #elif __MWERKS__
3257 /* current implementation of fcntl in fcntl.mac.c simply returns old
3258 descriptor */
3259 return fcntl (oldd, F_DUPFD);
3260 #else
3261 You lose!!!
3262 #endif
3266 /* This is from the original sysdep.c. Emulate BSD dup2. First close
3267 newd if it already exists. Then, attempt to dup oldd. If not
3268 successful, call dup2 recursively until we are, then close the
3269 unsuccessful ones. */
3272 dup2 (int oldd, int newd)
3274 int fd, ret;
3276 close (newd);
3278 fd = dup (oldd);
3279 if (fd == -1)
3280 return -1;
3281 if (fd == newd)
3282 return newd;
3283 ret = dup2 (oldd, newd);
3284 close (fd);
3285 return ret;
3289 /* let it fail for now */
3291 char *
3292 sbrk (int incr)
3294 return (char *) -1;
3299 fsync (int fd)
3301 return 0;
3306 ioctl (int d, int request, void *argp)
3308 return -1;
3312 #ifdef __MRC__
3314 isatty (int fildes)
3316 if (fildes >=0 && fildes <= 2)
3317 return 1;
3318 else
3319 return 0;
3324 getgid ()
3326 return 100;
3331 getegid ()
3333 return 100;
3338 getuid ()
3340 return 200;
3345 geteuid ()
3347 return 200;
3349 #endif /* __MRC__ */
3352 #ifdef __MWERKS__
3353 #if __MSL__ < 0x6000
3354 #undef getpid
3356 getpid ()
3358 return 9999;
3360 #endif
3361 #endif /* __MWERKS__ */
3363 #endif /* ! MAC_OSX */
3366 /* Return the path to the directory in which Emacs can create
3367 temporary files. The MacOS "temporary items" directory cannot be
3368 used because it removes the file written by a process when it
3369 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3370 again not exactly). And of course Emacs needs to read back the
3371 files written by its subprocesses. So here we write the files to a
3372 directory "Emacs" in the Preferences Folder. This directory is
3373 created if it does not exist. */
3375 char *
3376 get_temp_dir_name ()
3378 static char *temp_dir_name = NULL;
3379 short vol_ref_num;
3380 long dir_id;
3381 OSErr err;
3382 Str255 full_path;
3383 char unix_dir_name[MAXPATHLEN+1];
3384 DIR *dir;
3386 /* Cache directory name with pointer temp_dir_name.
3387 Look for it only the first time. */
3388 if (!temp_dir_name)
3390 err = FindFolder (kOnSystemDisk, kPreferencesFolderType, kCreateFolder,
3391 &vol_ref_num, &dir_id);
3392 if (err != noErr)
3393 return NULL;
3395 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3396 return NULL;
3398 if (strlen (full_path) + 6 <= MAXPATHLEN)
3399 strcat (full_path, "Emacs:");
3400 else
3401 return NULL;
3403 if (!mac_to_posix_pathname (full_path, unix_dir_name, MAXPATHLEN+1))
3404 return NULL;
3406 dir = opendir (unix_dir_name); /* check whether temp directory exists */
3407 if (dir)
3408 closedir (dir);
3409 else if (mkdir (unix_dir_name, 0700) != 0) /* create it if not */
3410 return NULL;
3412 temp_dir_name = (char *) malloc (strlen (unix_dir_name) + 1);
3413 strcpy (temp_dir_name, unix_dir_name);
3416 return temp_dir_name;
3419 #ifndef MAC_OSX
3421 /* Allocate and construct an array of pointers to strings from a list
3422 of strings stored in a 'STR#' resource. The returned pointer array
3423 is stored in the style of argv and environ: if the 'STR#' resource
3424 contains numString strings, a pointer array with numString+1
3425 elements is returned in which the last entry contains a null
3426 pointer. The pointer to the pointer array is passed by pointer in
3427 parameter t. The resource ID of the 'STR#' resource is passed in
3428 parameter StringListID.
3431 void
3432 get_string_list (char ***t, short string_list_id)
3434 Handle h;
3435 Ptr p;
3436 int i, num_strings;
3438 h = GetResource ('STR#', string_list_id);
3439 if (h)
3441 HLock (h);
3442 p = *h;
3443 num_strings = * (short *) p;
3444 p += sizeof(short);
3445 *t = (char **) malloc (sizeof (char *) * (num_strings + 1));
3446 for (i = 0; i < num_strings; i++)
3448 short length = *p++;
3449 (*t)[i] = (char *) malloc (length + 1);
3450 strncpy ((*t)[i], p, length);
3451 (*t)[i][length] = '\0';
3452 p += length;
3454 (*t)[num_strings] = 0;
3455 HUnlock (h);
3457 else
3459 /* Return no string in case GetResource fails. Bug fixed by
3460 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3461 option (no sym -on implies -opt local). */
3462 *t = (char **) malloc (sizeof (char *));
3463 (*t)[0] = 0;
3468 static char *
3469 get_path_to_system_folder ()
3471 short vol_ref_num;
3472 long dir_id;
3473 OSErr err;
3474 Str255 full_path;
3475 static char system_folder_unix_name[MAXPATHLEN+1];
3476 DIR *dir;
3478 err = FindFolder (kOnSystemDisk, kSystemFolderType, kDontCreateFolder,
3479 &vol_ref_num, &dir_id);
3480 if (err != noErr)
3481 return NULL;
3483 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3484 return NULL;
3486 if (!mac_to_posix_pathname (full_path, system_folder_unix_name,
3487 MAXPATHLEN+1))
3488 return NULL;
3490 return system_folder_unix_name;
3494 char **environ;
3496 #define ENVIRON_STRING_LIST_ID 128
3498 /* Get environment variable definitions from STR# resource. */
3500 void
3501 init_environ ()
3503 int i;
3505 get_string_list (&environ, ENVIRON_STRING_LIST_ID);
3507 i = 0;
3508 while (environ[i])
3509 i++;
3511 /* Make HOME directory the one Emacs starts up in if not specified
3512 by resource. */
3513 if (getenv ("HOME") == NULL)
3515 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3516 if (environ)
3518 environ[i] = (char *) malloc (strlen (my_passwd_dir) + 6);
3519 if (environ[i])
3521 strcpy (environ[i], "HOME=");
3522 strcat (environ[i], my_passwd_dir);
3524 environ[i+1] = 0;
3525 i++;
3529 /* Make HOME directory the one Emacs starts up in if not specified
3530 by resource. */
3531 if (getenv ("MAIL") == NULL)
3533 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3534 if (environ)
3536 char * path_to_system_folder = get_path_to_system_folder ();
3537 environ[i] = (char *) malloc (strlen (path_to_system_folder) + 22);
3538 if (environ[i])
3540 strcpy (environ[i], "MAIL=");
3541 strcat (environ[i], path_to_system_folder);
3542 strcat (environ[i], "Eudora Folder/In");
3544 environ[i+1] = 0;
3550 /* Return the value of the environment variable NAME. */
3552 char *
3553 getenv (const char *name)
3555 int length = strlen(name);
3556 char **e;
3558 for (e = environ; *e != 0; e++)
3559 if (strncmp(*e, name, length) == 0 && (*e)[length] == '=')
3560 return &(*e)[length + 1];
3562 if (strcmp (name, "TMPDIR") == 0)
3563 return get_temp_dir_name ();
3565 return 0;
3569 #ifdef __MRC__
3570 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3571 char *sys_siglist[] =
3573 "Zero is not a signal!!!",
3574 "Abort", /* 1 */
3575 "Interactive user interrupt", /* 2 */ "?",
3576 "Floating point exception", /* 4 */ "?", "?", "?",
3577 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3578 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3579 "?", "?", "?", "?", "?", "?", "?", "?",
3580 "Terminal" /* 32 */
3582 #elif __MWERKS__
3583 char *sys_siglist[] =
3585 "Zero is not a signal!!!",
3586 "Abort",
3587 "Floating point exception",
3588 "Illegal instruction",
3589 "Interactive user interrupt",
3590 "Segment violation",
3591 "Terminal"
3593 #else /* not __MRC__ and not __MWERKS__ */
3594 You lose!!!
3595 #endif /* not __MRC__ and not __MWERKS__ */
3598 #include <utsname.h>
3601 uname (struct utsname *name)
3603 char **system_name;
3604 system_name = GetString (-16413); /* IM - Resource Manager Reference */
3605 if (system_name)
3607 BlockMove (*system_name, name->nodename, (*system_name)[0]+1);
3608 p2cstr (name->nodename);
3609 return 0;
3611 else
3612 return -1;
3616 /* Event class of HLE sent to subprocess. */
3617 const OSType kEmacsSubprocessSend = 'ESND';
3619 /* Event class of HLE sent back from subprocess. */
3620 const OSType kEmacsSubprocessReply = 'ERPY';
3623 char *
3624 mystrchr (char *s, char c)
3626 while (*s && *s != c)
3628 if (*s == '\\')
3629 s++;
3630 s++;
3633 if (*s)
3635 *s = '\0';
3636 return s;
3638 else
3639 return NULL;
3643 char *
3644 mystrtok (char *s)
3646 while (*s)
3647 s++;
3649 return s + 1;
3653 void
3654 mystrcpy (char *to, char *from)
3656 while (*from)
3658 if (*from == '\\')
3659 from++;
3660 *to++ = *from++;
3662 *to = '\0';
3666 /* Start a Mac subprocess. Arguments for it is passed in argv (null
3667 terminated). The process should run with the default directory
3668 "workdir", read input from "infn", and write output and error to
3669 "outfn" and "errfn", resp. The Process Manager call
3670 LaunchApplication is used to start the subprocess. We use high
3671 level events as the mechanism to pass arguments to the subprocess
3672 and to make Emacs wait for the subprocess to terminate and pass
3673 back a result code. The bulk of the code here packs the arguments
3674 into one message to be passed together with the high level event.
3675 Emacs also sometimes starts a subprocess using a shell to perform
3676 wildcard filename expansion. Since we don't really have a shell on
3677 the Mac, this case is detected and the starting of the shell is
3678 by-passed. We really need to add code here to do filename
3679 expansion to support such functionality.
3681 We can't use this strategy in Carbon because the High Level Event
3682 APIs are not available. */
3685 run_mac_command (argv, workdir, infn, outfn, errfn)
3686 unsigned char **argv;
3687 const char *workdir;
3688 const char *infn, *outfn, *errfn;
3690 #if TARGET_API_MAC_CARBON
3691 return -1;
3692 #else /* not TARGET_API_MAC_CARBON */
3693 char macappname[MAXPATHLEN+1], macworkdir[MAXPATHLEN+1];
3694 char macinfn[MAXPATHLEN+1], macoutfn[MAXPATHLEN+1], macerrfn[MAXPATHLEN+1];
3695 int paramlen, argc, newargc, j, retries;
3696 char **newargv, *param, *p;
3697 OSErr iErr;
3698 FSSpec spec;
3699 LaunchParamBlockRec lpbr;
3700 EventRecord send_event, reply_event;
3701 RgnHandle cursor_region_handle;
3702 TargetID targ;
3703 unsigned long ref_con, len;
3705 if (posix_to_mac_pathname (workdir, macworkdir, MAXPATHLEN+1) == 0)
3706 return -1;
3707 if (posix_to_mac_pathname (infn, macinfn, MAXPATHLEN+1) == 0)
3708 return -1;
3709 if (posix_to_mac_pathname (outfn, macoutfn, MAXPATHLEN+1) == 0)
3710 return -1;
3711 if (posix_to_mac_pathname (errfn, macerrfn, MAXPATHLEN+1) == 0)
3712 return -1;
3714 paramlen = strlen (macworkdir) + strlen (macinfn) + strlen (macoutfn)
3715 + strlen (macerrfn) + 4; /* count nulls at end of strings */
3717 argc = 0;
3718 while (argv[argc])
3719 argc++;
3721 if (argc == 0)
3722 return -1;
3724 /* If a subprocess is invoked with a shell, we receive 3 arguments
3725 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3726 bins>/<command> <command args>" */
3727 j = strlen (argv[0]);
3728 if (j >= 3 && strcmp (argv[0]+j-3, "/sh") == 0
3729 && argc == 3 && strcmp (argv[1], "-c") == 0)
3731 char *command, *t, tempmacpathname[MAXPATHLEN+1];
3733 /* The arguments for the command in argv[2] are separated by
3734 spaces. Count them and put the count in newargc. */
3735 command = (char *) alloca (strlen (argv[2])+2);
3736 strcpy (command, argv[2]);
3737 if (command[strlen (command) - 1] != ' ')
3738 strcat (command, " ");
3740 t = command;
3741 newargc = 0;
3742 t = mystrchr (t, ' ');
3743 while (t)
3745 newargc++;
3746 t = mystrchr (t+1, ' ');
3749 newargv = (char **) alloca (sizeof (char *) * newargc);
3751 t = command;
3752 for (j = 0; j < newargc; j++)
3754 newargv[j] = (char *) alloca (strlen (t) + 1);
3755 mystrcpy (newargv[j], t);
3757 t = mystrtok (t);
3758 paramlen += strlen (newargv[j]) + 1;
3761 if (strncmp (newargv[0], "~emacs/", 7) == 0)
3763 if (posix_to_mac_pathname (newargv[0], tempmacpathname, MAXPATHLEN+1)
3764 == 0)
3765 return -1;
3767 else
3768 { /* sometimes Emacs call "sh" without a path for the command */
3769 #if 0
3770 char *t = (char *) alloca (strlen (newargv[0]) + 7 + 1);
3771 strcpy (t, "~emacs/");
3772 strcat (t, newargv[0]);
3773 #endif /* 0 */
3774 Lisp_Object path;
3775 openp (Vexec_path, build_string (newargv[0]), Vexec_suffixes, &path,
3776 make_number (X_OK));
3778 if (NILP (path))
3779 return -1;
3780 if (posix_to_mac_pathname (SDATA (path), tempmacpathname,
3781 MAXPATHLEN+1) == 0)
3782 return -1;
3784 strcpy (macappname, tempmacpathname);
3786 else
3788 if (posix_to_mac_pathname (argv[0], macappname, MAXPATHLEN+1) == 0)
3789 return -1;
3791 newargv = (char **) alloca (sizeof (char *) * argc);
3792 newargc = argc;
3793 for (j = 1; j < argc; j++)
3795 if (strncmp (argv[j], "~emacs/", 7) == 0)
3797 char *t = strchr (argv[j], ' ');
3798 if (t)
3800 char tempcmdname[MAXPATHLEN+1], tempmaccmdname[MAXPATHLEN+1];
3801 strncpy (tempcmdname, argv[j], t-argv[j]);
3802 tempcmdname[t-argv[j]] = '\0';
3803 if (posix_to_mac_pathname (tempcmdname, tempmaccmdname,
3804 MAXPATHLEN+1) == 0)
3805 return -1;
3806 newargv[j] = (char *) alloca (strlen (tempmaccmdname)
3807 + strlen (t) + 1);
3808 strcpy (newargv[j], tempmaccmdname);
3809 strcat (newargv[j], t);
3811 else
3813 char tempmaccmdname[MAXPATHLEN+1];
3814 if (posix_to_mac_pathname (argv[j], tempmaccmdname,
3815 MAXPATHLEN+1) == 0)
3816 return -1;
3817 newargv[j] = (char *) alloca (strlen (tempmaccmdname)+1);
3818 strcpy (newargv[j], tempmaccmdname);
3821 else
3822 newargv[j] = argv[j];
3823 paramlen += strlen (newargv[j]) + 1;
3827 /* After expanding all the arguments, we now know the length of the
3828 parameter block to be sent to the subprocess as a message
3829 attached to the HLE. */
3830 param = (char *) malloc (paramlen + 1);
3831 if (!param)
3832 return -1;
3834 p = param;
3835 *p++ = newargc;
3836 /* first byte of message contains number of arguments for command */
3837 strcpy (p, macworkdir);
3838 p += strlen (macworkdir);
3839 *p++ = '\0';
3840 /* null terminate strings sent so it's possible to use strcpy over there */
3841 strcpy (p, macinfn);
3842 p += strlen (macinfn);
3843 *p++ = '\0';
3844 strcpy (p, macoutfn);
3845 p += strlen (macoutfn);
3846 *p++ = '\0';
3847 strcpy (p, macerrfn);
3848 p += strlen (macerrfn);
3849 *p++ = '\0';
3850 for (j = 1; j < newargc; j++)
3852 strcpy (p, newargv[j]);
3853 p += strlen (newargv[j]);
3854 *p++ = '\0';
3857 c2pstr (macappname);
3859 iErr = FSMakeFSSpec (0, 0, macappname, &spec);
3861 if (iErr != noErr)
3863 free (param);
3864 return -1;
3867 lpbr.launchBlockID = extendedBlock;
3868 lpbr.launchEPBLength = extendedBlockLen;
3869 lpbr.launchControlFlags = launchContinue + launchNoFileFlags;
3870 lpbr.launchAppSpec = &spec;
3871 lpbr.launchAppParameters = NULL;
3873 iErr = LaunchApplication (&lpbr); /* call the subprocess */
3874 if (iErr != noErr)
3876 free (param);
3877 return -1;
3880 send_event.what = kHighLevelEvent;
3881 send_event.message = kEmacsSubprocessSend;
3882 /* Event ID stored in "where" unused */
3884 retries = 3;
3885 /* OS may think current subprocess has terminated if previous one
3886 terminated recently. */
3889 iErr = PostHighLevelEvent (&send_event, &lpbr.launchProcessSN, 0, param,
3890 paramlen + 1, receiverIDisPSN);
3892 while (iErr == sessClosedErr && retries-- > 0);
3894 if (iErr != noErr)
3896 free (param);
3897 return -1;
3900 cursor_region_handle = NewRgn ();
3902 /* Wait for the subprocess to finish, when it will send us a ERPY
3903 high level event. */
3904 while (1)
3905 if (WaitNextEvent (highLevelEventMask, &reply_event, 180,
3906 cursor_region_handle)
3907 && reply_event.message == kEmacsSubprocessReply)
3908 break;
3910 /* The return code is sent through the refCon */
3911 iErr = AcceptHighLevelEvent (&targ, &ref_con, NULL, &len);
3912 if (iErr != noErr)
3914 DisposeHandle ((Handle) cursor_region_handle);
3915 free (param);
3916 return -1;
3919 DisposeHandle ((Handle) cursor_region_handle);
3920 free (param);
3922 return ref_con;
3923 #endif /* not TARGET_API_MAC_CARBON */
3927 DIR *
3928 opendir (const char *dirname)
3930 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
3931 char mac_pathname[MAXPATHLEN+1], vol_name[MAXPATHLEN+1];
3932 DIR *dirp;
3933 CInfoPBRec cipb;
3934 HVolumeParam vpb;
3935 int len, vol_name_len;
3937 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
3938 return 0;
3940 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
3941 if (len > -1)
3942 fully_resolved_name[len] = '\0';
3943 else
3944 strcpy (fully_resolved_name, true_pathname);
3946 dirp = (DIR *) malloc (sizeof(DIR));
3947 if (!dirp)
3948 return 0;
3950 /* Handle special case when dirname is "/": sets up for readir to
3951 get all mount volumes. */
3952 if (strcmp (fully_resolved_name, "/") == 0)
3954 dirp->getting_volumes = 1; /* special all mounted volumes DIR struct */
3955 dirp->current_index = 1; /* index for first volume */
3956 return dirp;
3959 /* Handle typical cases: not accessing all mounted volumes. */
3960 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
3961 return 0;
3963 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3964 len = strlen (mac_pathname);
3965 if (mac_pathname[len - 1] != ':' && len < MAXPATHLEN)
3966 strcat (mac_pathname, ":");
3968 /* Extract volume name */
3969 vol_name_len = strchr (mac_pathname, ':') - mac_pathname;
3970 strncpy (vol_name, mac_pathname, vol_name_len);
3971 vol_name[vol_name_len] = '\0';
3972 strcat (vol_name, ":");
3974 c2pstr (mac_pathname);
3975 cipb.hFileInfo.ioNamePtr = mac_pathname;
3976 /* using full pathname so vRefNum and DirID ignored */
3977 cipb.hFileInfo.ioVRefNum = 0;
3978 cipb.hFileInfo.ioDirID = 0;
3979 cipb.hFileInfo.ioFDirIndex = 0;
3980 /* set to 0 to get information about specific dir or file */
3982 errno = PBGetCatInfo (&cipb, false);
3983 if (errno != noErr)
3985 errno = ENOENT;
3986 return 0;
3989 if (!(cipb.hFileInfo.ioFlAttrib & 0x10)) /* bit 4 = 1 for directories */
3990 return 0; /* not a directory */
3992 dirp->dir_id = cipb.dirInfo.ioDrDirID; /* used later in readdir */
3993 dirp->getting_volumes = 0;
3994 dirp->current_index = 1; /* index for first file/directory */
3996 c2pstr (vol_name);
3997 vpb.ioNamePtr = vol_name;
3998 /* using full pathname so vRefNum and DirID ignored */
3999 vpb.ioVRefNum = 0;
4000 vpb.ioVolIndex = -1;
4001 errno = PBHGetVInfo ((union HParamBlockRec *) &vpb, false);
4002 if (errno != noErr)
4004 errno = ENOENT;
4005 return 0;
4008 dirp->vol_ref_num = vpb.ioVRefNum;
4010 return dirp;
4014 closedir (DIR *dp)
4016 free (dp);
4018 return 0;
4022 struct dirent *
4023 readdir (DIR *dp)
4025 HParamBlockRec hpblock;
4026 CInfoPBRec cipb;
4027 static struct dirent s_dirent;
4028 static Str255 s_name;
4029 int done;
4030 char *p;
4032 /* Handle the root directory containing the mounted volumes. Call
4033 PBHGetVInfo specifying an index to obtain the info for a volume.
4034 PBHGetVInfo returns an error when it receives an index beyond the
4035 last volume, at which time we should return a nil dirent struct
4036 pointer. */
4037 if (dp->getting_volumes)
4039 hpblock.volumeParam.ioNamePtr = s_name;
4040 hpblock.volumeParam.ioVRefNum = 0;
4041 hpblock.volumeParam.ioVolIndex = dp->current_index;
4043 errno = PBHGetVInfo (&hpblock, false);
4044 if (errno != noErr)
4046 errno = ENOENT;
4047 return 0;
4050 p2cstr (s_name);
4051 strcat (s_name, "/"); /* need "/" for stat to work correctly */
4053 dp->current_index++;
4055 s_dirent.d_ino = hpblock.volumeParam.ioVRefNum;
4056 s_dirent.d_name = s_name;
4058 return &s_dirent;
4060 else
4062 cipb.hFileInfo.ioVRefNum = dp->vol_ref_num;
4063 cipb.hFileInfo.ioNamePtr = s_name;
4064 /* location to receive filename returned */
4066 /* return only visible files */
4067 done = false;
4068 while (!done)
4070 cipb.hFileInfo.ioDirID = dp->dir_id;
4071 /* directory ID found by opendir */
4072 cipb.hFileInfo.ioFDirIndex = dp->current_index;
4074 errno = PBGetCatInfo (&cipb, false);
4075 if (errno != noErr)
4077 errno = ENOENT;
4078 return 0;
4081 /* insist on a visible entry */
4082 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* directory? */
4083 done = !(cipb.dirInfo.ioDrUsrWds.frFlags & fInvisible);
4084 else
4085 done = !(cipb.hFileInfo.ioFlFndrInfo.fdFlags & fInvisible);
4087 dp->current_index++;
4090 p2cstr (s_name);
4092 p = s_name;
4093 while (*p)
4095 if (*p == '/')
4096 *p = ':';
4097 p++;
4100 s_dirent.d_ino = cipb.dirInfo.ioDrDirID;
4101 /* value unimportant: non-zero for valid file */
4102 s_dirent.d_name = s_name;
4104 return &s_dirent;
4109 char *
4110 getwd (char *path)
4112 char mac_pathname[MAXPATHLEN+1];
4113 Str255 directory_name;
4114 OSErr errno;
4115 CInfoPBRec cipb;
4117 if (path_from_vol_dir_name (mac_pathname, 255, 0, 0, "\p") == 0)
4118 return NULL;
4120 if (mac_to_posix_pathname (mac_pathname, path, MAXPATHLEN+1) == 0)
4121 return 0;
4122 else
4123 return path;
4126 #endif /* ! MAC_OSX */
4129 void
4130 initialize_applescript ()
4132 AEDesc null_desc;
4133 OSAError osaerror;
4135 /* if open fails, as_scripting_component is set to NULL. Its
4136 subsequent use in OSA calls will fail with badComponentInstance
4137 error. */
4138 as_scripting_component = OpenDefaultComponent (kOSAComponentType,
4139 kAppleScriptSubtype);
4141 null_desc.descriptorType = typeNull;
4142 null_desc.dataHandle = 0;
4143 osaerror = OSAMakeContext (as_scripting_component, &null_desc,
4144 kOSANullScript, &as_script_context);
4145 if (osaerror)
4146 as_script_context = kOSANullScript;
4147 /* use default context if create fails */
4151 void
4152 terminate_applescript()
4154 OSADispose (as_scripting_component, as_script_context);
4155 CloseComponent (as_scripting_component);
4158 /* Convert a lisp string to the 4 byte character code. */
4160 OSType
4161 mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
4163 OSType result;
4164 if (NILP(arg))
4166 result = defCode;
4168 else
4170 /* check type string */
4171 CHECK_STRING(arg);
4172 if (SBYTES (arg) != 4)
4174 error ("Wrong argument: need string of length 4 for code");
4176 result = EndianU32_BtoN (*((UInt32 *) SDATA (arg)));
4178 return result;
4181 /* Convert the 4 byte character code into a 4 byte string. */
4183 Lisp_Object
4184 mac_get_object_from_code(OSType defCode)
4186 UInt32 code = EndianU32_NtoB (defCode);
4188 return make_unibyte_string ((char *)&code, 4);
4192 DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0,
4193 doc: /* Get the creator code of FILENAME as a four character string. */)
4194 (filename)
4195 Lisp_Object filename;
4197 OSStatus status;
4198 #ifdef MAC_OSX
4199 FSRef fref;
4200 #else
4201 FSSpec fss;
4202 #endif
4203 Lisp_Object result = Qnil;
4204 CHECK_STRING (filename);
4206 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4207 return Qnil;
4209 filename = Fexpand_file_name (filename, Qnil);
4211 BLOCK_INPUT;
4212 #ifdef MAC_OSX
4213 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4214 #else
4215 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4216 #endif
4218 if (status == noErr)
4220 #ifdef MAC_OSX
4221 FSCatalogInfo catalogInfo;
4223 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4224 &catalogInfo, NULL, NULL, NULL);
4225 #else
4226 FInfo finder_info;
4228 status = FSpGetFInfo (&fss, &finder_info);
4229 #endif
4230 if (status == noErr)
4232 #ifdef MAC_OSX
4233 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator);
4234 #else
4235 result = mac_get_object_from_code (finder_info.fdCreator);
4236 #endif
4239 UNBLOCK_INPUT;
4240 if (status != noErr) {
4241 error ("Error while getting file information.");
4243 return result;
4246 DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0,
4247 doc: /* Get the type code of FILENAME as a four character string. */)
4248 (filename)
4249 Lisp_Object filename;
4251 OSStatus status;
4252 #ifdef MAC_OSX
4253 FSRef fref;
4254 #else
4255 FSSpec fss;
4256 #endif
4257 Lisp_Object result = Qnil;
4258 CHECK_STRING (filename);
4260 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4261 return Qnil;
4263 filename = Fexpand_file_name (filename, Qnil);
4265 BLOCK_INPUT;
4266 #ifdef MAC_OSX
4267 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4268 #else
4269 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4270 #endif
4272 if (status == noErr)
4274 #ifdef MAC_OSX
4275 FSCatalogInfo catalogInfo;
4277 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4278 &catalogInfo, NULL, NULL, NULL);
4279 #else
4280 FInfo finder_info;
4282 status = FSpGetFInfo (&fss, &finder_info);
4283 #endif
4284 if (status == noErr)
4286 #ifdef MAC_OSX
4287 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType);
4288 #else
4289 result = mac_get_object_from_code (finder_info.fdType);
4290 #endif
4293 UNBLOCK_INPUT;
4294 if (status != noErr) {
4295 error ("Error while getting file information.");
4297 return result;
4300 DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0,
4301 doc: /* Set creator code of file FILENAME to CODE.
4302 If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4303 assumed. Return non-nil if successful. */)
4304 (filename, code)
4305 Lisp_Object filename, code;
4307 OSStatus status;
4308 #ifdef MAC_OSX
4309 FSRef fref;
4310 #else
4311 FSSpec fss;
4312 #endif
4313 OSType cCode;
4314 CHECK_STRING (filename);
4316 cCode = mac_get_code_from_arg(code, MAC_EMACS_CREATOR_CODE);
4318 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4319 return Qnil;
4321 filename = Fexpand_file_name (filename, Qnil);
4323 BLOCK_INPUT;
4324 #ifdef MAC_OSX
4325 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4326 #else
4327 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4328 #endif
4330 if (status == noErr)
4332 #ifdef MAC_OSX
4333 FSCatalogInfo catalogInfo;
4334 FSRef parentDir;
4335 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4336 &catalogInfo, NULL, NULL, &parentDir);
4337 #else
4338 FInfo finder_info;
4340 status = FSpGetFInfo (&fss, &finder_info);
4341 #endif
4342 if (status == noErr)
4344 #ifdef MAC_OSX
4345 ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode;
4346 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
4347 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4348 #else
4349 finder_info.fdCreator = cCode;
4350 status = FSpSetFInfo (&fss, &finder_info);
4351 #endif
4354 UNBLOCK_INPUT;
4355 if (status != noErr) {
4356 error ("Error while setting creator information.");
4358 return Qt;
4361 DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0,
4362 doc: /* Set file code of file FILENAME to CODE.
4363 CODE must be a 4-character string. Return non-nil if successful. */)
4364 (filename, code)
4365 Lisp_Object filename, code;
4367 OSStatus status;
4368 #ifdef MAC_OSX
4369 FSRef fref;
4370 #else
4371 FSSpec fss;
4372 #endif
4373 OSType cCode;
4374 CHECK_STRING (filename);
4376 cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
4378 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4379 return Qnil;
4381 filename = Fexpand_file_name (filename, Qnil);
4383 BLOCK_INPUT;
4384 #ifdef MAC_OSX
4385 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4386 #else
4387 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4388 #endif
4390 if (status == noErr)
4392 #ifdef MAC_OSX
4393 FSCatalogInfo catalogInfo;
4394 FSRef parentDir;
4395 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4396 &catalogInfo, NULL, NULL, &parentDir);
4397 #else
4398 FInfo finder_info;
4400 status = FSpGetFInfo (&fss, &finder_info);
4401 #endif
4402 if (status == noErr)
4404 #ifdef MAC_OSX
4405 ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode;
4406 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
4407 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
4408 #else
4409 finder_info.fdType = cCode;
4410 status = FSpSetFInfo (&fss, &finder_info);
4411 #endif
4414 UNBLOCK_INPUT;
4415 if (status != noErr) {
4416 error ("Error while setting creator information.");
4418 return Qt;
4422 /* Compile and execute the AppleScript SCRIPT and return the error
4423 status as function value. A zero is returned if compilation and
4424 execution is successful, in which case *RESULT is set to a Lisp
4425 string containing the resulting script value. Otherwise, the Mac
4426 error code is returned and *RESULT is set to an error Lisp string.
4427 For documentation on the MacOS scripting architecture, see Inside
4428 Macintosh - Interapplication Communications: Scripting
4429 Components. */
4431 static long
4432 do_applescript (script, result)
4433 Lisp_Object script, *result;
4435 AEDesc script_desc, result_desc, error_desc, *desc = NULL;
4436 OSErr error;
4437 OSAError osaerror;
4439 *result = Qnil;
4441 if (!as_scripting_component)
4442 initialize_applescript();
4444 error = AECreateDesc (typeChar, SDATA (script), SBYTES (script),
4445 &script_desc);
4446 if (error)
4447 return error;
4449 osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
4450 typeChar, kOSAModeNull, &result_desc);
4452 if (osaerror == noErr)
4453 /* success: retrieve resulting script value */
4454 desc = &result_desc;
4455 else if (osaerror == errOSAScriptError)
4456 /* error executing AppleScript: retrieve error message */
4457 if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar,
4458 &error_desc))
4459 desc = &error_desc;
4461 if (desc)
4463 #if TARGET_API_MAC_CARBON
4464 *result = make_uninit_string (AEGetDescDataSize (desc));
4465 AEGetDescData (desc, SDATA (*result), SBYTES (*result));
4466 #else /* not TARGET_API_MAC_CARBON */
4467 *result = make_uninit_string (GetHandleSize (desc->dataHandle));
4468 memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result));
4469 #endif /* not TARGET_API_MAC_CARBON */
4470 AEDisposeDesc (desc);
4473 AEDisposeDesc (&script_desc);
4475 return osaerror;
4479 DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
4480 doc: /* Compile and execute AppleScript SCRIPT and return the result.
4481 If compilation and execution are successful, the resulting script
4482 value is returned as a string. Otherwise the function aborts and
4483 displays the error message returned by the AppleScript scripting
4484 component. */)
4485 (script)
4486 Lisp_Object script;
4488 Lisp_Object result;
4489 long status;
4491 CHECK_STRING (script);
4493 BLOCK_INPUT;
4494 status = do_applescript (script, &result);
4495 UNBLOCK_INPUT;
4496 if (status == 0)
4497 return result;
4498 else if (!STRINGP (result))
4499 error ("AppleScript error %d", status);
4500 else
4501 error ("%s", SDATA (result));
4505 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
4506 Smac_file_name_to_posix, 1, 1, 0,
4507 doc: /* Convert Macintosh FILENAME to Posix form. */)
4508 (filename)
4509 Lisp_Object filename;
4511 char posix_filename[MAXPATHLEN+1];
4513 CHECK_STRING (filename);
4515 if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN))
4516 return build_string (posix_filename);
4517 else
4518 return Qnil;
4522 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac,
4523 Sposix_file_name_to_mac, 1, 1, 0,
4524 doc: /* Convert Posix FILENAME to Mac form. */)
4525 (filename)
4526 Lisp_Object filename;
4528 char mac_filename[MAXPATHLEN+1];
4530 CHECK_STRING (filename);
4532 if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN))
4533 return build_string (mac_filename);
4534 else
4535 return Qnil;
4539 DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data, Smac_coerce_ae_data, 3, 3, 0,
4540 doc: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4541 Each type should be a string of length 4 or the symbol
4542 `undecoded-file-name'. */)
4543 (src_type, src_data, dst_type)
4544 Lisp_Object src_type, src_data, dst_type;
4546 OSErr err;
4547 Lisp_Object result = Qnil;
4548 DescType src_desc_type, dst_desc_type;
4549 AEDesc dst_desc;
4551 CHECK_STRING (src_data);
4552 if (EQ (src_type, Qundecoded_file_name))
4553 src_desc_type = TYPE_FILE_NAME;
4554 else
4555 src_desc_type = mac_get_code_from_arg (src_type, 0);
4557 if (EQ (dst_type, Qundecoded_file_name))
4558 dst_desc_type = TYPE_FILE_NAME;
4559 else
4560 dst_desc_type = mac_get_code_from_arg (dst_type, 0);
4562 BLOCK_INPUT;
4563 err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data),
4564 dst_desc_type, &dst_desc);
4565 if (err == noErr)
4567 result = Fcdr (mac_aedesc_to_lisp (&dst_desc));
4568 AEDisposeDesc (&dst_desc);
4570 UNBLOCK_INPUT;
4572 return result;
4576 #if TARGET_API_MAC_CARBON
4577 static Lisp_Object Qxml, Qmime_charset;
4578 static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
4580 DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
4581 doc: /* Return the application preference value for KEY.
4582 KEY is either a string specifying a preference key, or a list of key
4583 strings. If it is a list, the (i+1)-th element is used as a key for
4584 the CFDictionary value obtained by the i-th element. Return nil if
4585 lookup is failed at some stage.
4587 Optional arg APPLICATION is an application ID string. If omitted or
4588 nil, that stands for the current application.
4590 Optional arg FORMAT specifies the data format of the return value. If
4591 omitted or nil, each Core Foundation object is converted into a
4592 corresponding Lisp object as follows:
4594 Core Foundation Lisp Tag
4595 ------------------------------------------------------------
4596 CFString Multibyte string string
4597 CFNumber Integer or float number
4598 CFBoolean Symbol (t or nil) boolean
4599 CFDate List of three integers date
4600 (cf. `current-time')
4601 CFData Unibyte string data
4602 CFArray Vector array
4603 CFDictionary Alist or hash table dictionary
4604 (depending on HASH-BOUND)
4606 If it is t, a symbol that represents the type of the original Core
4607 Foundation object is prepended. If it is `xml', the value is returned
4608 as an XML representation.
4610 Optional arg HASH-BOUND specifies which kinds of the list objects,
4611 alists or hash tables, are used as the targets of the conversion from
4612 CFDictionary. If HASH-BOUND is a negative integer or nil, always
4613 generate alists. If HASH-BOUND >= 0, generate an alist if the number
4614 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4615 otherwise. */)
4616 (key, application, format, hash_bound)
4617 Lisp_Object key, application, format, hash_bound;
4619 CFStringRef app_id, key_str;
4620 CFPropertyListRef app_plist = NULL, plist;
4621 Lisp_Object result = Qnil, tmp;
4622 struct gcpro gcpro1, gcpro2;
4624 if (STRINGP (key))
4625 key = Fcons (key, Qnil);
4626 else
4628 CHECK_CONS (key);
4629 for (tmp = key; CONSP (tmp); tmp = XCDR (tmp))
4630 CHECK_STRING_CAR (tmp);
4631 CHECK_LIST_END (tmp, key);
4633 if (!NILP (application))
4634 CHECK_STRING (application);
4635 CHECK_SYMBOL (format);
4636 if (!NILP (hash_bound))
4637 CHECK_NUMBER (hash_bound);
4639 GCPRO2 (key, format);
4641 BLOCK_INPUT;
4643 app_id = kCFPreferencesCurrentApplication;
4644 if (!NILP (application))
4646 app_id = cfstring_create_with_string (application);
4647 if (app_id == NULL)
4648 goto out;
4650 if (!CFPreferencesAppSynchronize (app_id))
4651 goto out;
4653 key_str = cfstring_create_with_string (XCAR (key));
4654 if (key_str == NULL)
4655 goto out;
4656 app_plist = CFPreferencesCopyAppValue (key_str, app_id);
4657 CFRelease (key_str);
4658 if (app_plist == NULL)
4659 goto out;
4661 plist = app_plist;
4662 for (key = XCDR (key); CONSP (key); key = XCDR (key))
4664 if (CFGetTypeID (plist) != CFDictionaryGetTypeID ())
4665 break;
4666 key_str = cfstring_create_with_string (XCAR (key));
4667 if (key_str == NULL)
4668 goto out;
4669 plist = CFDictionaryGetValue (plist, key_str);
4670 CFRelease (key_str);
4671 if (plist == NULL)
4672 goto out;
4675 if (NILP (key))
4677 if (EQ (format, Qxml))
4679 CFDataRef data = CFPropertyListCreateXMLData (NULL, plist);
4680 if (data == NULL)
4681 goto out;
4682 result = cfdata_to_lisp (data);
4683 CFRelease (data);
4685 else
4686 result =
4687 cfproperty_list_to_lisp (plist, EQ (format, Qt),
4688 NILP (hash_bound) ? -1 : XINT (hash_bound));
4691 out:
4692 if (app_plist)
4693 CFRelease (app_plist);
4694 CFRelease (app_id);
4696 UNBLOCK_INPUT;
4698 UNGCPRO;
4700 return result;
4704 static CFStringEncoding
4705 get_cfstring_encoding_from_lisp (obj)
4706 Lisp_Object obj;
4708 CFStringRef iana_name;
4709 CFStringEncoding encoding = kCFStringEncodingInvalidId;
4711 if (NILP (obj))
4712 return kCFStringEncodingUnicode;
4714 if (INTEGERP (obj))
4715 return XINT (obj);
4717 if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj)))
4719 Lisp_Object coding_spec, plist;
4721 coding_spec = Fget (obj, Qcoding_system);
4722 plist = XVECTOR (coding_spec)->contents[3];
4723 obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset);
4726 if (SYMBOLP (obj))
4727 obj = SYMBOL_NAME (obj);
4729 if (STRINGP (obj))
4731 iana_name = cfstring_create_with_string (obj);
4732 if (iana_name)
4734 encoding = CFStringConvertIANACharSetNameToEncoding (iana_name);
4735 CFRelease (iana_name);
4739 return encoding;
4742 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4743 static CFStringRef
4744 cfstring_create_normalized (str, symbol)
4745 CFStringRef str;
4746 Lisp_Object symbol;
4748 int form = -1;
4749 TextEncodingVariant variant;
4750 float initial_mag = 0.0;
4751 CFStringRef result = NULL;
4753 if (EQ (symbol, QNFD))
4754 form = kCFStringNormalizationFormD;
4755 else if (EQ (symbol, QNFKD))
4756 form = kCFStringNormalizationFormKD;
4757 else if (EQ (symbol, QNFC))
4758 form = kCFStringNormalizationFormC;
4759 else if (EQ (symbol, QNFKC))
4760 form = kCFStringNormalizationFormKC;
4761 else if (EQ (symbol, QHFS_plus_D))
4763 variant = kUnicodeHFSPlusDecompVariant;
4764 initial_mag = 1.5;
4766 else if (EQ (symbol, QHFS_plus_C))
4768 variant = kUnicodeHFSPlusCompVariant;
4769 initial_mag = 1.0;
4772 if (form >= 0)
4774 CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str);
4776 if (mut_str)
4778 CFStringNormalize (mut_str, form);
4779 result = mut_str;
4782 else if (initial_mag > 0.0)
4784 UnicodeToTextInfo uni = NULL;
4785 UnicodeMapping map;
4786 CFIndex length;
4787 UniChar *in_text, *buffer = NULL, *out_buf = NULL;
4788 OSStatus err = noErr;
4789 ByteCount out_read, out_size, out_len;
4791 map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4792 kUnicodeNoSubset,
4793 kTextEncodingDefaultFormat);
4794 map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4795 variant,
4796 kTextEncodingDefaultFormat);
4797 map.mappingVersion = kUnicodeUseLatestMapping;
4799 length = CFStringGetLength (str);
4800 out_size = (int)((float)length * initial_mag) * sizeof (UniChar);
4801 if (out_size < 32)
4802 out_size = 32;
4804 in_text = (UniChar *)CFStringGetCharactersPtr (str);
4805 if (in_text == NULL)
4807 buffer = xmalloc (sizeof (UniChar) * length);
4808 CFStringGetCharacters (str, CFRangeMake (0, length), buffer);
4809 in_text = buffer;
4812 if (in_text)
4813 err = CreateUnicodeToTextInfo (&map, &uni);
4814 while (err == noErr)
4816 out_buf = xmalloc (out_size);
4817 err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar),
4818 in_text,
4819 kUnicodeDefaultDirectionMask,
4820 0, NULL, NULL, NULL,
4821 out_size, &out_read, &out_len,
4822 out_buf);
4823 if (err == noErr && out_read < length * sizeof (UniChar))
4825 xfree (out_buf);
4826 out_size += length;
4828 else
4829 break;
4831 if (err == noErr)
4832 result = CFStringCreateWithCharacters (NULL, out_buf,
4833 out_len / sizeof (UniChar));
4834 if (uni)
4835 DisposeUnicodeToTextInfo (&uni);
4836 if (out_buf)
4837 xfree (out_buf);
4838 if (buffer)
4839 xfree (buffer);
4841 else
4843 result = str;
4844 CFRetain (result);
4847 return result;
4849 #endif
4851 DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0,
4852 doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
4853 The conversion is performed using the converter provided by the system.
4854 Each encoding is specified by either a coding system symbol, a mime
4855 charset string, or an integer as a CFStringEncoding value. An encoding
4856 of nil means UTF-16 in native byte order, no byte order mark.
4857 On Mac OS X 10.2 and later, you can do Unicode Normalization by
4858 specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4859 NFKD, NFC, NFKC, HFS+D, or HFS+C.
4860 On successful conversion, return the result string, else return nil. */)
4861 (string, source, target, normalization_form)
4862 Lisp_Object string, source, target, normalization_form;
4864 Lisp_Object result = Qnil;
4865 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4866 CFStringEncoding src_encoding, tgt_encoding;
4867 CFStringRef str = NULL;
4869 CHECK_STRING (string);
4870 if (!INTEGERP (source) && !STRINGP (source))
4871 CHECK_SYMBOL (source);
4872 if (!INTEGERP (target) && !STRINGP (target))
4873 CHECK_SYMBOL (target);
4874 CHECK_SYMBOL (normalization_form);
4876 GCPRO4 (string, source, target, normalization_form);
4878 BLOCK_INPUT;
4880 src_encoding = get_cfstring_encoding_from_lisp (source);
4881 tgt_encoding = get_cfstring_encoding_from_lisp (target);
4883 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4884 use string_as_unibyte which works as well, except for the fact that
4885 it's too permissive (it doesn't check that the multibyte string only
4886 contain single-byte chars). */
4887 string = Fstring_as_unibyte (string);
4888 if (src_encoding != kCFStringEncodingInvalidId
4889 && tgt_encoding != kCFStringEncodingInvalidId)
4890 str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
4891 src_encoding, !NILP (source));
4892 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4893 if (str)
4895 CFStringRef saved_str = str;
4897 str = cfstring_create_normalized (saved_str, normalization_form);
4898 CFRelease (saved_str);
4900 #endif
4901 if (str)
4903 CFIndex str_len, buf_len;
4905 str_len = CFStringGetLength (str);
4906 if (CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4907 !NILP (target), NULL, 0, &buf_len) == str_len)
4909 result = make_uninit_string (buf_len);
4910 CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4911 !NILP (target), SDATA (result), buf_len, NULL);
4913 CFRelease (str);
4916 UNBLOCK_INPUT;
4918 UNGCPRO;
4920 return result;
4923 DEFUN ("mac-process-hi-command", Fmac_process_hi_command, Smac_process_hi_command, 1, 1, 0,
4924 doc: /* Send a HI command whose ID is COMMAND-ID to the command chain.
4925 COMMAND-ID must be a 4-character string. Some common command IDs are
4926 defined in the Carbon Event Manager. */)
4927 (command_id)
4928 Lisp_Object command_id;
4930 OSStatus err;
4931 HICommand command;
4933 bzero (&command, sizeof (HICommand));
4934 command.commandID = mac_get_code_from_arg (command_id, 0);
4936 BLOCK_INPUT;
4937 err = ProcessHICommand (&command);
4938 UNBLOCK_INPUT;
4940 if (err != noErr)
4941 error ("HI command (command ID: '%s') not handled.", SDATA (command_id));
4943 return Qnil;
4946 #endif /* TARGET_API_MAC_CARBON */
4949 static Lisp_Object
4950 mac_get_system_locale ()
4952 OSStatus err;
4953 LangCode lang;
4954 RegionCode region;
4955 LocaleRef locale;
4956 Str255 str;
4958 lang = GetScriptVariable (smSystemScript, smScriptLang);
4959 region = GetScriptManagerVariable (smRegionCode);
4960 err = LocaleRefFromLangOrRegionCode (lang, region, &locale);
4961 if (err == noErr)
4962 err = LocaleRefGetPartString (locale, kLocaleAllPartsMask,
4963 sizeof (str), str);
4964 if (err == noErr)
4965 return build_string (str);
4966 else
4967 return Qnil;
4971 #ifdef MAC_OSX
4973 extern int inhibit_window_system;
4974 extern int noninteractive;
4976 /* Unlike in X11, window events in Carbon do not come from sockets.
4977 So we cannot simply use `select' to monitor two kinds of inputs:
4978 window events and process outputs. We emulate such functionality
4979 by regarding fd 0 as the window event channel and simultaneously
4980 monitoring both kinds of input channels. It is implemented by
4981 dividing into some cases:
4982 1. The window event channel is not involved.
4983 -> Use `select'.
4984 2. Sockets are not involved.
4985 -> Use ReceiveNextEvent.
4986 3. [If SELECT_USE_CFSOCKET is set]
4987 Only the window event channel and socket read/write channels are
4988 involved, and timeout is not too short (greater than
4989 SELECT_TIMEOUT_THRESHOLD_RUNLOOP seconds).
4990 -> Create CFSocket for each socket and add it into the current
4991 event RunLoop so that the current event loop gets quit when
4992 the socket becomes ready. Then CFRunLoopRunInMode can wait
4993 for both kinds of inputs.
4994 4. Otherwise.
4995 -> Periodically poll the window input channel while repeatedly
4996 executing `select' with a short timeout
4997 (SELECT_POLLING_PERIOD_USEC microseconds). */
4999 #ifndef SELECT_USE_CFSOCKET
5000 #define SELECT_USE_CFSOCKET 1
5001 #endif
5003 #define SELECT_POLLING_PERIOD_USEC 100000
5004 #if SELECT_USE_CFSOCKET
5005 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
5007 /* Dictionary of file descriptors vs CFSocketRef's allocated in
5008 sys_select. */
5009 static CFMutableDictionaryRef cfsockets_for_select;
5011 /* Process ID of Emacs. */
5012 static pid_t mac_emacs_pid;
5014 static void
5015 socket_callback (s, type, address, data, info)
5016 CFSocketRef s;
5017 CFSocketCallBackType type;
5018 CFDataRef address;
5019 const void *data;
5020 void *info;
5023 #endif /* SELECT_USE_CFSOCKET */
5025 static int
5026 select_and_poll_event (nfds, rfds, wfds, efds, timeout)
5027 int nfds;
5028 SELECT_TYPE *rfds, *wfds, *efds;
5029 EMACS_TIME *timeout;
5031 int timedout_p = 0;
5032 int r = 0;
5033 EMACS_TIME select_timeout;
5034 EventTimeout timeoutval =
5035 (timeout
5036 ? (EMACS_SECS (*timeout) * kEventDurationSecond
5037 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
5038 : kEventDurationForever);
5039 SELECT_TYPE orfds, owfds, oefds;
5041 if (timeout == NULL)
5043 if (rfds) orfds = *rfds;
5044 if (wfds) owfds = *wfds;
5045 if (efds) oefds = *efds;
5048 /* Try detect_input_pending before CFRunLoopRunInMode in the same
5049 BLOCK_INPUT block, in case that some input has already been read
5050 asynchronously. */
5051 BLOCK_INPUT;
5052 while (1)
5054 if (detect_input_pending ())
5055 break;
5057 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5058 r = select (nfds, rfds, wfds, efds, &select_timeout);
5059 if (r != 0)
5060 break;
5062 if (timeoutval == 0.0)
5063 timedout_p = 1;
5064 else
5066 #if USE_CG_DRAWING
5067 mac_prepare_for_quickdraw (NULL);
5068 #endif
5069 if (CFRunLoopRunInMode (kCFRunLoopDefaultMode,
5070 timeoutval >= 0 ? timeoutval : 100000, true)
5071 == kCFRunLoopRunTimedOut)
5072 timedout_p = 1;
5075 if (timeout == NULL && timedout_p)
5077 if (rfds) *rfds = orfds;
5078 if (wfds) *wfds = owfds;
5079 if (efds) *efds = oefds;
5081 else
5082 break;
5084 UNBLOCK_INPUT;
5086 if (r != 0)
5087 return r;
5088 else if (!timedout_p)
5090 /* Pretend that `select' is interrupted by a signal. */
5091 detect_input_pending ();
5092 errno = EINTR;
5093 return -1;
5095 else
5096 return 0;
5099 /* Clean up the CFSocket associated with the file descriptor FD in
5100 case the same descriptor is used in other threads later. If no
5101 CFSocket is associated with FD, then return 0 without closing FD.
5102 Otherwise, return 1 with closing FD. */
5105 mac_try_close_socket (fd)
5106 int fd;
5108 #if SELECT_USE_CFSOCKET
5109 if (getpid () == mac_emacs_pid && cfsockets_for_select)
5111 void *key = (void *) fd;
5112 CFSocketRef socket =
5113 (CFSocketRef) CFDictionaryGetValue (cfsockets_for_select, key);
5115 if (socket)
5117 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
5118 CFOptionFlags flags = CFSocketGetSocketFlags (socket);
5120 if (!(flags & kCFSocketCloseOnInvalidate))
5121 CFSocketSetSocketFlags (socket, flags | kCFSocketCloseOnInvalidate);
5122 #endif
5123 BLOCK_INPUT;
5124 CFSocketInvalidate (socket);
5125 CFDictionaryRemoveValue (cfsockets_for_select, key);
5126 UNBLOCK_INPUT;
5128 return 1;
5131 #endif
5133 return 0;
5137 sys_select (nfds, rfds, wfds, efds, timeout)
5138 int nfds;
5139 SELECT_TYPE *rfds, *wfds, *efds;
5140 EMACS_TIME *timeout;
5142 int timedout_p = 0;
5143 int r;
5144 EMACS_TIME select_timeout;
5145 SELECT_TYPE orfds, owfds, oefds;
5147 if (inhibit_window_system || noninteractive
5148 || nfds < 1 || rfds == NULL || !FD_ISSET (0, rfds))
5149 return select (nfds, rfds, wfds, efds, timeout);
5151 FD_CLR (0, rfds);
5152 orfds = *rfds;
5154 if (wfds)
5155 owfds = *wfds;
5156 else
5157 FD_ZERO (&owfds);
5159 if (efds)
5160 oefds = *efds;
5161 else
5163 EventTimeout timeoutval =
5164 (timeout
5165 ? (EMACS_SECS (*timeout) * kEventDurationSecond
5166 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
5167 : kEventDurationForever);
5169 FD_SET (0, rfds); /* sentinel */
5172 nfds--;
5174 while (!(FD_ISSET (nfds, rfds) || (wfds && FD_ISSET (nfds, wfds))));
5175 nfds++;
5176 FD_CLR (0, rfds);
5178 if (nfds == 1)
5179 return select_and_poll_event (nfds, rfds, wfds, efds, timeout);
5181 /* Avoid initial overhead of RunLoop setup for the case that
5182 some input is already available. */
5183 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5184 r = select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
5185 if (r != 0 || timeoutval == 0.0)
5186 return r;
5188 *rfds = orfds;
5189 if (wfds)
5190 *wfds = owfds;
5192 #if SELECT_USE_CFSOCKET
5193 if (timeoutval > 0 && timeoutval <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
5194 goto poll_periodically;
5196 /* Try detect_input_pending before CFRunLoopRunInMode in the
5197 same BLOCK_INPUT block, in case that some input has already
5198 been read asynchronously. */
5199 BLOCK_INPUT;
5200 if (!detect_input_pending ())
5202 int minfd, fd;
5203 CFRunLoopRef runloop =
5204 (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
5205 static CFMutableDictionaryRef sources;
5207 if (sources == NULL)
5208 sources =
5209 CFDictionaryCreateMutable (NULL, 0, NULL,
5210 &kCFTypeDictionaryValueCallBacks);
5212 if (cfsockets_for_select == NULL)
5213 cfsockets_for_select =
5214 CFDictionaryCreateMutable (NULL, 0, NULL,
5215 &kCFTypeDictionaryValueCallBacks);
5217 for (minfd = 1; ; minfd++) /* nfds-1 works as a sentinel. */
5218 if (FD_ISSET (minfd, rfds) || (wfds && FD_ISSET (minfd, wfds)))
5219 break;
5221 for (fd = minfd; fd < nfds; fd++)
5222 if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
5224 void *key = (void *) fd;
5225 CFRunLoopSourceRef source =
5226 (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
5228 if (source == NULL || !CFRunLoopSourceIsValid (source))
5230 CFSocketRef socket =
5231 CFSocketCreateWithNative (NULL, fd,
5232 (kCFSocketReadCallBack
5233 | kCFSocketConnectCallBack),
5234 socket_callback, NULL);
5236 if (socket == NULL)
5237 continue;
5238 CFDictionarySetValue (cfsockets_for_select, key, socket);
5239 source = CFSocketCreateRunLoopSource (NULL, socket, 0);
5240 CFRelease (socket);
5241 if (source == NULL)
5242 continue;
5243 CFDictionarySetValue (sources, key, source);
5244 CFRelease (source);
5246 CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode);
5249 #if USE_CG_DRAWING
5250 mac_prepare_for_quickdraw (NULL);
5251 #endif
5252 if (CFRunLoopRunInMode (kCFRunLoopDefaultMode,
5253 timeoutval >= 0 ? timeoutval : 100000, true)
5254 == kCFRunLoopRunTimedOut)
5255 timedout_p = 1;
5257 for (fd = minfd; fd < nfds; fd++)
5258 if (FD_ISSET (fd, rfds) || (wfds && FD_ISSET (fd, wfds)))
5260 void *key = (void *) fd;
5261 CFRunLoopSourceRef source =
5262 (CFRunLoopSourceRef) CFDictionaryGetValue (sources, key);
5264 CFRunLoopRemoveSource (runloop, source, kCFRunLoopDefaultMode);
5267 UNBLOCK_INPUT;
5269 if (!timedout_p)
5271 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5272 return select_and_poll_event (nfds, rfds, wfds, efds,
5273 &select_timeout);
5275 else
5277 FD_ZERO (rfds);
5278 if (wfds)
5279 FD_ZERO (wfds);
5280 return 0;
5282 #endif /* SELECT_USE_CFSOCKET */
5285 poll_periodically:
5287 EMACS_TIME end_time, now, remaining_time;
5289 if (timeout)
5291 remaining_time = *timeout;
5292 EMACS_GET_TIME (now);
5293 EMACS_ADD_TIME (end_time, now, remaining_time);
5298 EMACS_SET_SECS_USECS (select_timeout, 0, SELECT_POLLING_PERIOD_USEC);
5299 if (timeout && EMACS_TIME_LT (remaining_time, select_timeout))
5300 select_timeout = remaining_time;
5301 r = select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
5302 if (r != 0)
5303 return r;
5305 *rfds = orfds;
5306 if (wfds)
5307 *wfds = owfds;
5308 if (efds)
5309 *efds = oefds;
5311 if (timeout)
5313 EMACS_GET_TIME (now);
5314 EMACS_SUB_TIME (remaining_time, end_time, now);
5317 while (!timeout || EMACS_TIME_LT (now, end_time));
5319 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
5320 return select_and_poll_event (nfds, rfds, wfds, efds, &select_timeout);
5324 /* Set up environment variables so that Emacs can correctly find its
5325 support files when packaged as an application bundle. Directories
5326 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
5327 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
5328 by `make install' by default can instead be placed in
5329 .../Emacs.app/Contents/Resources/ and
5330 .../Emacs.app/Contents/MacOS/. Each of these environment variables
5331 is changed only if it is not already set. Presumably if the user
5332 sets an environment variable, he will want to use files in his path
5333 instead of ones in the application bundle. */
5334 void
5335 init_mac_osx_environment ()
5337 CFBundleRef bundle;
5338 CFURLRef bundleURL;
5339 CFStringRef cf_app_bundle_pathname;
5340 int app_bundle_pathname_len;
5341 char *app_bundle_pathname;
5342 char *p, *q;
5343 struct stat st;
5345 mac_emacs_pid = getpid ();
5347 /* Initialize locale related variables. */
5348 mac_system_script_code =
5349 (ScriptCode) GetScriptManagerVariable (smSysScript);
5350 Vmac_system_locale = mac_get_system_locale ();
5352 /* Fetch the pathname of the application bundle as a C string into
5353 app_bundle_pathname. */
5355 bundle = CFBundleGetMainBundle ();
5356 if (!bundle || CFBundleGetIdentifier (bundle) == NULL)
5358 /* We could not find the bundle identifier. For now, prevent
5359 the fatal error by bringing it up in the terminal. */
5360 inhibit_window_system = 1;
5361 return;
5364 bundleURL = CFBundleCopyBundleURL (bundle);
5365 if (!bundleURL)
5366 return;
5368 cf_app_bundle_pathname = CFURLCopyFileSystemPath (bundleURL,
5369 kCFURLPOSIXPathStyle);
5370 app_bundle_pathname_len = CFStringGetLength (cf_app_bundle_pathname);
5371 app_bundle_pathname = (char *) alloca (app_bundle_pathname_len + 1);
5373 if (!CFStringGetCString (cf_app_bundle_pathname,
5374 app_bundle_pathname,
5375 app_bundle_pathname_len + 1,
5376 kCFStringEncodingISOLatin1))
5378 CFRelease (cf_app_bundle_pathname);
5379 return;
5382 CFRelease (cf_app_bundle_pathname);
5384 /* P should have sufficient room for the pathname of the bundle plus
5385 the subpath in it leading to the respective directories. Q
5386 should have three times that much room because EMACSLOADPATH can
5387 have the value "<path to site-lisp dir>:<path to lisp dir>:<path
5388 to leim dir>". */
5389 p = (char *) alloca (app_bundle_pathname_len + 50);
5390 q = (char *) alloca (3 * app_bundle_pathname_len + 150);
5391 if (!getenv ("EMACSLOADPATH"))
5393 q[0] = '\0';
5395 strcpy (p, app_bundle_pathname);
5396 strcat (p, "/Contents/Resources/site-lisp");
5397 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5398 strcat (q, p);
5400 strcpy (p, app_bundle_pathname);
5401 strcat (p, "/Contents/Resources/lisp");
5402 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5404 if (q[0] != '\0')
5405 strcat (q, ":");
5406 strcat (q, p);
5409 strcpy (p, app_bundle_pathname);
5410 strcat (p, "/Contents/Resources/leim");
5411 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5413 if (q[0] != '\0')
5414 strcat (q, ":");
5415 strcat (q, p);
5418 if (q[0] != '\0')
5419 setenv ("EMACSLOADPATH", q, 1);
5422 if (!getenv ("EMACSPATH"))
5424 q[0] = '\0';
5426 strcpy (p, app_bundle_pathname);
5427 strcat (p, "/Contents/MacOS/libexec");
5428 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5429 strcat (q, p);
5431 strcpy (p, app_bundle_pathname);
5432 strcat (p, "/Contents/MacOS/bin");
5433 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5435 if (q[0] != '\0')
5436 strcat (q, ":");
5437 strcat (q, p);
5440 if (q[0] != '\0')
5441 setenv ("EMACSPATH", q, 1);
5444 if (!getenv ("EMACSDATA"))
5446 strcpy (p, app_bundle_pathname);
5447 strcat (p, "/Contents/Resources/etc");
5448 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5449 setenv ("EMACSDATA", p, 1);
5452 if (!getenv ("EMACSDOC"))
5454 strcpy (p, app_bundle_pathname);
5455 strcat (p, "/Contents/Resources/etc");
5456 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5457 setenv ("EMACSDOC", p, 1);
5460 if (!getenv ("INFOPATH"))
5462 strcpy (p, app_bundle_pathname);
5463 strcat (p, "/Contents/Resources/info");
5464 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5465 setenv ("INFOPATH", p, 1);
5468 #endif /* MAC_OSX */
5470 #if TARGET_API_MAC_CARBON
5471 void
5472 mac_wakeup_from_rne ()
5474 #ifndef MAC_OSX
5475 if (wakeup_from_rne_enabled_p)
5476 /* Post a harmless event so as to wake up from
5477 ReceiveNextEvent. */
5478 mac_post_mouse_moved_event ();
5479 #endif
5481 #endif
5483 void
5484 syms_of_mac ()
5486 Qundecoded_file_name = intern ("undecoded-file-name");
5487 staticpro (&Qundecoded_file_name);
5489 #if TARGET_API_MAC_CARBON
5490 Qstring = intern ("string"); staticpro (&Qstring);
5491 Qnumber = intern ("number"); staticpro (&Qnumber);
5492 Qboolean = intern ("boolean"); staticpro (&Qboolean);
5493 Qdate = intern ("date"); staticpro (&Qdate);
5494 Qdata = intern ("data"); staticpro (&Qdata);
5495 Qarray = intern ("array"); staticpro (&Qarray);
5496 Qdictionary = intern ("dictionary"); staticpro (&Qdictionary);
5498 Qxml = intern ("xml");
5499 staticpro (&Qxml);
5501 Qmime_charset = intern ("mime-charset");
5502 staticpro (&Qmime_charset);
5504 QNFD = intern ("NFD"); staticpro (&QNFD);
5505 QNFKD = intern ("NFKD"); staticpro (&QNFKD);
5506 QNFC = intern ("NFC"); staticpro (&QNFC);
5507 QNFKC = intern ("NFKC"); staticpro (&QNFKC);
5508 QHFS_plus_D = intern ("HFS+D"); staticpro (&QHFS_plus_D);
5509 QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C);
5510 #endif
5513 int i;
5515 for (i = 0; i < sizeof (ae_attr_table) / sizeof (ae_attr_table[0]); i++)
5517 ae_attr_table[i].symbol = intern (ae_attr_table[i].name);
5518 staticpro (&ae_attr_table[i].symbol);
5522 defsubr (&Smac_coerce_ae_data);
5523 #if TARGET_API_MAC_CARBON
5524 defsubr (&Smac_get_preference);
5525 defsubr (&Smac_code_convert_string);
5526 defsubr (&Smac_process_hi_command);
5527 #endif
5529 defsubr (&Smac_set_file_creator);
5530 defsubr (&Smac_set_file_type);
5531 defsubr (&Smac_get_file_creator);
5532 defsubr (&Smac_get_file_type);
5533 defsubr (&Sdo_applescript);
5534 defsubr (&Smac_file_name_to_posix);
5535 defsubr (&Sposix_file_name_to_mac);
5537 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code,
5538 doc: /* The system script code. */);
5539 mac_system_script_code = (ScriptCode) GetScriptManagerVariable (smSysScript);
5541 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale,
5542 doc: /* The system locale identifier string.
5543 This is not a POSIX locale ID, but an ICU locale ID. So encoding
5544 information is not included. */);
5545 Vmac_system_locale = mac_get_system_locale ();
5548 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5549 (do not change this comment) */