update copyright year(s)
[bpt/emacs.git] / src / mac.c
CommitLineData
1a578e9b 1/* Unix emulation routines for GNU Emacs on the Mac OS.
0b5538bd 2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
aaef169d 3 2005, 2006 Free Software Foundation, Inc.
1a578e9b
AC
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
1a578e9b 21
e0f712ba 22/* Contributed by Andrew Choi (akochoi@mac.com). */
1a578e9b
AC
23
24#include <config.h>
25
26#include <stdio.h>
27#include <errno.h>
1a578e9b 28
e4959763
YM
29#include "lisp.h"
30#include "process.h"
1fcd1370
YM
31#ifdef MAC_OSX
32#undef select
33#endif
e4959763 34#include "systime.h"
4df24d3b 35#include "sysselect.h"
e4959763
YM
36#include "blockinput.h"
37
38#include "macterm.h"
39
eb32b292
YM
40#include "charset.h"
41#include "coding.h"
908b0456 42#if !TARGET_API_MAC_CARBON
1a578e9b
AC
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 <FixMath.h>
50#include <Timer.h>
51#include <OSA.h>
52#include <AppleScript.h>
e0f712ba 53#include <Scrap.h>
b564370b
YM
54#include <Events.h>
55#include <Processes.h>
56#include <EPPC.h>
42c6741e 57#include <MacLocales.h>
908b0456 58#include <Endian.h>
eb32b292 59#endif /* not TARGET_API_MAC_CARBON */
b564370b
YM
60
61#include <utime.h>
62#include <dirent.h>
63#include <sys/types.h>
64#include <sys/stat.h>
b564370b
YM
65#include <pwd.h>
66#include <grp.h>
67#include <sys/param.h>
b564370b
YM
68#include <fcntl.h>
69#if __MWERKS__
70#include <unistd.h>
71#endif
1a578e9b 72
42c6741e
YM
73/* The system script code. */
74static int mac_system_script_code;
75
76/* The system locale identifier string. */
77static Lisp_Object Vmac_system_locale;
78
1a578e9b
AC
79/* An instance of the AppleScript component. */
80static ComponentInstance as_scripting_component;
81/* The single script context used for all script executions. */
82static OSAID as_script_context;
83
1fcd1370 84#ifndef MAC_OSX
7ce8b638
YM
85static OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *));
86static OSErr fsspec_to_posix_pathname P_ ((const FSSpec *, char *, int));
1fcd1370 87#endif
1a578e9b
AC
88
89/* When converting from Mac to Unix pathnames, /'s in folder names are
90 converted to :'s. This function, used in copying folder names,
91 performs a strncat and converts all character a to b in the copy of
92 the string s2 appended to the end of s1. */
93
94void
95string_cat_and_replace (char *s1, const char *s2, int n, char a, char b)
96{
97 int l1 = strlen (s1);
98 int l2 = strlen (s2);
99 char *p = s1 + l1;
100 int i;
7d0393cf 101
1a578e9b
AC
102 strncat (s1, s2, n);
103 for (i = 0; i < l2; i++)
104 {
105 if (*p == a)
106 *p = b;
107 p++;
108 }
109}
110
111
e0f712ba 112/* Convert a Mac pathname to Posix form. A Mac full pathname is one
1a578e9b 113 that does not begin with a ':' and contains at least one ':'. A Mac
7d0393cf 114 full pathname causes a '/' to be prepended to the Posix pathname.
1a578e9b
AC
115 The algorithm for the rest of the pathname is as follows:
116 For each segment between two ':',
117 if it is non-null, copy as is and then add a '/' at the end,
e0f712ba 118 otherwise, insert a "../" into the Posix pathname.
1a578e9b 119 Returns 1 if successful; 0 if fails. */
7d0393cf 120
1a578e9b 121int
60fe1161 122mac_to_posix_pathname (const char *mfn, char *ufn, int ufnbuflen)
1a578e9b
AC
123{
124 const char *p, *q, *pe;
7d0393cf 125
1a578e9b 126 strcpy (ufn, "");
7d0393cf 127
1a578e9b
AC
128 if (*mfn == '\0')
129 return 1;
7d0393cf 130
1a578e9b
AC
131 p = strchr (mfn, ':');
132 if (p != 0 && p != mfn) /* full pathname */
133 strcat (ufn, "/");
7d0393cf 134
1a578e9b
AC
135 p = mfn;
136 if (*p == ':')
137 p++;
138
139 pe = mfn + strlen (mfn);
140 while (p < pe)
141 {
142 q = strchr (p, ':');
143 if (q)
144 {
145 if (q == p)
146 { /* two consecutive ':' */
147 if (strlen (ufn) + 3 >= ufnbuflen)
148 return 0;
149 strcat (ufn, "../");
150 }
151 else
152 {
153 if (strlen (ufn) + (q - p) + 1 >= ufnbuflen)
154 return 0;
155 string_cat_and_replace (ufn, p, q - p, '/', ':');
156 strcat (ufn, "/");
157 }
158 p = q + 1;
159 }
160 else
161 {
162 if (strlen (ufn) + (pe - p) >= ufnbuflen)
163 return 0;
164 string_cat_and_replace (ufn, p, pe - p, '/', ':');
165 /* no separator for last one */
166 p = pe;
167 }
168 }
7d0393cf 169
1a578e9b
AC
170 return 1;
171}
172
173
174extern char *get_temp_dir_name ();
175
176
e0f712ba 177/* Convert a Posix pathname to Mac form. Approximately reverse of the
1a578e9b 178 above in algorithm. */
7d0393cf 179
1a578e9b 180int
60fe1161 181posix_to_mac_pathname (const char *ufn, char *mfn, int mfnbuflen)
1a578e9b
AC
182{
183 const char *p, *q, *pe;
184 char expanded_pathname[MAXPATHLEN+1];
7d0393cf 185
1a578e9b 186 strcpy (mfn, "");
7d0393cf 187
1a578e9b
AC
188 if (*ufn == '\0')
189 return 1;
190
191 p = ufn;
7d0393cf 192
1a578e9b
AC
193 /* Check for and handle volume names. Last comparison: strangely
194 somewhere "/.emacs" is passed. A temporary fix for now. */
195 if (*p == '/' && strchr (p+1, '/') == NULL && strcmp (p, "/.emacs") != 0)
196 {
197 if (strlen (p) + 1 > mfnbuflen)
198 return 0;
199 strcpy (mfn, p+1);
200 strcat (mfn, ":");
201 return 1;
202 }
203
204 /* expand to emacs dir found by init_emacs_passwd_dir */
205 if (strncmp (p, "~emacs/", 7) == 0)
206 {
207 struct passwd *pw = getpwnam ("emacs");
208 p += 7;
209 if (strlen (pw->pw_dir) + strlen (p) > MAXPATHLEN)
210 return 0;
211 strcpy (expanded_pathname, pw->pw_dir);
212 strcat (expanded_pathname, p);
213 p = expanded_pathname;
214 /* now p points to the pathname with emacs dir prefix */
215 }
216 else if (strncmp (p, "/tmp/", 5) == 0)
217 {
218 char *t = get_temp_dir_name ();
219 p += 5;
220 if (strlen (t) + strlen (p) > MAXPATHLEN)
221 return 0;
222 strcpy (expanded_pathname, t);
223 strcat (expanded_pathname, p);
224 p = expanded_pathname;
225 /* now p points to the pathname with emacs dir prefix */
7d0393cf 226 }
1a578e9b
AC
227 else if (*p != '/') /* relative pathname */
228 strcat (mfn, ":");
7d0393cf 229
1a578e9b
AC
230 if (*p == '/')
231 p++;
232
233 pe = p + strlen (p);
234 while (p < pe)
235 {
236 q = strchr (p, '/');
237 if (q)
238 {
239 if (q - p == 2 && *p == '.' && *(p+1) == '.')
240 {
241 if (strlen (mfn) + 1 >= mfnbuflen)
242 return 0;
243 strcat (mfn, ":");
244 }
245 else
246 {
247 if (strlen (mfn) + (q - p) + 1 >= mfnbuflen)
248 return 0;
249 string_cat_and_replace (mfn, p, q - p, ':', '/');
250 strcat (mfn, ":");
251 }
252 p = q + 1;
253 }
254 else
255 {
256 if (strlen (mfn) + (pe - p) >= mfnbuflen)
257 return 0;
258 string_cat_and_replace (mfn, p, pe - p, ':', '/');
259 p = pe;
260 }
261 }
7d0393cf 262
1a578e9b
AC
263 return 1;
264}
265
e4959763 266\f
31b6888a
YM
267/***********************************************************************
268 Conversions on Apple event objects
269 ***********************************************************************/
270
271static Lisp_Object Qundecoded_file_name;
272
273static Lisp_Object
274mac_aelist_to_lisp (desc_list)
275 AEDescList *desc_list;
276{
277 OSErr err;
278 long count;
279 Lisp_Object result, elem;
280 DescType desc_type;
281 Size size;
282 AEKeyword keyword;
283 AEDesc desc;
284
285 err = AECountItems (desc_list, &count);
286 if (err != noErr)
287 return Qnil;
288 result = Qnil;
289 while (count > 0)
290 {
291 err = AESizeOfNthItem (desc_list, count, &desc_type, &size);
292 if (err == noErr)
293 switch (desc_type)
294 {
295 case typeAEList:
296 case typeAERecord:
297 case typeAppleEvent:
298 err = AEGetNthDesc (desc_list, count, typeWildCard,
299 &keyword, &desc);
300 if (err != noErr)
301 break;
302 elem = mac_aelist_to_lisp (&desc);
303 AEDisposeDesc (&desc);
304 break;
305
306 default:
307 if (desc_type == typeNull)
308 elem = Qnil;
309 else
310 {
311 elem = make_uninit_string (size);
312 err = AEGetNthPtr (desc_list, count, typeWildCard, &keyword,
313 &desc_type, SDATA (elem), size, &size);
314 }
315 if (err != noErr)
316 break;
317 desc_type = EndianU32_NtoB (desc_type);
318 elem = Fcons (make_unibyte_string ((char *) &desc_type, 4), elem);
319 break;
320 }
321
322 if (err != noErr)
323 elem = Qnil;
324 else if (desc_list->descriptorType != typeAEList)
325 {
326 keyword = EndianU32_NtoB (keyword);
327 elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem);
328 }
329
330 result = Fcons (elem, result);
331 count--;
332 }
333
334 desc_type = EndianU32_NtoB (desc_list->descriptorType);
335 return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
336}
337
338Lisp_Object
339mac_aedesc_to_lisp (desc)
340 AEDesc *desc;
341{
7ce8b638 342 OSErr err = noErr;
31b6888a
YM
343 DescType desc_type = desc->descriptorType;
344 Lisp_Object result;
345
346 switch (desc_type)
347 {
348 case typeNull:
349 result = Qnil;
350 break;
351
352 case typeAEList:
353 case typeAERecord:
354 case typeAppleEvent:
355 return mac_aelist_to_lisp (desc);
356#if 0
357 /* The following one is much simpler, but creates and disposes
358 of Apple event descriptors many times. */
359 {
360 long count;
361 Lisp_Object elem;
362 AEKeyword keyword;
363 AEDesc desc1;
364
365 err = AECountItems (desc, &count);
366 if (err != noErr)
367 break;
368 result = Qnil;
369 while (count > 0)
370 {
371 err = AEGetNthDesc (desc, count, typeWildCard, &keyword, &desc1);
372 if (err != noErr)
373 break;
374 elem = mac_aedesc_to_lisp (&desc1);
375 AEDisposeDesc (&desc1);
376 if (desc_type != typeAEList)
377 {
378 keyword = EndianU32_NtoB (keyword);
379 elem = Fcons (make_unibyte_string ((char *) &keyword, 4), elem);
380 }
381 result = Fcons (elem, result);
382 count--;
383 }
384 }
385#endif
386 break;
387
388 default:
389#if TARGET_API_MAC_CARBON
390 result = make_uninit_string (AEGetDescDataSize (desc));
391 err = AEGetDescData (desc, SDATA (result), SBYTES (result));
392#else
393 result = make_uninit_string (GetHandleSize (desc->dataHandle));
394 memcpy (SDATA (result), *(desc->dataHandle), SBYTES (result));
395#endif
396 break;
397 }
398
399 if (err != noErr)
400 return Qnil;
401
402 desc_type = EndianU32_NtoB (desc_type);
403 return Fcons (make_unibyte_string ((char *) &desc_type, 4), result);
404}
405
7ce8b638
YM
406static pascal OSErr
407mac_coerce_file_name_ptr (type_code, data_ptr, data_size,
408 to_type, handler_refcon, result)
409 DescType type_code;
410 const void *data_ptr;
411 Size data_size;
412 DescType to_type;
413 long handler_refcon;
414 AEDesc *result;
415{
416 OSErr err;
417
b9f0075c
YM
418 if (type_code == typeNull)
419 err = errAECoercionFail;
420 else if (type_code == to_type || to_type == typeWildCard)
421 err = AECreateDesc (TYPE_FILE_NAME, data_ptr, data_size, result);
422 else if (type_code == TYPE_FILE_NAME)
7ce8b638 423 /* Coercion from undecoded file name. */
b9f0075c 424 {
7ce8b638 425#ifdef MAC_OSX
b9f0075c
YM
426 CFStringRef str;
427 CFURLRef url = NULL;
428 CFDataRef data = NULL;
7ce8b638 429
b9f0075c
YM
430 str = CFStringCreateWithBytes (NULL, data_ptr, data_size,
431 kCFStringEncodingUTF8, false);
432 if (str)
433 {
434 url = CFURLCreateWithFileSystemPath (NULL, str,
435 kCFURLPOSIXPathStyle, false);
436 CFRelease (str);
437 }
438 if (url)
439 {
440 data = CFURLCreateData (NULL, url, kCFStringEncodingUTF8, true);
441 CFRelease (url);
442 }
443 if (data)
444 {
445 err = AECoercePtr (typeFileURL, CFDataGetBytePtr (data),
446 CFDataGetLength (data), to_type, result);
447 CFRelease (data);
448 }
449 else
450 err = memFullErr;
7ce8b638 451#else
b9f0075c
YM
452 FSSpec fs;
453 char *buf;
7ce8b638 454
b9f0075c 455 buf = xmalloc (data_size + 1);
305366a3
YM
456 memcpy (buf, data_ptr, data_size);
457 buf[data_size] = '\0';
458 err = posix_pathname_to_fsspec (buf, &fs);
459 xfree (buf);
b9f0075c
YM
460 if (err == noErr)
461 err = AECoercePtr (typeFSS, &fs, sizeof (FSSpec), to_type, result);
462#endif
463 }
7ce8b638
YM
464 else if (to_type == TYPE_FILE_NAME)
465 /* Coercion to undecoded file name. */
b9f0075c 466 {
7ce8b638 467#ifdef MAC_OSX
b9f0075c
YM
468 CFURLRef url = NULL;
469 CFStringRef str = NULL;
470 CFDataRef data = NULL;
471
472 if (type_code == typeFileURL)
473 url = CFURLCreateWithBytes (NULL, data_ptr, data_size,
474 kCFStringEncodingUTF8, NULL);
475 else
7ce8b638
YM
476 {
477 AEDesc desc;
7ce8b638
YM
478 Size size;
479 char *buf;
7ce8b638
YM
480
481 err = AECoercePtr (type_code, data_ptr, data_size,
482 typeFileURL, &desc);
483 if (err == noErr)
484 {
485 size = AEGetDescDataSize (&desc);
486 buf = xmalloc (size);
305366a3
YM
487 err = AEGetDescData (&desc, buf, size);
488 if (err == noErr)
489 url = CFURLCreateWithBytes (NULL, buf, size,
490 kCFStringEncodingUTF8, NULL);
491 xfree (buf);
7ce8b638
YM
492 AEDisposeDesc (&desc);
493 }
b9f0075c
YM
494 }
495 if (url)
496 {
497 str = CFURLCopyFileSystemPath (url, kCFURLPOSIXPathStyle);
498 CFRelease (url);
499 }
500 if (str)
501 {
502 data = CFStringCreateExternalRepresentation (NULL, str,
503 kCFStringEncodingUTF8,
504 '\0');
505 CFRelease (str);
506 }
507 if (data)
508 {
509 err = AECreateDesc (TYPE_FILE_NAME, CFDataGetBytePtr (data),
510 CFDataGetLength (data), result);
511 CFRelease (data);
512 }
7ce8b638 513#else
b9f0075c
YM
514 char file_name[MAXPATHLEN];
515
516 if (type_code == typeFSS && data_size == sizeof (FSSpec))
517 err = fsspec_to_posix_pathname (data_ptr, file_name,
518 sizeof (file_name) - 1);
519 else
520 {
521 AEDesc desc;
7ce8b638 522 FSSpec fs;
7ce8b638 523
b9f0075c 524 err = AECoercePtr (type_code, data_ptr, data_size, typeFSS, &desc);
7ce8b638
YM
525 if (err == noErr)
526 {
527#if TARGET_API_MAC_CARBON
528 err = AEGetDescData (&desc, &fs, sizeof (FSSpec));
529#else
530 fs = *(FSSpec *)(*(desc.dataHandle));
531#endif
532 if (err == noErr)
533 err = fsspec_to_posix_pathname (&fs, file_name,
534 sizeof (file_name) - 1);
7ce8b638
YM
535 AEDisposeDesc (&desc);
536 }
7ce8b638 537 }
b9f0075c
YM
538 if (err == noErr)
539 err = AECreateDesc (TYPE_FILE_NAME, file_name,
540 strlen (file_name), result);
541#endif
542 }
7ce8b638
YM
543 else
544 abort ();
545
546 if (err != noErr)
547 return errAECoercionFail;
548 return noErr;
549}
550
551static pascal OSErr
552mac_coerce_file_name_desc (from_desc, to_type, handler_refcon, result)
553 const AEDesc *from_desc;
554 DescType to_type;
555 long handler_refcon;
556 AEDesc *result;
557{
558 OSErr err = noErr;
559 DescType from_type = from_desc->descriptorType;
560
b9f0075c
YM
561 if (from_type == typeNull)
562 err = errAECoercionFail;
563 else if (from_type == to_type || to_type == typeWildCard)
7ce8b638
YM
564 err = AEDuplicateDesc (from_desc, result);
565 else
566 {
567 char *data_ptr;
568 Size data_size;
569
570#if TARGET_API_MAC_CARBON
571 data_size = AEGetDescDataSize (from_desc);
572#else
573 data_size = GetHandleSize (from_desc->dataHandle);
574#endif
575 data_ptr = xmalloc (data_size);
7ce8b638 576#if TARGET_API_MAC_CARBON
305366a3 577 err = AEGetDescData (from_desc, data_ptr, data_size);
7ce8b638 578#else
305366a3 579 memcpy (data_ptr, *(from_desc->dataHandle), data_size);
7ce8b638 580#endif
305366a3
YM
581 if (err == noErr)
582 err = mac_coerce_file_name_ptr (from_type, data_ptr,
583 data_size, to_type,
584 handler_refcon, result);
585 xfree (data_ptr);
7ce8b638
YM
586 }
587
588 if (err != noErr)
589 return errAECoercionFail;
590 return noErr;
591}
592
593OSErr
594init_coercion_handler ()
595{
596 OSErr err;
597
598 static AECoercePtrUPP coerce_file_name_ptrUPP = NULL;
599 static AECoerceDescUPP coerce_file_name_descUPP = NULL;
600
601 if (coerce_file_name_ptrUPP == NULL)
602 {
603 coerce_file_name_ptrUPP = NewAECoercePtrUPP (mac_coerce_file_name_ptr);
604 coerce_file_name_descUPP = NewAECoerceDescUPP (mac_coerce_file_name_desc);
605 }
606
607 err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
608 (AECoercionHandlerUPP)
609 coerce_file_name_ptrUPP, 0, false, false);
610 if (err == noErr)
611 err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
612 (AECoercionHandlerUPP)
613 coerce_file_name_ptrUPP, 0, false, false);
614 if (err == noErr)
615 err = AEInstallCoercionHandler (TYPE_FILE_NAME, typeWildCard,
616 coerce_file_name_descUPP, 0, true, false);
617 if (err == noErr)
618 err = AEInstallCoercionHandler (typeWildCard, TYPE_FILE_NAME,
619 coerce_file_name_descUPP, 0, true, false);
620 return err;
621}
622
31b6888a
YM
623#if TARGET_API_MAC_CARBON
624OSErr
70e88ff1 625create_apple_event_from_event_ref (event, num_params, names, types, result)
31b6888a
YM
626 EventRef event;
627 UInt32 num_params;
628 EventParamName *names;
629 EventParamType *types;
31b6888a
YM
630 AppleEvent *result;
631{
632 OSErr err;
633 static const ProcessSerialNumber psn = {0, kCurrentProcess};
634 AEAddressDesc address_desc;
70e88ff1 635 UInt32 i, size;
31b6888a
YM
636 CFStringRef string;
637 CFDataRef data;
638 char *buf;
639
640 err = AECreateDesc (typeProcessSerialNumber, &psn,
641 sizeof (ProcessSerialNumber), &address_desc);
642 if (err == noErr)
643 {
644 err = AECreateAppleEvent (0, 0, /* Dummy class and ID. */
645 &address_desc, /* NULL is not allowed
646 on Mac OS Classic. */
647 kAutoGenerateReturnID,
648 kAnyTransactionID, result);
649 AEDisposeDesc (&address_desc);
650 }
651 if (err != noErr)
652 return err;
653
654 for (i = 0; i < num_params; i++)
655 switch (types[i])
656 {
657#ifdef MAC_OSX
658 case typeCFStringRef:
659 err = GetEventParameter (event, names[i], typeCFStringRef, NULL,
660 sizeof (CFStringRef), NULL, &string);
661 if (err != noErr)
662 break;
663 data = CFStringCreateExternalRepresentation (NULL, string,
664 kCFStringEncodingUTF8,
665 '?');
666 if (data == NULL)
667 break;
668 /* typeUTF8Text is not available on Mac OS X 10.1. */
669 AEPutParamPtr (result, names[i], 'utf8',
670 CFDataGetBytePtr (data), CFDataGetLength (data));
671 CFRelease (data);
672 break;
673#endif
674
675 default:
70e88ff1
YM
676 err = GetEventParameter (event, names[i], types[i], NULL,
677 0, &size, NULL);
678 if (err != noErr)
679 break;
680 buf = xmalloc (size);
31b6888a 681 err = GetEventParameter (event, names[i], types[i], NULL,
70e88ff1 682 size, NULL, buf);
31b6888a 683 if (err == noErr)
70e88ff1 684 AEPutParamPtr (result, names[i], types[i], buf, size);
31b6888a
YM
685 xfree (buf);
686 break;
687 }
688
689 return noErr;
690}
691#endif
692
693\f
e4959763
YM
694/***********************************************************************
695 Conversion between Lisp and Core Foundation objects
696 ***********************************************************************/
697
d8f96db8 698#if TARGET_API_MAC_CARBON
e4959763
YM
699static Lisp_Object Qstring, Qnumber, Qboolean, Qdate, Qdata;
700static Lisp_Object Qarray, Qdictionary;
e4959763
YM
701
702struct cfdict_context
703{
704 Lisp_Object *result;
705 int with_tag, hash_bound;
706};
707
e8d8317c 708/* C string to CFString. */
e4959763 709
d8f96db8
ST
710CFStringRef
711cfstring_create_with_utf8_cstring (c_str)
712 const char *c_str;
713{
714 CFStringRef str;
715
716 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingUTF8);
717 if (str == NULL)
718 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
719 str = CFStringCreateWithCString (NULL, c_str, kCFStringEncodingMacRoman);
720
721 return str;
722}
e4959763
YM
723
724
e8d8317c
YM
725/* Lisp string to CFString. */
726
727CFStringRef
728cfstring_create_with_string (s)
729 Lisp_Object s;
730{
731 CFStringRef string = NULL;
732
733 if (STRING_MULTIBYTE (s))
734 {
735 char *p, *end = SDATA (s) + SBYTES (s);
736
737 for (p = SDATA (s); p < end; p++)
738 if (!isascii (*p))
739 {
740 s = ENCODE_UTF_8 (s);
741 break;
742 }
743 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
744 kCFStringEncodingUTF8, false);
745 }
746
747 if (string == NULL)
748 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
749 string = CFStringCreateWithBytes (NULL, SDATA (s), SBYTES (s),
750 kCFStringEncodingMacRoman, false);
751
752 return string;
753}
754
755
e4959763
YM
756/* From CFData to a lisp string. Always returns a unibyte string. */
757
758Lisp_Object
759cfdata_to_lisp (data)
760 CFDataRef data;
761{
762 CFIndex len = CFDataGetLength (data);
763 Lisp_Object result = make_uninit_string (len);
eb32b292 764
e4959763
YM
765 CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result));
766
767 return result;
768}
769
770
f997a558
YM
771/* From CFString to a lisp string. Returns a unibyte string
772 containing a UTF-8 byte sequence. */
e4959763
YM
773
774Lisp_Object
f997a558 775cfstring_to_lisp_nodecode (string)
e4959763
YM
776 CFStringRef string;
777{
778 Lisp_Object result = Qnil;
779 const char *s = CFStringGetCStringPtr (string, kCFStringEncodingUTF8);
780
781 if (s)
782 result = make_unibyte_string (s, strlen (s));
783 else
784 {
785 CFDataRef data =
786 CFStringCreateExternalRepresentation (NULL, string,
787 kCFStringEncodingUTF8, '?');
788
789 if (data)
790 {
791 result = cfdata_to_lisp (data);
792 CFRelease (data);
793 }
794 }
795
f997a558
YM
796 return result;
797}
798
799
800/* From CFString to a lisp string. Never returns a unibyte string
801 (even if it only contains ASCII characters).
802 This may cause GC during code conversion. */
803
804Lisp_Object
805cfstring_to_lisp (string)
806 CFStringRef string;
807{
808 Lisp_Object result = cfstring_to_lisp_nodecode (string);
809
e4959763
YM
810 if (!NILP (result))
811 {
f997a558 812 result = code_convert_string_norecord (result, Qutf_8, 0);
e4959763
YM
813 /* This may be superfluous. Just to make sure that the result
814 is a multibyte string. */
815 result = string_to_multibyte (result);
816 }
817
818 return result;
819}
820
821
822/* CFNumber to a lisp integer or a lisp float. */
823
824Lisp_Object
825cfnumber_to_lisp (number)
826 CFNumberRef number;
827{
828 Lisp_Object result = Qnil;
48502d68 829#if BITS_PER_EMACS_INT > 32
e4959763
YM
830 SInt64 int_val;
831 CFNumberType emacs_int_type = kCFNumberSInt64Type;
832#else
833 SInt32 int_val;
834 CFNumberType emacs_int_type = kCFNumberSInt32Type;
d8f96db8 835#endif
e4959763
YM
836 double float_val;
837
838 if (CFNumberGetValue (number, emacs_int_type, &int_val)
839 && !FIXNUM_OVERFLOW_P (int_val))
840 result = make_number (int_val);
841 else
842 if (CFNumberGetValue (number, kCFNumberDoubleType, &float_val))
843 result = make_float (float_val);
844 return result;
845}
846
847
848/* CFDate to a list of three integers as in a return value of
d440d0de 849 `current-time'. */
e4959763
YM
850
851Lisp_Object
852cfdate_to_lisp (date)
853 CFDateRef date;
854{
d440d0de 855 static const CFGregorianDate epoch_gdate = {1970, 1, 1, 0, 0, 0.0};
e4959763
YM
856 static CFAbsoluteTime epoch = 0.0, sec;
857 int high, low;
858
859 if (epoch == 0.0)
860 epoch = CFGregorianDateGetAbsoluteTime (epoch_gdate, NULL);
861
862 sec = CFDateGetAbsoluteTime (date) - epoch;
863 high = sec / 65536.0;
864 low = sec - high * 65536.0;
865
866 return list3 (make_number (high), make_number (low), make_number (0));
867}
868
869
870/* CFBoolean to a lisp symbol, `t' or `nil'. */
871
872Lisp_Object
873cfboolean_to_lisp (boolean)
874 CFBooleanRef boolean;
875{
876 return CFBooleanGetValue (boolean) ? Qt : Qnil;
877}
878
879
880/* Any Core Foundation object to a (lengthy) lisp string. */
881
882Lisp_Object
883cfobject_desc_to_lisp (object)
884 CFTypeRef object;
885{
886 Lisp_Object result = Qnil;
887 CFStringRef desc = CFCopyDescription (object);
888
889 if (desc)
890 {
891 result = cfstring_to_lisp (desc);
892 CFRelease (desc);
893 }
894
895 return result;
896}
897
898
899/* Callback functions for cfproperty_list_to_lisp. */
900
901static void
902cfdictionary_add_to_list (key, value, context)
903 const void *key;
904 const void *value;
905 void *context;
906{
907 struct cfdict_context *cxt = (struct cfdict_context *)context;
908
909 *cxt->result =
910 Fcons (Fcons (cfstring_to_lisp (key),
911 cfproperty_list_to_lisp (value, cxt->with_tag,
912 cxt->hash_bound)),
913 *cxt->result);
914}
915
916static void
917cfdictionary_puthash (key, value, context)
918 const void *key;
919 const void *value;
920 void *context;
921{
922 Lisp_Object lisp_key = cfstring_to_lisp (key);
923 struct cfdict_context *cxt = (struct cfdict_context *)context;
924 struct Lisp_Hash_Table *h = XHASH_TABLE (*(cxt->result));
925 unsigned hash_code;
926
927 hash_lookup (h, lisp_key, &hash_code);
928 hash_put (h, lisp_key,
929 cfproperty_list_to_lisp (value, cxt->with_tag, cxt->hash_bound),
930 hash_code);
931}
932
933
934/* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
935 non-zero, a symbol that represents the type of the original Core
936 Foundation object is prepended. HASH_BOUND specifies which kinds
937 of the lisp objects, alists or hash tables, are used as the targets
938 of the conversion from CFDictionary. If HASH_BOUND is negative,
939 always generate alists. If HASH_BOUND >= 0, generate an alist if
940 the number of keys in the dictionary is smaller than HASH_BOUND,
941 and a hash table otherwise. */
942
943Lisp_Object
944cfproperty_list_to_lisp (plist, with_tag, hash_bound)
945 CFPropertyListRef plist;
946 int with_tag, hash_bound;
947{
948 CFTypeID type_id = CFGetTypeID (plist);
949 Lisp_Object tag = Qnil, result = Qnil;
950 struct gcpro gcpro1, gcpro2;
951
952 GCPRO2 (tag, result);
953
954 if (type_id == CFStringGetTypeID ())
955 {
956 tag = Qstring;
957 result = cfstring_to_lisp (plist);
958 }
959 else if (type_id == CFNumberGetTypeID ())
960 {
961 tag = Qnumber;
962 result = cfnumber_to_lisp (plist);
963 }
964 else if (type_id == CFBooleanGetTypeID ())
965 {
966 tag = Qboolean;
967 result = cfboolean_to_lisp (plist);
968 }
969 else if (type_id == CFDateGetTypeID ())
970 {
971 tag = Qdate;
972 result = cfdate_to_lisp (plist);
973 }
974 else if (type_id == CFDataGetTypeID ())
975 {
976 tag = Qdata;
977 result = cfdata_to_lisp (plist);
978 }
979 else if (type_id == CFArrayGetTypeID ())
980 {
981 CFIndex index, count = CFArrayGetCount (plist);
982
983 tag = Qarray;
984 result = Fmake_vector (make_number (count), Qnil);
985 for (index = 0; index < count; index++)
986 XVECTOR (result)->contents[index] =
987 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist, index),
988 with_tag, hash_bound);
989 }
990 else if (type_id == CFDictionaryGetTypeID ())
991 {
992 struct cfdict_context context;
993 CFIndex count = CFDictionaryGetCount (plist);
994
995 tag = Qdictionary;
996 context.result = &result;
997 context.with_tag = with_tag;
998 context.hash_bound = hash_bound;
999 if (hash_bound < 0 || count < hash_bound)
1000 {
1001 result = Qnil;
1002 CFDictionaryApplyFunction (plist, cfdictionary_add_to_list,
1003 &context);
1004 }
1005 else
1006 {
1007 result = make_hash_table (Qequal,
1008 make_number (count),
1009 make_float (DEFAULT_REHASH_SIZE),
1010 make_float (DEFAULT_REHASH_THRESHOLD),
1011 Qnil, Qnil, Qnil);
1012 CFDictionaryApplyFunction (plist, cfdictionary_puthash,
1013 &context);
1014 }
1015 }
1016 else
1017 abort ();
1018
1019 UNGCPRO;
1020
1021 if (with_tag)
1022 result = Fcons (tag, result);
1023
1024 return result;
1025}
1026#endif
1027
1028\f
1029/***********************************************************************
1030 Emulation of the X Resource Manager
1031 ***********************************************************************/
1032
1033/* Parser functions for resource lines. Each function takes an
1034 address of a variable whose value points to the head of a string.
1035 The value will be advanced so that it points to the next character
1036 of the parsed part when the function returns.
1037
1038 A resource name such as "Emacs*font" is parsed into a non-empty
1039 list called `quarks'. Each element is either a Lisp string that
1040 represents a concrete component, a Lisp symbol LOOSE_BINDING
1041 (actually Qlambda) that represents any number (>=0) of intervening
1042 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
1043 that represents as any single component. */
1044
1045#define P (*p)
1046
1047#define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
1048#define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
1049
1050static void
a3901264 1051skip_white_space (p)
e4959763
YM
1052 char **p;
1053{
1054 /* WhiteSpace = {<space> | <horizontal tab>} */
1055 while (*P == ' ' || *P == '\t')
1056 P++;
1057}
1058
1059static int
1060parse_comment (p)
1061 char **p;
1062{
1063 /* Comment = "!" {<any character except null or newline>} */
1064 if (*P == '!')
1065 {
1066 P++;
1067 while (*P)
1068 if (*P++ == '\n')
1069 break;
1070 return 1;
1071 }
1072 else
1073 return 0;
1074}
1075
1076/* Don't interpret filename. Just skip until the newline. */
1077static int
1078parse_include_file (p)
1079 char **p;
1080{
1081 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
1082 if (*P == '#')
1083 {
1084 P++;
1085 while (*P)
1086 if (*P++ == '\n')
1087 break;
1088 return 1;
1089 }
1090 else
1091 return 0;
1092}
1093
1094static char
1095parse_binding (p)
1096 char **p;
1097{
1098 /* Binding = "." | "*" */
1099 if (*P == '.' || *P == '*')
1100 {
1101 char binding = *P++;
1102
1103 while (*P == '.' || *P == '*')
1104 if (*P++ == '*')
1105 binding = '*';
1106 return binding;
1107 }
1108 else
1109 return '\0';
1110}
1111
1112static Lisp_Object
1113parse_component (p)
1114 char **p;
1115{
1116 /* Component = "?" | ComponentName
1117 ComponentName = NameChar {NameChar}
1118 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
1119 if (*P == '?')
1120 {
1121 P++;
1122 return SINGLE_COMPONENT;
1123 }
1124 else if (isalnum (*P) || *P == '_' || *P == '-')
1125 {
1126 char *start = P++;
1127
1128 while (isalnum (*P) || *P == '_' || *P == '-')
1129 P++;
1130
1131 return make_unibyte_string (start, P - start);
1132 }
1133 else
1134 return Qnil;
1135}
1136
1137static Lisp_Object
1138parse_resource_name (p)
1139 char **p;
1140{
1141 Lisp_Object result = Qnil, component;
1142 char binding;
1143
1144 /* ResourceName = [Binding] {Component Binding} ComponentName */
1145 if (parse_binding (p) == '*')
1146 result = Fcons (LOOSE_BINDING, result);
1147
1148 component = parse_component (p);
1149 if (NILP (component))
1150 return Qnil;
1151
48502d68 1152 result = Fcons (component, result);
d440d0de 1153 while ((binding = parse_binding (p)) != '\0')
e4959763
YM
1154 {
1155 if (binding == '*')
1156 result = Fcons (LOOSE_BINDING, result);
1157 component = parse_component (p);
1158 if (NILP (component))
1159 return Qnil;
1160 else
1161 result = Fcons (component, result);
1162 }
48502d68 1163
e4959763
YM
1164 /* The final component should not be '?'. */
1165 if (EQ (component, SINGLE_COMPONENT))
1166 return Qnil;
1167
1168 return Fnreverse (result);
1169}
1170
1171static Lisp_Object
1172parse_value (p)
1173 char **p;
1174{
1175 char *q, *buf;
1176 Lisp_Object seq = Qnil, result;
1177 int buf_len, total_len = 0, len, continue_p;
d8f96db8 1178
e4959763
YM
1179 q = strchr (P, '\n');
1180 buf_len = q ? q - P : strlen (P);
1181 buf = xmalloc (buf_len);
1182
1183 while (1)
1184 {
1185 q = buf;
1186 continue_p = 0;
1187 while (*P)
1188 {
1189 if (*P == '\n')
1190 {
1191 P++;
1192 break;
1193 }
1194 else if (*P == '\\')
1195 {
1196 P++;
1197 if (*P == '\0')
1198 break;
1199 else if (*P == '\n')
1200 {
1201 P++;
1202 continue_p = 1;
1203 break;
1204 }
1205 else if (*P == 'n')
1206 {
1207 *q++ = '\n';
1208 P++;
1209 }
1210 else if ('0' <= P[0] && P[0] <= '7'
1211 && '0' <= P[1] && P[1] <= '7'
1212 && '0' <= P[2] && P[2] <= '7')
1213 {
1fcd1370 1214 *q++ = ((P[0] - '0') << 6) + ((P[1] - '0') << 3) + (P[2] - '0');
e4959763
YM
1215 P += 3;
1216 }
1217 else
1218 *q++ = *P++;
1219 }
1220 else
1221 *q++ = *P++;
1222 }
1223 len = q - buf;
1224 seq = Fcons (make_unibyte_string (buf, len), seq);
1225 total_len += len;
1226
1227 if (continue_p)
1228 {
1229 q = strchr (P, '\n');
1230 len = q ? q - P : strlen (P);
1231 if (len > buf_len)
1232 {
1233 xfree (buf);
1234 buf_len = len;
1235 buf = xmalloc (buf_len);
1236 }
1237 }
1238 else
1239 break;
1240 }
1241 xfree (buf);
1242
1243 if (SBYTES (XCAR (seq)) == total_len)
1244 return make_string (SDATA (XCAR (seq)), total_len);
1245 else
1246 {
1247 buf = xmalloc (total_len);
1248 q = buf + total_len;
1249 for (; CONSP (seq); seq = XCDR (seq))
1250 {
48502d68 1251 len = SBYTES (XCAR (seq));
e4959763
YM
1252 q -= len;
1253 memcpy (q, SDATA (XCAR (seq)), len);
1254 }
1255 result = make_string (buf, total_len);
1256 xfree (buf);
1257 return result;
1258 }
1259}
1260
1261static Lisp_Object
1262parse_resource_line (p)
1263 char **p;
1264{
1265 Lisp_Object quarks, value;
1266
1267 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
1268 if (parse_comment (p) || parse_include_file (p))
1269 return Qnil;
1270
1271 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
a3901264 1272 skip_white_space (p);
e4959763
YM
1273 quarks = parse_resource_name (p);
1274 if (NILP (quarks))
1275 goto cleanup;
a3901264 1276 skip_white_space (p);
e4959763
YM
1277 if (*P != ':')
1278 goto cleanup;
1279 P++;
a3901264 1280 skip_white_space (p);
e4959763
YM
1281 value = parse_value (p);
1282 return Fcons (quarks, value);
1283
1284 cleanup:
1285 /* Skip the remaining data as a dummy value. */
1286 parse_value (p);
1287 return Qnil;
1288}
1289
1290#undef P
1291
1292/* Equivalents of X Resource Manager functions.
1293
1294 An X Resource Database acts as a collection of resource names and
1295 associated values. It is implemented as a trie on quarks. Namely,
1296 each edge is labeled by either a string, LOOSE_BINDING, or
48502d68
YM
1297 SINGLE_COMPONENT. Each node has a node id, which is a unique
1298 nonnegative integer, and the root node id is 0. A database is
1299 implemented as a hash table that maps a pair (SRC-NODE-ID .
1300 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
1301 in the table as a value for HASHKEY_MAX_NID. A value associated to
fc09d07f
YM
1302 a node is recorded as a value for the node id.
1303
1304 A database also has a cache for past queries as a value for
1305 HASHKEY_QUERY_CACHE. It is another hash table that maps
1306 "NAME-STRING\0CLASS-STRING" to the result of the query. */
e4959763 1307
48502d68 1308#define HASHKEY_MAX_NID (make_number (0))
fc09d07f 1309#define HASHKEY_QUERY_CACHE (make_number (-1))
e4959763
YM
1310
1311static XrmDatabase
1312xrm_create_database ()
1313{
48502d68
YM
1314 XrmDatabase database;
1315
1316 database = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1317 make_float (DEFAULT_REHASH_SIZE),
1318 make_float (DEFAULT_REHASH_THRESHOLD),
1319 Qnil, Qnil, Qnil);
1320 Fputhash (HASHKEY_MAX_NID, make_number (0), database);
fc09d07f 1321 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
48502d68
YM
1322
1323 return database;
e4959763
YM
1324}
1325
1326static void
1327xrm_q_put_resource (database, quarks, value)
1328 XrmDatabase database;
1329 Lisp_Object quarks, value;
1330{
48502d68 1331 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
e4959763 1332 unsigned hash_code;
48502d68
YM
1333 int max_nid, i;
1334 Lisp_Object node_id, key;
1335
1336 max_nid = XINT (Fgethash (HASHKEY_MAX_NID, database, Qnil));
e4959763 1337
48502d68 1338 XSETINT (node_id, 0);
e4959763
YM
1339 for (; CONSP (quarks); quarks = XCDR (quarks))
1340 {
48502d68
YM
1341 key = Fcons (node_id, XCAR (quarks));
1342 i = hash_lookup (h, key, &hash_code);
e4959763
YM
1343 if (i < 0)
1344 {
48502d68 1345 max_nid++;
eb32b292 1346 XSETINT (node_id, max_nid);
48502d68 1347 hash_put (h, key, node_id, hash_code);
e4959763
YM
1348 }
1349 else
48502d68 1350 node_id = HASH_VALUE (h, i);
e4959763 1351 }
48502d68 1352 Fputhash (node_id, value, database);
e4959763 1353
48502d68 1354 Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database);
fc09d07f 1355 Fputhash (HASHKEY_QUERY_CACHE, Qnil, database);
e4959763
YM
1356}
1357
1358/* Merge multiple resource entries specified by DATA into a resource
1359 database DATABASE. DATA points to the head of a null-terminated
1360 string consisting of multiple resource lines. It's like a
1361 combination of XrmGetStringDatabase and XrmMergeDatabases. */
1362
1363void
1364xrm_merge_string_database (database, data)
1365 XrmDatabase database;
1366 char *data;
1367{
1368 Lisp_Object quarks_value;
1369
1370 while (*data)
1371 {
1372 quarks_value = parse_resource_line (&data);
1373 if (!NILP (quarks_value))
1374 xrm_q_put_resource (database,
1375 XCAR (quarks_value), XCDR (quarks_value));
1376 }
1377}
1378
1379static Lisp_Object
48502d68 1380xrm_q_get_resource_1 (database, node_id, quark_name, quark_class)
e4959763 1381 XrmDatabase database;
48502d68 1382 Lisp_Object node_id, quark_name, quark_class;
e4959763
YM
1383{
1384 struct Lisp_Hash_Table *h = XHASH_TABLE (database);
48502d68 1385 Lisp_Object key, labels[3], value;
e4959763 1386 int i, k;
48502d68 1387
e4959763 1388 if (!CONSP (quark_name))
48502d68
YM
1389 return Fgethash (node_id, database, Qnil);
1390
e4959763 1391 /* First, try tight bindings */
48502d68
YM
1392 labels[0] = XCAR (quark_name);
1393 labels[1] = XCAR (quark_class);
1394 labels[2] = SINGLE_COMPONENT;
e4959763 1395
48502d68
YM
1396 key = Fcons (node_id, Qnil);
1397 for (k = 0; k < sizeof (labels) / sizeof (*labels); k++)
e4959763 1398 {
48502d68
YM
1399 XSETCDR (key, labels[k]);
1400 i = hash_lookup (h, key, NULL);
e4959763
YM
1401 if (i >= 0)
1402 {
48502d68
YM
1403 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1404 XCDR (quark_name), XCDR (quark_class));
e4959763
YM
1405 if (!NILP (value))
1406 return value;
1407 }
1408 }
1409
1410 /* Then, try loose bindings */
48502d68
YM
1411 XSETCDR (key, LOOSE_BINDING);
1412 i = hash_lookup (h, key, NULL);
e4959763
YM
1413 if (i >= 0)
1414 {
48502d68
YM
1415 value = xrm_q_get_resource_1 (database, HASH_VALUE (h, i),
1416 quark_name, quark_class);
e4959763
YM
1417 if (!NILP (value))
1418 return value;
1419 else
48502d68
YM
1420 return xrm_q_get_resource_1 (database, node_id,
1421 XCDR (quark_name), XCDR (quark_class));
e4959763
YM
1422 }
1423 else
1424 return Qnil;
1425}
1426
48502d68
YM
1427static Lisp_Object
1428xrm_q_get_resource (database, quark_name, quark_class)
1429 XrmDatabase database;
1430 Lisp_Object quark_name, quark_class;
1431{
1432 return xrm_q_get_resource_1 (database, make_number (0),
1433 quark_name, quark_class);
1434}
1435
e4959763
YM
1436/* Retrieve a resource value for the specified NAME and CLASS from the
1437 resource database DATABASE. It corresponds to XrmGetResource. */
1438
1439Lisp_Object
1440xrm_get_resource (database, name, class)
1441 XrmDatabase database;
1442 char *name, *class;
1443{
fc09d07f
YM
1444 Lisp_Object key, query_cache, quark_name, quark_class, tmp;
1445 int i, nn, nc;
1446 struct Lisp_Hash_Table *h;
1447 unsigned hash_code;
1448
1449 nn = strlen (name);
1450 nc = strlen (class);
1451 key = make_uninit_string (nn + nc + 1);
1452 strcpy (SDATA (key), name);
1453 strncpy (SDATA (key) + nn + 1, class, nc);
1454
1455 query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil);
1456 if (NILP (query_cache))
1457 {
1458 query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
1459 make_float (DEFAULT_REHASH_SIZE),
1460 make_float (DEFAULT_REHASH_THRESHOLD),
1461 Qnil, Qnil, Qnil);
1462 Fputhash (HASHKEY_QUERY_CACHE, query_cache, database);
1463 }
1464 h = XHASH_TABLE (query_cache);
1465 i = hash_lookup (h, key, &hash_code);
1466 if (i >= 0)
1467 return HASH_VALUE (h, i);
e4959763
YM
1468
1469 quark_name = parse_resource_name (&name);
1470 if (*name != '\0')
1471 return Qnil;
1472 for (tmp = quark_name, nn = 0; CONSP (tmp); tmp = XCDR (tmp), nn++)
1473 if (!STRINGP (XCAR (tmp)))
1474 return Qnil;
1475
1476 quark_class = parse_resource_name (&class);
1477 if (*class != '\0')
1478 return Qnil;
1479 for (tmp = quark_class, nc = 0; CONSP (tmp); tmp = XCDR (tmp), nc++)
1480 if (!STRINGP (XCAR (tmp)))
1481 return Qnil;
1482
1483 if (nn != nc)
1484 return Qnil;
1485 else
fc09d07f
YM
1486 {
1487 tmp = xrm_q_get_resource (database, quark_name, quark_class);
1488 hash_put (h, key, tmp, hash_code);
1489 return tmp;
1490 }
e4959763
YM
1491}
1492
1493#if TARGET_API_MAC_CARBON
1494static Lisp_Object
1495xrm_cfproperty_list_to_value (plist)
1496 CFPropertyListRef plist;
1497{
1498 CFTypeID type_id = CFGetTypeID (plist);
1499
1500 if (type_id == CFStringGetTypeID ())
908b0456 1501 return cfstring_to_lisp (plist);
e4959763
YM
1502 else if (type_id == CFNumberGetTypeID ())
1503 {
1504 CFStringRef string;
1505 Lisp_Object result = Qnil;
1506
1507 string = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@"), plist);
1508 if (string)
1509 {
1510 result = cfstring_to_lisp (string);
1511 CFRelease (string);
1512 }
1513 return result;
1514 }
1515 else if (type_id == CFBooleanGetTypeID ())
48502d68 1516 return build_string (CFBooleanGetValue (plist) ? "true" : "false");
e4959763
YM
1517 else if (type_id == CFDataGetTypeID ())
1518 return cfdata_to_lisp (plist);
1519 else
1520 return Qnil;
1521}
1522#endif
1523
1524/* Create a new resource database from the preferences for the
1525 application APPLICATION. APPLICATION is either a string that
1526 specifies an application ID, or NULL that represents the current
1527 application. */
1528
1529XrmDatabase
1530xrm_get_preference_database (application)
1531 char *application;
1532{
1533#if TARGET_API_MAC_CARBON
1534 CFStringRef app_id, *keys, user_doms[2], host_doms[2];
1535 CFMutableSetRef key_set = NULL;
1536 CFArrayRef key_array;
1537 CFIndex index, count;
1538 char *res_name;
1539 XrmDatabase database;
1540 Lisp_Object quarks = Qnil, value = Qnil;
1541 CFPropertyListRef plist;
1542 int iu, ih;
1543 struct gcpro gcpro1, gcpro2, gcpro3;
1544
1545 user_doms[0] = kCFPreferencesCurrentUser;
1546 user_doms[1] = kCFPreferencesAnyUser;
1547 host_doms[0] = kCFPreferencesCurrentHost;
1548 host_doms[1] = kCFPreferencesAnyHost;
1549
1550 database = xrm_create_database ();
1551
1552 GCPRO3 (database, quarks, value);
1553
1554 BLOCK_INPUT;
1555
1556 app_id = kCFPreferencesCurrentApplication;
1557 if (application)
1558 {
1559 app_id = cfstring_create_with_utf8_cstring (application);
1560 if (app_id == NULL)
1561 goto out;
1562 }
1563
1564 key_set = CFSetCreateMutable (NULL, 0, &kCFCopyStringSetCallBacks);
1565 if (key_set == NULL)
1566 goto out;
1567 for (iu = 0; iu < sizeof (user_doms) / sizeof (*user_doms) ; iu++)
1568 for (ih = 0; ih < sizeof (host_doms) / sizeof (*host_doms); ih++)
1569 {
1570 key_array = CFPreferencesCopyKeyList (app_id, user_doms[iu],
1571 host_doms[ih]);
1572 if (key_array)
1573 {
1574 count = CFArrayGetCount (key_array);
1575 for (index = 0; index < count; index++)
1576 CFSetAddValue (key_set,
1577 CFArrayGetValueAtIndex (key_array, index));
1578 CFRelease (key_array);
1579 }
1580 }
1581
1582 count = CFSetGetCount (key_set);
1583 keys = xmalloc (sizeof (CFStringRef) * count);
e4959763
YM
1584 CFSetGetValues (key_set, (const void **)keys);
1585 for (index = 0; index < count; index++)
1586 {
f997a558 1587 res_name = SDATA (cfstring_to_lisp_nodecode (keys[index]));
e4959763
YM
1588 quarks = parse_resource_name (&res_name);
1589 if (!(NILP (quarks) || *res_name))
1590 {
1591 plist = CFPreferencesCopyAppValue (keys[index], app_id);
1592 value = xrm_cfproperty_list_to_value (plist);
1593 CFRelease (plist);
1594 if (!NILP (value))
1595 xrm_q_put_resource (database, quarks, value);
1596 }
1597 }
1598
1599 xfree (keys);
1600 out:
1601 if (key_set)
1602 CFRelease (key_set);
1603 CFRelease (app_id);
1604
1605 UNBLOCK_INPUT;
1606
1607 UNGCPRO;
1608
1609 return database;
1610#else
1611 return xrm_create_database ();
1612#endif
1613}
1614
1615\f
e0f712ba 1616#ifndef MAC_OSX
1a578e9b
AC
1617
1618/* The following functions with "sys_" prefix are stubs to Unix
1619 functions that have already been implemented by CW or MPW. The
1620 calls to them in Emacs source course are #define'd to call the sys_
1621 versions by the header files s-mac.h. In these stubs pathnames are
1622 converted between their Unix and Mac forms. */
1623
1624
1625/* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1626 + 17 leap days. These are for adjusting time values returned by
1627 MacOS Toolbox functions. */
1628
1629#define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1630
1631#ifdef __MWERKS__
e0f712ba 1632#if __MSL__ < 0x6000
1a578e9b
AC
1633/* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1634 a leap year! This is for adjusting time_t values returned by MSL
1635 functions. */
1636#define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
e0f712ba
AC
1637#else /* __MSL__ >= 0x6000 */
1638/* CW changes Pro 6 to follow Unix! */
1a578e9b 1639#define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
e0f712ba 1640#endif /* __MSL__ >= 0x6000 */
1a578e9b
AC
1641#elif __MRC__
1642/* MPW library functions follow Unix (confused?). */
1643#define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
e0f712ba 1644#else /* not __MRC__ */
1a578e9b 1645You lose!!!
e0f712ba 1646#endif /* not __MRC__ */
1a578e9b
AC
1647
1648
1649/* Define our own stat function for both MrC and CW. The reason for
1650 doing this: "stat" is both the name of a struct and function name:
1651 can't use the same trick like that for sys_open, sys_close, etc. to
1652 redirect Emacs's calls to our own version that converts Unix style
1653 filenames to Mac style filename because all sorts of compilation
1654 errors will be generated if stat is #define'd to be sys_stat. */
1655
1656int
1657stat_noalias (const char *path, struct stat *buf)
1658{
1659 char mac_pathname[MAXPATHLEN+1];
1660 CInfoPBRec cipb;
1661
60fe1161 1662 if (posix_to_mac_pathname (path, mac_pathname, MAXPATHLEN+1) == 0)
1a578e9b
AC
1663 return -1;
1664
1665 c2pstr (mac_pathname);
1666 cipb.hFileInfo.ioNamePtr = mac_pathname;
1667 cipb.hFileInfo.ioVRefNum = 0;
1668 cipb.hFileInfo.ioDirID = 0;
1669 cipb.hFileInfo.ioFDirIndex = 0;
1670 /* set to 0 to get information about specific dir or file */
7d0393cf 1671
1a578e9b
AC
1672 errno = PBGetCatInfo (&cipb, false);
1673 if (errno == -43) /* -43: fnfErr defined in Errors.h */
1674 errno = ENOENT;
1675 if (errno != noErr)
1676 return -1;
1677
1678 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
1679 {
1680 buf->st_mode = S_IFDIR | S_IREAD | S_IEXEC;
7d0393cf 1681
1a578e9b
AC
1682 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1683 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1684 buf->st_ino = cipb.dirInfo.ioDrDirID;
1685 buf->st_dev = cipb.dirInfo.ioVRefNum;
1686 buf->st_size = cipb.dirInfo.ioDrNmFls;
1687 /* size of dir = number of files and dirs */
1688 buf->st_atime
1689 = buf->st_mtime
1690 = cipb.dirInfo.ioDrMdDat - MAC_UNIX_EPOCH_DIFF;
1691 buf->st_ctime = cipb.dirInfo.ioDrCrDat - MAC_UNIX_EPOCH_DIFF;
1692 }
1693 else
1694 {
1695 buf->st_mode = S_IFREG | S_IREAD;
1696 if (!(cipb.hFileInfo.ioFlAttrib & 0x1))
1697 buf->st_mode |= S_IWRITE; /* bit 1 = 1 for locked files/directories */
1698 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
1699 buf->st_mode |= S_IEXEC;
1700 buf->st_ino = cipb.hFileInfo.ioDirID;
1701 buf->st_dev = cipb.hFileInfo.ioVRefNum;
1702 buf->st_size = cipb.hFileInfo.ioFlLgLen;
1703 buf->st_atime
1704 = buf->st_mtime
1705 = cipb.hFileInfo.ioFlMdDat - MAC_UNIX_EPOCH_DIFF;
1706 buf->st_ctime = cipb.hFileInfo.ioFlCrDat - MAC_UNIX_EPOCH_DIFF;
1707 }
1708
1709 if (cipb.hFileInfo.ioFlFndrInfo.fdFlags & 0x8000)
1710 {
1711 /* identify alias files as symlinks */
1a578e9b 1712 buf->st_mode &= ~S_IFREG;
3b6944ed 1713 buf->st_mode |= S_IFLNK;
1a578e9b
AC
1714 }
1715
1716 buf->st_nlink = 1;
1717 buf->st_uid = getuid ();
1718 buf->st_gid = getgid ();
1719 buf->st_rdev = 0;
1720
1721 return 0;
1722}
1723
1724
1725int
1726lstat (const char *path, struct stat *buf)
1727{
1728 int result;
1729 char true_pathname[MAXPATHLEN+1];
1730
1731 /* Try looking for the file without resolving aliases first. */
1732 if ((result = stat_noalias (path, buf)) >= 0)
1733 return result;
1734
1735 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1736 return -1;
7d0393cf 1737
1a578e9b
AC
1738 return stat_noalias (true_pathname, buf);
1739}
1740
1741
1742int
1743stat (const char *path, struct stat *sb)
1744{
1745 int result;
7d0393cf 1746 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b 1747 int len;
7d0393cf 1748
3b6944ed
AC
1749 if ((result = stat_noalias (path, sb)) >= 0 &&
1750 ! (sb->st_mode & S_IFLNK))
1a578e9b
AC
1751 return result;
1752
1753 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1754 return -1;
7d0393cf 1755
1a578e9b
AC
1756 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
1757 if (len > -1)
1758 {
1759 fully_resolved_name[len] = '\0';
1760 /* in fact our readlink terminates strings */
1761 return lstat (fully_resolved_name, sb);
1762 }
1763 else
1764 return lstat (true_pathname, sb);
1765}
1766
1767
1768#if __MRC__
1769/* CW defines fstat in stat.mac.c while MPW does not provide this
1770 function. Without the information of how to get from a file
1771 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1772 to implement this function. Fortunately, there is only one place
1773 where this function is called in our configuration: in fileio.c,
1774 where only the st_dev and st_ino fields are used to determine
1775 whether two fildes point to different i-nodes to prevent copying
1776 a file onto itself equal. What we have here probably needs
1777 improvement. */
1778
1779int
1780fstat (int fildes, struct stat *buf)
1781{
1782 buf->st_dev = 0;
1783 buf->st_ino = fildes;
1784 buf->st_mode = S_IFREG; /* added by T.I. for the copy-file */
1785 return 0; /* success */
1786}
1787#endif /* __MRC__ */
1788
1789
1a578e9b
AC
1790int
1791mkdir (const char *dirname, int mode)
1792{
1793#pragma unused(mode)
1794
1795 HFileParam hfpb;
1796 char true_pathname[MAXPATHLEN+1], mac_pathname[MAXPATHLEN+1];
7d0393cf 1797
1a578e9b
AC
1798 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
1799 return -1;
7d0393cf 1800
60fe1161 1801 if (posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1) == 0)
1a578e9b
AC
1802 return -1;
1803
1804 c2pstr (mac_pathname);
1805 hfpb.ioNamePtr = mac_pathname;
1806 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
1807 hfpb.ioDirID = 0; /* parent is the root */
7d0393cf 1808
1a578e9b
AC
1809 errno = PBDirCreate ((HParmBlkPtr) &hfpb, false);
1810 /* just return the Mac OSErr code for now */
1811 return errno == noErr ? 0 : -1;
1812}
1813
1814
1815#undef rmdir
1816sys_rmdir (const char *dirname)
1817{
1818 HFileParam hfpb;
1819 char mac_pathname[MAXPATHLEN+1];
7d0393cf 1820
60fe1161 1821 if (posix_to_mac_pathname (dirname, mac_pathname, MAXPATHLEN+1) == 0)
1a578e9b
AC
1822 return -1;
1823
1824 c2pstr (mac_pathname);
1825 hfpb.ioNamePtr = mac_pathname;
1826 hfpb.ioVRefNum = 0; /* ignored unless name is invalid */
1827 hfpb.ioDirID = 0; /* parent is the root */
7d0393cf 1828
1a578e9b
AC
1829 errno = PBHDelete ((HParmBlkPtr) &hfpb, false);
1830 return errno == noErr ? 0 : -1;
1831}
1832
1833
1834#ifdef __MRC__
1835/* No implementation yet. */
1836int
1837execvp (const char *path, ...)
1838{
1839 return -1;
1840}
1841#endif /* __MRC__ */
1842
1843
1844int
1845utime (const char *path, const struct utimbuf *times)
1846{
7d0393cf 1847 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
1848 int len;
1849 char mac_pathname[MAXPATHLEN+1];
1850 CInfoPBRec cipb;
7d0393cf 1851
1a578e9b
AC
1852 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1853 return -1;
7d0393cf 1854
1a578e9b
AC
1855 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
1856 if (len > -1)
1857 fully_resolved_name[len] = '\0';
1858 else
1859 strcpy (fully_resolved_name, true_pathname);
1860
60fe1161 1861 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
1862 return -1;
1863
1864 c2pstr (mac_pathname);
1865 cipb.hFileInfo.ioNamePtr = mac_pathname;
1866 cipb.hFileInfo.ioVRefNum = 0;
1867 cipb.hFileInfo.ioDirID = 0;
7d0393cf 1868 cipb.hFileInfo.ioFDirIndex = 0;
1a578e9b 1869 /* set to 0 to get information about specific dir or file */
7d0393cf 1870
1a578e9b
AC
1871 errno = PBGetCatInfo (&cipb, false);
1872 if (errno != noErr)
1873 return -1;
1874
1875 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* bit 4 = 1 for directories */
1876 {
1877 if (times)
1878 cipb.dirInfo.ioDrMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
1879 else
1880 GetDateTime (&cipb.dirInfo.ioDrMdDat);
1881 }
1882 else
1883 {
1884 if (times)
1885 cipb.hFileInfo.ioFlMdDat = times->modtime + MAC_UNIX_EPOCH_DIFF;
1886 else
1887 GetDateTime (&cipb.hFileInfo.ioFlMdDat);
1888 }
1889
1890 errno = PBSetCatInfo (&cipb, false);
1891 return errno == noErr ? 0 : -1;
1892}
1893
1894
1895#ifndef F_OK
1896#define F_OK 0
1897#endif
1898#ifndef X_OK
1899#define X_OK 1
1900#endif
1901#ifndef W_OK
1902#define W_OK 2
1903#endif
1904
1905/* Like stat, but test for access mode in hfpb.ioFlAttrib */
1906int
1907access (const char *path, int mode)
1908{
7d0393cf 1909 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
1910 int len;
1911 char mac_pathname[MAXPATHLEN+1];
1912 CInfoPBRec cipb;
7d0393cf 1913
1a578e9b
AC
1914 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1915 return -1;
7d0393cf 1916
1a578e9b
AC
1917 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
1918 if (len > -1)
1919 fully_resolved_name[len] = '\0';
1920 else
1921 strcpy (fully_resolved_name, true_pathname);
1922
60fe1161 1923 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
1924 return -1;
1925
1926 c2pstr (mac_pathname);
1927 cipb.hFileInfo.ioNamePtr = mac_pathname;
1928 cipb.hFileInfo.ioVRefNum = 0;
1929 cipb.hFileInfo.ioDirID = 0;
1930 cipb.hFileInfo.ioFDirIndex = 0;
1931 /* set to 0 to get information about specific dir or file */
7d0393cf 1932
1a578e9b
AC
1933 errno = PBGetCatInfo (&cipb, false);
1934 if (errno != noErr)
1935 return -1;
1936
1937 if (mode == F_OK) /* got this far, file exists */
1938 return 0;
1939
1940 if (mode & X_OK)
1941 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* path refers to a directory */
1942 return 0;
1943 else
1944 {
1945 if (cipb.hFileInfo.ioFlFndrInfo.fdType == 'APPL')
1946 return 0;
1947 else
1948 return -1;
1949 }
1950
1951 if (mode & W_OK)
1952 return (cipb.hFileInfo.ioFlAttrib & 0x1) ? -1 : 0;
1953 /* don't allow if lock bit is on */
1954
1955 return -1;
1956}
1957
1958
1959#define DEV_NULL_FD 0x10000
1960
1961#undef open
1962int
1963sys_open (const char *path, int oflag)
1964{
7d0393cf 1965 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
1966 int len;
1967 char mac_pathname[MAXPATHLEN+1];
7d0393cf 1968
1a578e9b
AC
1969 if (strcmp (path, "/dev/null") == 0)
1970 return DEV_NULL_FD; /* some bogus fd to be ignored in write */
7d0393cf 1971
1a578e9b
AC
1972 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
1973 return -1;
7d0393cf 1974
1a578e9b
AC
1975 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
1976 if (len > -1)
1977 fully_resolved_name[len] = '\0';
1978 else
1979 strcpy (fully_resolved_name, true_pathname);
1980
60fe1161 1981 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
1982 return -1;
1983 else
1984 {
1985#ifdef __MRC__
3b6944ed
AC
1986 int res = open (mac_pathname, oflag);
1987 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1988 if (oflag & O_CREAT)
1a578e9b 1989 fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
3b6944ed 1990 return res;
e0f712ba 1991#else /* not __MRC__ */
1a578e9b 1992 return open (mac_pathname, oflag);
e0f712ba 1993#endif /* not __MRC__ */
1a578e9b
AC
1994 }
1995}
1996
1997
1998#undef creat
1999int
2000sys_creat (const char *path, mode_t mode)
2001{
7d0393cf 2002 char true_pathname[MAXPATHLEN+1];
1a578e9b
AC
2003 int len;
2004 char mac_pathname[MAXPATHLEN+1];
7d0393cf 2005
1a578e9b
AC
2006 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2007 return -1;
2008
60fe1161 2009 if (!posix_to_mac_pathname (true_pathname, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
2010 return -1;
2011 else
2012 {
2013#ifdef __MRC__
2014 int result = creat (mac_pathname);
2015 fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
2016 return result;
e0f712ba 2017#else /* not __MRC__ */
1a578e9b 2018 return creat (mac_pathname, mode);
e0f712ba 2019#endif /* not __MRC__ */
1a578e9b
AC
2020 }
2021}
2022
2023
2024#undef unlink
2025int
2026sys_unlink (const char *path)
2027{
7d0393cf 2028 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
2029 int len;
2030 char mac_pathname[MAXPATHLEN+1];
7d0393cf 2031
1a578e9b
AC
2032 if (find_true_pathname (path, true_pathname, MAXPATHLEN+1) == -1)
2033 return -1;
7d0393cf 2034
1a578e9b
AC
2035 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2036 if (len > -1)
2037 fully_resolved_name[len] = '\0';
2038 else
2039 strcpy (fully_resolved_name, true_pathname);
2040
60fe1161 2041 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
2042 return -1;
2043 else
2044 return unlink (mac_pathname);
2045}
2046
2047
2048#undef read
2049int
2050sys_read (int fildes, char *buf, int count)
2051{
2052 if (fildes == 0) /* this should not be used for console input */
2053 return -1;
2054 else
e0f712ba 2055#if __MSL__ >= 0x6000
1a578e9b
AC
2056 return _read (fildes, buf, count);
2057#else
2058 return read (fildes, buf, count);
2059#endif
2060}
2061
2062
2063#undef write
2064int
2065sys_write (int fildes, const char *buf, int count)
2066{
2067 if (fildes == DEV_NULL_FD)
2068 return count;
2069 else
e0f712ba 2070#if __MSL__ >= 0x6000
1a578e9b
AC
2071 return _write (fildes, buf, count);
2072#else
2073 return write (fildes, buf, count);
2074#endif
2075}
2076
2077
2078#undef rename
2079int
2080sys_rename (const char * old_name, const char * new_name)
2081{
2082 char true_old_pathname[MAXPATHLEN+1], true_new_pathname[MAXPATHLEN+1];
7d0393cf 2083 char fully_resolved_old_name[MAXPATHLEN+1];
1a578e9b
AC
2084 int len;
2085 char mac_old_name[MAXPATHLEN+1], mac_new_name[MAXPATHLEN+1];
7d0393cf 2086
1a578e9b
AC
2087 if (find_true_pathname (old_name, true_old_pathname, MAXPATHLEN+1) == -1)
2088 return -1;
7d0393cf 2089
1a578e9b
AC
2090 len = readlink (true_old_pathname, fully_resolved_old_name, MAXPATHLEN);
2091 if (len > -1)
2092 fully_resolved_old_name[len] = '\0';
2093 else
2094 strcpy (fully_resolved_old_name, true_old_pathname);
2095
2096 if (find_true_pathname (new_name, true_new_pathname, MAXPATHLEN+1) == -1)
2097 return -1;
7d0393cf 2098
1a578e9b
AC
2099 if (strcmp (fully_resolved_old_name, true_new_pathname) == 0)
2100 return 0;
2101
60fe1161 2102 if (!posix_to_mac_pathname (fully_resolved_old_name,
1a578e9b
AC
2103 mac_old_name,
2104 MAXPATHLEN+1))
2105 return -1;
7d0393cf 2106
60fe1161 2107 if (!posix_to_mac_pathname(true_new_pathname, mac_new_name, MAXPATHLEN+1))
1a578e9b
AC
2108 return -1;
2109
2110 /* If a file with new_name already exists, rename deletes the old
2111 file in Unix. CW version fails in these situation. So we add a
2112 call to unlink here. */
2113 (void) unlink (mac_new_name);
7d0393cf 2114
1a578e9b
AC
2115 return rename (mac_old_name, mac_new_name);
2116}
2117
2118
2119#undef fopen
2120extern FILE *fopen (const char *name, const char *mode);
2121FILE *
2122sys_fopen (const char *name, const char *mode)
2123{
7d0393cf 2124 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
2125 int len;
2126 char mac_pathname[MAXPATHLEN+1];
7d0393cf 2127
1a578e9b
AC
2128 if (find_true_pathname (name, true_pathname, MAXPATHLEN+1) == -1)
2129 return 0;
7d0393cf 2130
1a578e9b
AC
2131 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
2132 if (len > -1)
2133 fully_resolved_name[len] = '\0';
2134 else
2135 strcpy (fully_resolved_name, true_pathname);
2136
60fe1161 2137 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
2138 return 0;
2139 else
2140 {
2141#ifdef __MRC__
2142 if (mode[0] == 'w' || mode[0] == 'a')
2143 fsetfileinfo (mac_pathname, 'EMAx', 'TEXT');
e0f712ba 2144#endif /* not __MRC__ */
1a578e9b
AC
2145 return fopen (mac_pathname, mode);
2146 }
2147}
2148
2149
62b00a46 2150#include "keyboard.h"
b15325b2
ST
2151extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
2152
1a578e9b 2153int
e0f712ba 2154select (n, rfds, wfds, efds, timeout)
1a578e9b
AC
2155 int n;
2156 SELECT_TYPE *rfds;
2157 SELECT_TYPE *wfds;
2158 SELECT_TYPE *efds;
2159 struct timeval *timeout;
2160{
b564370b 2161 OSErr err;
62b00a46 2162#if TARGET_API_MAC_CARBON
b564370b
YM
2163 EventTimeout timeout_sec =
2164 (timeout
2165 ? (EMACS_SECS (*timeout) * kEventDurationSecond
2166 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
2167 : kEventDurationForever);
2168
62b00a46
YM
2169 BLOCK_INPUT;
2170 err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL);
2171 UNBLOCK_INPUT;
e0f712ba 2172#else /* not TARGET_API_MAC_CARBON */
1a578e9b 2173 EventRecord e;
b15325b2
ST
2174 UInt32 sleep_time = EMACS_SECS (*timeout) * 60 +
2175 ((EMACS_USECS (*timeout) * 60) / 1000000);
1a578e9b
AC
2176
2177 /* Can only handle wait for keyboard input. */
2178 if (n > 1 || wfds || efds)
2179 return -1;
2180
b15325b2
ST
2181 /* Also return true if an event other than a keyDown has occurred.
2182 This causes kbd_buffer_get_event in keyboard.c to call
2183 read_avail_input which in turn calls XTread_socket to poll for
2184 these events. Otherwise these never get processed except but a
2185 very slow poll timer. */
62b00a46
YM
2186 if (mac_wait_next_event (&e, sleep_time, false))
2187 err = noErr;
2188 else
2189 err = -9875; /* eventLoopTimedOutErr */
e0f712ba 2190#endif /* not TARGET_API_MAC_CARBON */
7d0393cf 2191
62b00a46
YM
2192 if (FD_ISSET (0, rfds))
2193 if (err == noErr)
2194 return 1;
2195 else
2196 {
2197 FD_ZERO (rfds);
2198 return 0;
2199 }
2200 else
2201 if (err == noErr)
2202 {
2203 if (input_polling_used ())
2204 {
2205 /* It could be confusing if a real alarm arrives while
2206 processing the fake one. Turn it off and let the
2207 handler reset it. */
2208 extern void poll_for_input_1 P_ ((void));
2209 int old_poll_suppress_count = poll_suppress_count;
2210 poll_suppress_count = 1;
2211 poll_for_input_1 ();
2212 poll_suppress_count = old_poll_suppress_count;
2213 }
2214 errno = EINTR;
2215 return -1;
2216 }
2217 else
2218 return 0;
2219}
7d0393cf 2220
7d0393cf 2221
62b00a46
YM
2222/* Simulation of SIGALRM. The stub for function signal stores the
2223 signal handler function in alarm_signal_func if a SIGALRM is
2224 encountered. */
1a578e9b 2225
62b00a46
YM
2226#include <signal.h>
2227#include "syssignal.h"
1a578e9b 2228
62b00a46 2229static TMTask mac_atimer_task;
7d0393cf 2230
62b00a46 2231static QElemPtr mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
7d0393cf 2232
62b00a46 2233static int signal_mask = 0;
1a578e9b 2234
62b00a46
YM
2235#ifdef __MRC__
2236__sigfun alarm_signal_func = (__sigfun) 0;
2237#elif __MWERKS__
2238__signal_func_ptr alarm_signal_func = (__signal_func_ptr) 0;
2239#else /* not __MRC__ and not __MWERKS__ */
2240You lose!!!
2241#endif /* not __MRC__ and not __MWERKS__ */
1a578e9b
AC
2242
2243#undef signal
2244#ifdef __MRC__
2245extern __sigfun signal (int signal, __sigfun signal_func);
2246__sigfun
2247sys_signal (int signal_num, __sigfun signal_func)
2248#elif __MWERKS__
2249extern __signal_func_ptr signal (int signal, __signal_func_ptr signal_func);
2250__signal_func_ptr
2251sys_signal (int signal_num, __signal_func_ptr signal_func)
e0f712ba 2252#else /* not __MRC__ and not __MWERKS__ */
1a578e9b 2253 You lose!!!
e0f712ba 2254#endif /* not __MRC__ and not __MWERKS__ */
1a578e9b
AC
2255{
2256 if (signal_num != SIGALRM)
2257 return signal (signal_num, signal_func);
2258 else
2259 {
2260#ifdef __MRC__
7d0393cf 2261 __sigfun old_signal_func;
1a578e9b 2262#elif __MWERKS__
7d0393cf 2263 __signal_func_ptr old_signal_func;
1a578e9b
AC
2264#else
2265 You lose!!!
2266#endif
2267 old_signal_func = alarm_signal_func;
2268 alarm_signal_func = signal_func;
2269 return old_signal_func;
2270 }
2271}
2272
2273
62b00a46
YM
2274static pascal void
2275mac_atimer_handler (qlink)
2276 TMTaskPtr qlink;
2277{
2278 if (alarm_signal_func)
2279 (alarm_signal_func) (SIGALRM);
2280}
2281
2282
2283static void
2284set_mac_atimer (count)
2285 long count;
2286{
2287 static TimerUPP mac_atimer_handlerUPP = NULL;
2288
2289 if (mac_atimer_handlerUPP == NULL)
2290 mac_atimer_handlerUPP = NewTimerUPP (mac_atimer_handler);
2291 mac_atimer_task.tmCount = 0;
2292 mac_atimer_task.tmAddr = mac_atimer_handlerUPP;
2293 mac_atimer_qlink = (QElemPtr) &mac_atimer_task;
2294 InsTime (mac_atimer_qlink);
2295 if (count)
2296 PrimeTime (mac_atimer_qlink, count);
2297}
2298
2299
2300int
2301remove_mac_atimer (remaining_count)
2302 long *remaining_count;
2303{
2304 if (mac_atimer_qlink)
2305 {
2306 RmvTime (mac_atimer_qlink);
2307 if (remaining_count)
2308 *remaining_count = mac_atimer_task.tmCount;
2309 mac_atimer_qlink = NULL;
2310
2311 return 0;
2312 }
2313 else
2314 return -1;
2315}
2316
2317
2318int
2319sigblock (int mask)
2320{
2321 int old_mask = signal_mask;
2322
2323 signal_mask |= mask;
2324
2325 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2326 remove_mac_atimer (NULL);
2327
2328 return old_mask;
2329}
2330
2331
2332int
2333sigsetmask (int mask)
2334{
2335 int old_mask = signal_mask;
2336
2337 signal_mask = mask;
2338
2339 if ((old_mask ^ signal_mask) & sigmask (SIGALRM))
2340 if (signal_mask & sigmask (SIGALRM))
2341 remove_mac_atimer (NULL);
2342 else
2343 set_mac_atimer (mac_atimer_task.tmCount);
2344
2345 return old_mask;
2346}
2347
2348
2349int
2350alarm (int seconds)
2351{
2352 long remaining_count;
2353
2354 if (remove_mac_atimer (&remaining_count) == 0)
2355 {
2356 set_mac_atimer (seconds * 1000);
2357
2358 return remaining_count / 1000;
2359 }
2360 else
2361 {
2362 mac_atimer_task.tmCount = seconds * 1000;
2363
2364 return 0;
2365 }
2366}
2367
2368
2369int
2370setitimer (which, value, ovalue)
2371 int which;
2372 const struct itimerval *value;
2373 struct itimerval *ovalue;
2374{
2375 long remaining_count;
2376 long count = (EMACS_SECS (value->it_value) * 1000
2377 + (EMACS_USECS (value->it_value) + 999) / 1000);
2378
2379 if (remove_mac_atimer (&remaining_count) == 0)
2380 {
2381 if (ovalue)
2382 {
2383 bzero (ovalue, sizeof (*ovalue));
2384 EMACS_SET_SECS_USECS (ovalue->it_value, remaining_count / 1000,
2385 (remaining_count % 1000) * 1000);
2386 }
2387 set_mac_atimer (count);
2388 }
2389 else
2390 mac_atimer_task.tmCount = count;
2391
2392 return 0;
2393}
2394
2395
1a578e9b
AC
2396/* gettimeofday should return the amount of time (in a timeval
2397 structure) since midnight today. The toolbox function Microseconds
2398 returns the number of microseconds (in a UnsignedWide value) since
2399 the machine was booted. Also making this complicated is WideAdd,
2400 WideSubtract, etc. take wide values. */
2401
2402int
2403gettimeofday (tp)
2404 struct timeval *tp;
2405{
2406 static inited = 0;
2407 static wide wall_clock_at_epoch, clicks_at_epoch;
2408 UnsignedWide uw_microseconds;
2409 wide w_microseconds;
2410 time_t sys_time (time_t *);
2411
2412 /* If this function is called for the first time, record the number
2413 of seconds since midnight and the number of microseconds since
2414 boot at the time of this first call. */
2415 if (!inited)
2416 {
2417 time_t systime;
2418 inited = 1;
2419 systime = sys_time (NULL);
2420 /* Store microseconds since midnight in wall_clock_at_epoch. */
2421 WideMultiply (systime, 1000000L, &wall_clock_at_epoch);
2422 Microseconds (&uw_microseconds);
2423 /* Store microseconds since boot in clicks_at_epoch. */
2424 clicks_at_epoch.hi = uw_microseconds.hi;
2425 clicks_at_epoch.lo = uw_microseconds.lo;
2426 }
2427
2428 /* Get time since boot */
2429 Microseconds (&uw_microseconds);
7d0393cf 2430
1a578e9b
AC
2431 /* Convert to time since midnight*/
2432 w_microseconds.hi = uw_microseconds.hi;
2433 w_microseconds.lo = uw_microseconds.lo;
2434 WideSubtract (&w_microseconds, &clicks_at_epoch);
2435 WideAdd (&w_microseconds, &wall_clock_at_epoch);
2436 tp->tv_sec = WideDivide (&w_microseconds, 1000000L, &tp->tv_usec);
2437
2438 return 0;
2439}
2440
2441
2442#ifdef __MRC__
2443unsigned int
2444sleep (unsigned int seconds)
2445{
bc04fb2c 2446 unsigned long time_up;
fa0b4c14
AC
2447 EventRecord e;
2448
bc04fb2c
AC
2449 time_up = TickCount () + seconds * 60;
2450 while (TickCount () < time_up)
2451 {
2452 /* Accept no event; just wait. by T.I. */
2453 WaitNextEvent (0, &e, 30, NULL);
2454 }
1a578e9b 2455
1a578e9b
AC
2456 return (0);
2457}
2458#endif /* __MRC__ */
2459
2460
2461/* The time functions adjust time values according to the difference
2462 between the Unix and CW epoches. */
2463
2464#undef gmtime
2465extern struct tm *gmtime (const time_t *);
2466struct tm *
2467sys_gmtime (const time_t *timer)
2468{
2469 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
7d0393cf 2470
1a578e9b
AC
2471 return gmtime (&unix_time);
2472}
2473
2474
2475#undef localtime
2476extern struct tm *localtime (const time_t *);
2477struct tm *
2478sys_localtime (const time_t *timer)
2479{
e0f712ba 2480#if __MSL__ >= 0x6000
1a578e9b
AC
2481 time_t unix_time = *timer;
2482#else
2483 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2484#endif
7d0393cf 2485
1a578e9b
AC
2486 return localtime (&unix_time);
2487}
2488
2489
2490#undef ctime
2491extern char *ctime (const time_t *);
2492char *
2493sys_ctime (const time_t *timer)
2494{
e0f712ba 2495#if __MSL__ >= 0x6000
1a578e9b
AC
2496 time_t unix_time = *timer;
2497#else
2498 time_t unix_time = *timer + CW_OR_MPW_UNIX_EPOCH_DIFF;
2499#endif
7d0393cf 2500
1a578e9b
AC
2501 return ctime (&unix_time);
2502}
2503
2504
2505#undef time
2506extern time_t time (time_t *);
2507time_t
2508sys_time (time_t *timer)
2509{
e0f712ba 2510#if __MSL__ >= 0x6000
1a578e9b
AC
2511 time_t mac_time = time (NULL);
2512#else
2513 time_t mac_time = time (NULL) - CW_OR_MPW_UNIX_EPOCH_DIFF;
2514#endif
2515
2516 if (timer)
2517 *timer = mac_time;
7d0393cf 2518
1a578e9b
AC
2519 return mac_time;
2520}
2521
2522
1a578e9b
AC
2523/* no subprocesses, empty wait */
2524
2525int
2526wait (int pid)
2527{
2528 return 0;
2529}
2530
2531
2532void
2533croak (char *badfunc)
2534{
2535 printf ("%s not yet implemented\r\n", badfunc);
2536 exit (1);
2537}
2538
2539
1a578e9b
AC
2540char *
2541mktemp (char *template)
2542{
2543 int len, k;
2544 static seqnum = 0;
7d0393cf 2545
1a578e9b
AC
2546 len = strlen (template);
2547 k = len - 1;
2548 while (k >= 0 && template[k] == 'X')
2549 k--;
7d0393cf 2550
1a578e9b 2551 k++; /* make k index of first 'X' */
7d0393cf 2552
1a578e9b
AC
2553 if (k < len)
2554 {
2555 /* Zero filled, number of digits equal to the number of X's. */
2556 sprintf (&template[k], "%0*d", len-k, seqnum++);
7d0393cf 2557
1a578e9b
AC
2558 return template;
2559 }
2560 else
7d0393cf 2561 return 0;
1a578e9b
AC
2562}
2563
2564
2565/* Emulate getpwuid, getpwnam and others. */
2566
2567#define PASSWD_FIELD_SIZE 256
2568
2569static char my_passwd_name[PASSWD_FIELD_SIZE];
2570static char my_passwd_dir[MAXPATHLEN+1];
2571
7d0393cf 2572static struct passwd my_passwd =
1a578e9b
AC
2573{
2574 my_passwd_name,
2575 my_passwd_dir,
2576};
2577
49e7a2c0
LH
2578static struct group my_group =
2579{
2580 /* There are no groups on the mac, so we just return "root" as the
2581 group name. */
2582 "root",
2583};
2584
1a578e9b
AC
2585
2586/* Initialized by main () in macterm.c to pathname of emacs directory. */
2587
2588char emacs_passwd_dir[MAXPATHLEN+1];
2589
2590char *
2591getwd (char *);
2592
2593void
2594init_emacs_passwd_dir ()
2595{
2596 int found = false;
2597
2598 if (getwd (emacs_passwd_dir) && getwd (my_passwd_dir))
2599 {
2600 /* Need pathname of first ancestor that begins with "emacs"
2601 since Mac emacs application is somewhere in the emacs-*
2602 tree. */
2603 int len = strlen (emacs_passwd_dir);
2604 int j = len - 1;
2605 /* j points to the "/" following the directory name being
2606 compared. */
2607 int i = j - 1;
2608 while (i >= 0 && !found)
2609 {
2610 while (i >= 0 && emacs_passwd_dir[i] != '/')
2611 i--;
2612 if (emacs_passwd_dir[i] == '/' && i+5 < len)
2613 found = (strncmp (&(emacs_passwd_dir[i+1]), "emacs", 5) == 0);
2614 if (found)
2615 emacs_passwd_dir[j+1] = '\0';
2616 else
2617 {
2618 j = i;
2619 i = j - 1;
2620 }
2621 }
2622 }
7d0393cf 2623
1a578e9b
AC
2624 if (!found)
2625 {
2626 /* Setting to "/" probably won't work but set it to something
2627 anyway. */
2628 strcpy (emacs_passwd_dir, "/");
2629 strcpy (my_passwd_dir, "/");
2630 }
2631}
2632
2633
7d0393cf 2634static struct passwd emacs_passwd =
1a578e9b
AC
2635{
2636 "emacs",
2637 emacs_passwd_dir,
2638};
2639
2640static int my_passwd_inited = 0;
2641
2642
2643static void
2644init_my_passwd ()
2645{
2646 char **owner_name;
2647
2648 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2649 directory where Emacs was started. */
2650
2651 owner_name = (char **) GetResource ('STR ',-16096);
2652 if (owner_name)
2653 {
2654 HLock (owner_name);
2655 BlockMove ((unsigned char *) *owner_name,
2656 (unsigned char *) my_passwd_name,
2657 *owner_name[0]+1);
2658 HUnlock (owner_name);
2659 p2cstr ((unsigned char *) my_passwd_name);
2660 }
2661 else
2662 my_passwd_name[0] = 0;
2663}
2664
2665
2666struct passwd *
2667getpwuid (uid_t uid)
2668{
2669 if (!my_passwd_inited)
7d0393cf 2670 {
1a578e9b
AC
2671 init_my_passwd ();
2672 my_passwd_inited = 1;
2673 }
7d0393cf 2674
1a578e9b
AC
2675 return &my_passwd;
2676}
2677
2678
49e7a2c0
LH
2679struct group *
2680getgrgid (gid_t gid)
2681{
2682 return &my_group;
2683}
2684
2685
1a578e9b
AC
2686struct passwd *
2687getpwnam (const char *name)
2688{
2689 if (strcmp (name, "emacs") == 0)
2690 return &emacs_passwd;
2691
2692 if (!my_passwd_inited)
7d0393cf 2693 {
1a578e9b
AC
2694 init_my_passwd ();
2695 my_passwd_inited = 1;
2696 }
7d0393cf 2697
1a578e9b
AC
2698 return &my_passwd;
2699}
2700
2701
2702/* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2703 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2704 as in msdos.c. */
2705
2706
2707int
2708fork ()
2709{
2710 return -1;
2711}
2712
2713
2714int
2715kill (int x, int y)
2716{
2717 return -1;
2718}
2719
2720
2721void
2722sys_subshell ()
2723{
2724 error ("Can't spawn subshell");
2725}
2726
2727
1a578e9b
AC
2728void
2729request_sigio (void)
2730{
2731}
2732
2733
2734void
2735unrequest_sigio (void)
2736{
2737}
2738
2739
2740int
2741setpgrp ()
2742{
2743 return 0;
2744}
2745
2746
2747/* No pipes yet. */
2748
2749int
2750pipe (int _fildes[2])
2751{
2752 errno = EACCES;
2753 return -1;
2754}
2755
2756
2757/* Hard and symbolic links. */
2758
2759int
2760symlink (const char *name1, const char *name2)
2761{
2762 errno = ENOENT;
2763 return -1;
2764}
2765
2766
2767int
2768link (const char *name1, const char *name2)
2769{
2770 errno = ENOENT;
2771 return -1;
2772}
2773
e0f712ba 2774#endif /* ! MAC_OSX */
1a578e9b
AC
2775
2776/* Determine the path name of the file specified by VREFNUM, DIRID,
2777 and NAME and place that in the buffer PATH of length
2778 MAXPATHLEN. */
1fcd1370 2779static int
1a578e9b
AC
2780path_from_vol_dir_name (char *path, int man_path_len, short vol_ref_num,
2781 long dir_id, ConstStr255Param name)
2782{
2783 Str255 dir_name;
2784 CInfoPBRec cipb;
2785 OSErr err;
2786
2787 if (strlen (name) > man_path_len)
2788 return 0;
2789
2790 memcpy (dir_name, name, name[0]+1);
2791 memcpy (path, name, name[0]+1);
2792 p2cstr (path);
2793
2794 cipb.dirInfo.ioDrParID = dir_id;
2795 cipb.dirInfo.ioNamePtr = dir_name;
2796
2797 do
2798 {
2799 cipb.dirInfo.ioVRefNum = vol_ref_num;
2800 cipb.dirInfo.ioFDirIndex = -1;
2801 cipb.dirInfo.ioDrDirID = cipb.dirInfo.ioDrParID;
2802 /* go up to parent each time */
2803
2804 err = PBGetCatInfo (&cipb, false);
2805 if (err != noErr)
2806 return 0;
7d0393cf 2807
1a578e9b
AC
2808 p2cstr (dir_name);
2809 if (strlen (dir_name) + strlen (path) + 1 >= man_path_len)
2810 return 0;
2811
2812 strcat (dir_name, ":");
2813 strcat (dir_name, path);
2814 /* attach to front since we're going up directory tree */
2815 strcpy (path, dir_name);
2816 }
2817 while (cipb.dirInfo.ioDrDirID != fsRtDirID);
2818 /* stop when we see the volume's root directory */
7d0393cf 2819
1a578e9b
AC
2820 return 1; /* success */
2821}
2822
b564370b 2823
1fcd1370
YM
2824#ifndef MAC_OSX
2825
7ce8b638 2826static OSErr
b564370b
YM
2827posix_pathname_to_fsspec (ufn, fs)
2828 const char *ufn;
2829 FSSpec *fs;
2830{
2831 Str255 mac_pathname;
2832
2833 if (posix_to_mac_pathname (ufn, mac_pathname, sizeof (mac_pathname)) == 0)
2834 return fnfErr;
2835 else
2836 {
2837 c2pstr (mac_pathname);
2838 return FSMakeFSSpec (0, 0, mac_pathname, fs);
2839 }
2840}
2841
7ce8b638 2842static OSErr
b564370b
YM
2843fsspec_to_posix_pathname (fs, ufn, ufnbuflen)
2844 const FSSpec *fs;
2845 char *ufn;
2846 int ufnbuflen;
2847{
2848 char mac_pathname[MAXPATHLEN];
2849
2850 if (path_from_vol_dir_name (mac_pathname, sizeof (mac_pathname) - 1,
2851 fs->vRefNum, fs->parID, fs->name)
2852 && mac_to_posix_pathname (mac_pathname, ufn, ufnbuflen))
2853 return noErr;
2854 else
2855 return fnfErr;
2856}
2857
1a578e9b
AC
2858int
2859readlink (const char *path, char *buf, int bufsiz)
2860{
2861 char mac_sym_link_name[MAXPATHLEN+1];
2862 OSErr err;
2863 FSSpec fsspec;
2864 Boolean target_is_folder, was_aliased;
2865 Str255 directory_name, mac_pathname;
2866 CInfoPBRec cipb;
2867
60fe1161 2868 if (posix_to_mac_pathname (path, mac_sym_link_name, MAXPATHLEN+1) == 0)
1a578e9b
AC
2869 return -1;
2870
2871 c2pstr (mac_sym_link_name);
2872 err = FSMakeFSSpec (0, 0, mac_sym_link_name, &fsspec);
2873 if (err != noErr)
2874 {
2875 errno = ENOENT;
2876 return -1;
2877 }
2878
2879 err = ResolveAliasFile (&fsspec, true, &target_is_folder, &was_aliased);
2880 if (err != noErr || !was_aliased)
2881 {
2882 errno = ENOENT;
2883 return -1;
2884 }
2885
2886 if (path_from_vol_dir_name (mac_pathname, 255, fsspec.vRefNum, fsspec.parID,
2887 fsspec.name) == 0)
2888 {
2889 errno = ENOENT;
2890 return -1;
2891 }
2892
60fe1161 2893 if (mac_to_posix_pathname (mac_pathname, buf, bufsiz) == 0)
1a578e9b
AC
2894 {
2895 errno = ENOENT;
2896 return -1;
2897 }
2898
2899 return strlen (buf);
2900}
2901
2902
2903/* Convert a path to one with aliases fully expanded. */
2904
2905static int
2906find_true_pathname (const char *path, char *buf, int bufsiz)
2907{
2908 char *q, temp[MAXPATHLEN+1];
2909 const char *p;
2910 int len;
2911
2912 if (bufsiz <= 0 || path == 0 || path[0] == '\0')
2913 return -1;
2914
2915 buf[0] = '\0';
7d0393cf 2916
1a578e9b
AC
2917 p = path;
2918 if (*p == '/')
2919 q = strchr (p + 1, '/');
2920 else
2921 q = strchr (p, '/');
2922 len = 0; /* loop may not be entered, e.g., for "/" */
2923
2924 while (q)
2925 {
2926 strcpy (temp, buf);
2927 strncat (temp, p, q - p);
2928 len = readlink (temp, buf, bufsiz);
2929 if (len <= -1)
2930 {
2931 if (strlen (temp) + 1 > bufsiz)
2932 return -1;
2933 strcpy (buf, temp);
2934 }
2935 strcat (buf, "/");
2936 len++;
2937 p = q + 1;
2938 q = strchr(p, '/');
2939 }
7d0393cf 2940
1a578e9b
AC
2941 if (len + strlen (p) + 1 >= bufsiz)
2942 return -1;
7d0393cf 2943
1a578e9b
AC
2944 strcat (buf, p);
2945 return len + strlen (p);
2946}
2947
2948
2949mode_t
2950umask (mode_t numask)
2951{
2952 static mode_t mask = 022;
2953 mode_t oldmask = mask;
2954 mask = numask;
2955 return oldmask;
2956}
2957
2958
2959int
2960chmod (const char *path, mode_t mode)
2961{
2962 /* say it always succeed for now */
2963 return 0;
2964}
2965
2966
908b0456
YM
2967int
2968fchmod (int fd, mode_t mode)
2969{
2970 /* say it always succeed for now */
2971 return 0;
2972}
2973
2974
2975int
2976fchown (int fd, uid_t owner, gid_t group)
2977{
2978 /* say it always succeed for now */
2979 return 0;
2980}
2981
2982
1a578e9b
AC
2983int
2984dup (int oldd)
2985{
2986#ifdef __MRC__
2987 return fcntl (oldd, F_DUPFD, 0);
2988#elif __MWERKS__
2989 /* current implementation of fcntl in fcntl.mac.c simply returns old
2990 descriptor */
2991 return fcntl (oldd, F_DUPFD);
2992#else
2993You lose!!!
2994#endif
2995}
2996
2997
2998/* This is from the original sysdep.c. Emulate BSD dup2. First close
2999 newd if it already exists. Then, attempt to dup oldd. If not
3000 successful, call dup2 recursively until we are, then close the
3001 unsuccessful ones. */
3002
3003int
3004dup2 (int oldd, int newd)
3005{
3006 int fd, ret;
7d0393cf 3007
1a578e9b
AC
3008 close (newd);
3009
3010 fd = dup (oldd);
3011 if (fd == -1)
3012 return -1;
3013 if (fd == newd)
3014 return newd;
3015 ret = dup2 (oldd, newd);
3016 close (fd);
3017 return ret;
3018}
3019
3020
3021/* let it fail for now */
3022
3023char *
3024sbrk (int incr)
3025{
3026 return (char *) -1;
3027}
3028
3029
3030int
3031fsync (int fd)
3032{
3033 return 0;
3034}
3035
3036
3037int
3038ioctl (int d, int request, void *argp)
3039{
3040 return -1;
3041}
3042
3043
3044#ifdef __MRC__
3045int
3046isatty (int fildes)
3047{
3048 if (fildes >=0 && fildes <= 2)
3049 return 1;
3050 else
3051 return 0;
3052}
3053
3054
3055int
3056getgid ()
3057{
3058 return 100;
3059}
3060
3061
3062int
3063getegid ()
3064{
3065 return 100;
3066}
3067
3068
3069int
3070getuid ()
3071{
3072 return 200;
3073}
3074
3075
3076int
3077geteuid ()
3078{
3079 return 200;
3080}
3081#endif /* __MRC__ */
3082
3083
3084#ifdef __MWERKS__
e0f712ba 3085#if __MSL__ < 0x6000
1a578e9b
AC
3086#undef getpid
3087int
3088getpid ()
3089{
3090 return 9999;
3091}
3092#endif
3093#endif /* __MWERKS__ */
3094
e0f712ba
AC
3095#endif /* ! MAC_OSX */
3096
1a578e9b
AC
3097
3098/* Return the path to the directory in which Emacs can create
3099 temporary files. The MacOS "temporary items" directory cannot be
3100 used because it removes the file written by a process when it
3101 exits. In that sense it's more like "/dev/null" than "/tmp" (but
3102 again not exactly). And of course Emacs needs to read back the
3103 files written by its subprocesses. So here we write the files to a
3104 directory "Emacs" in the Preferences Folder. This directory is
3105 created if it does not exist. */
3106
e0f712ba 3107char *
1a578e9b
AC
3108get_temp_dir_name ()
3109{
3110 static char *temp_dir_name = NULL;
3111 short vol_ref_num;
3112 long dir_id;
3113 OSErr err;
1fcd1370 3114 Str255 full_path;
1a578e9b
AC
3115 char unix_dir_name[MAXPATHLEN+1];
3116 DIR *dir;
7d0393cf 3117
1a578e9b
AC
3118 /* Cache directory name with pointer temp_dir_name.
3119 Look for it only the first time. */
3120 if (!temp_dir_name)
3121 {
3122 err = FindFolder (kOnSystemDisk, kPreferencesFolderType, kCreateFolder,
3123 &vol_ref_num, &dir_id);
3124 if (err != noErr)
3125 return NULL;
7d0393cf 3126
1a578e9b
AC
3127 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3128 return NULL;
3129
3130 if (strlen (full_path) + 6 <= MAXPATHLEN)
3131 strcat (full_path, "Emacs:");
7d0393cf 3132 else
1a578e9b
AC
3133 return NULL;
3134
60fe1161 3135 if (!mac_to_posix_pathname (full_path, unix_dir_name, MAXPATHLEN+1))
1a578e9b 3136 return NULL;
7d0393cf 3137
1a578e9b
AC
3138 dir = opendir (unix_dir_name); /* check whether temp directory exists */
3139 if (dir)
3140 closedir (dir);
3141 else if (mkdir (unix_dir_name, 0700) != 0) /* create it if not */
3142 return NULL;
3143
3144 temp_dir_name = (char *) malloc (strlen (unix_dir_name) + 1);
3145 strcpy (temp_dir_name, unix_dir_name);
3146 }
3147
3148 return temp_dir_name;
3149}
3150
e0f712ba 3151#ifndef MAC_OSX
1a578e9b
AC
3152
3153/* Allocate and construct an array of pointers to strings from a list
3154 of strings stored in a 'STR#' resource. The returned pointer array
3155 is stored in the style of argv and environ: if the 'STR#' resource
7d0393cf 3156 contains numString strings, a pointer array with numString+1
1a578e9b
AC
3157 elements is returned in which the last entry contains a null
3158 pointer. The pointer to the pointer array is passed by pointer in
3159 parameter t. The resource ID of the 'STR#' resource is passed in
3160 parameter StringListID.
3161 */
3162
3163void
3164get_string_list (char ***t, short string_list_id)
3165{
3166 Handle h;
3167 Ptr p;
3168 int i, num_strings;
3169
3170 h = GetResource ('STR#', string_list_id);
3171 if (h)
3172 {
3173 HLock (h);
3174 p = *h;
3175 num_strings = * (short *) p;
3176 p += sizeof(short);
3177 *t = (char **) malloc (sizeof (char *) * (num_strings + 1));
3178 for (i = 0; i < num_strings; i++)
3179 {
3180 short length = *p++;
3181 (*t)[i] = (char *) malloc (length + 1);
3182 strncpy ((*t)[i], p, length);
3183 (*t)[i][length] = '\0';
3184 p += length;
3185 }
3186 (*t)[num_strings] = 0;
3187 HUnlock (h);
3188 }
3189 else
3190 {
3191 /* Return no string in case GetResource fails. Bug fixed by
3192 Ikegami Tsutomu. Caused MPW build to crash without sym -on
3193 option (no sym -on implies -opt local). */
3194 *t = (char **) malloc (sizeof (char *));
3195 (*t)[0] = 0;
3196 }
3197}
3198
3199
3200static char *
3201get_path_to_system_folder ()
3202{
3203 short vol_ref_num;
3204 long dir_id;
3205 OSErr err;
1fcd1370 3206 Str255 full_path;
1a578e9b
AC
3207 static char system_folder_unix_name[MAXPATHLEN+1];
3208 DIR *dir;
7d0393cf 3209
1a578e9b
AC
3210 err = FindFolder (kOnSystemDisk, kSystemFolderType, kDontCreateFolder,
3211 &vol_ref_num, &dir_id);
3212 if (err != noErr)
3213 return NULL;
7d0393cf 3214
1a578e9b
AC
3215 if (!path_from_vol_dir_name (full_path, 255, vol_ref_num, dir_id, "\p"))
3216 return NULL;
3217
e0f712ba
AC
3218 if (!mac_to_posix_pathname (full_path, system_folder_unix_name,
3219 MAXPATHLEN+1))
1a578e9b 3220 return NULL;
7d0393cf 3221
1a578e9b
AC
3222 return system_folder_unix_name;
3223}
3224
3225
3226char **environ;
3227
3228#define ENVIRON_STRING_LIST_ID 128
3229
3230/* Get environment variable definitions from STR# resource. */
3231
3232void
3233init_environ ()
3234{
3235 int i;
7d0393cf 3236
1a578e9b
AC
3237 get_string_list (&environ, ENVIRON_STRING_LIST_ID);
3238
3239 i = 0;
3240 while (environ[i])
3241 i++;
3242
3243 /* Make HOME directory the one Emacs starts up in if not specified
3244 by resource. */
3245 if (getenv ("HOME") == NULL)
3246 {
3247 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3248 if (environ)
3249 {
3250 environ[i] = (char *) malloc (strlen (my_passwd_dir) + 6);
3251 if (environ[i])
3252 {
3253 strcpy (environ[i], "HOME=");
3254 strcat (environ[i], my_passwd_dir);
3255 }
3256 environ[i+1] = 0;
3257 i++;
3258 }
3259 }
3260
3261 /* Make HOME directory the one Emacs starts up in if not specified
3262 by resource. */
3263 if (getenv ("MAIL") == NULL)
3264 {
3265 environ = (char **) realloc (environ, sizeof (char *) * (i + 2));
3266 if (environ)
3267 {
3268 char * path_to_system_folder = get_path_to_system_folder ();
3269 environ[i] = (char *) malloc (strlen (path_to_system_folder) + 22);
3270 if (environ[i])
3271 {
3272 strcpy (environ[i], "MAIL=");
3273 strcat (environ[i], path_to_system_folder);
3274 strcat (environ[i], "Eudora Folder/In");
3275 }
3276 environ[i+1] = 0;
3277 }
3278 }
3279}
3280
3281
3282/* Return the value of the environment variable NAME. */
3283
3284char *
3285getenv (const char *name)
3286{
3287 int length = strlen(name);
3288 char **e;
3289
3290 for (e = environ; *e != 0; e++)
3291 if (strncmp(*e, name, length) == 0 && (*e)[length] == '=')
3292 return &(*e)[length + 1];
3293
3294 if (strcmp (name, "TMPDIR") == 0)
3295 return get_temp_dir_name ();
3296
3297 return 0;
3298}
3299
3300
3301#ifdef __MRC__
3302/* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
3303char *sys_siglist[] =
3304{
3305 "Zero is not a signal!!!",
3306 "Abort", /* 1 */
3307 "Interactive user interrupt", /* 2 */ "?",
3308 "Floating point exception", /* 4 */ "?", "?", "?",
3309 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
3310 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
3311 "?", "?", "?", "?", "?", "?", "?", "?",
3312 "Terminal" /* 32 */
3313};
3314#elif __MWERKS__
3315char *sys_siglist[] =
3316{
3317 "Zero is not a signal!!!",
3318 "Abort",
3319 "Floating point exception",
3320 "Illegal instruction",
3321 "Interactive user interrupt",
3322 "Segment violation",
3323 "Terminal"
3324};
e0f712ba 3325#else /* not __MRC__ and not __MWERKS__ */
1a578e9b 3326You lose!!!
e0f712ba 3327#endif /* not __MRC__ and not __MWERKS__ */
1a578e9b
AC
3328
3329
3330#include <utsname.h>
3331
3332int
3333uname (struct utsname *name)
3334{
3335 char **system_name;
3336 system_name = GetString (-16413); /* IM - Resource Manager Reference */
3337 if (system_name)
3338 {
3339 BlockMove (*system_name, name->nodename, (*system_name)[0]+1);
3340 p2cstr (name->nodename);
3341 return 0;
3342 }
3343 else
3344 return -1;
3345}
3346
3347
1a578e9b
AC
3348/* Event class of HLE sent to subprocess. */
3349const OSType kEmacsSubprocessSend = 'ESND';
3350
3351/* Event class of HLE sent back from subprocess. */
3352const OSType kEmacsSubprocessReply = 'ERPY';
3353
3354
3355char *
3356mystrchr (char *s, char c)
3357{
3358 while (*s && *s != c)
3359 {
3360 if (*s == '\\')
3361 s++;
3362 s++;
3363 }
3364
3365 if (*s)
3366 {
3367 *s = '\0';
3368 return s;
3369 }
3370 else
3371 return NULL;
3372}
3373
3374
3375char *
3376mystrtok (char *s)
7d0393cf 3377{
1a578e9b
AC
3378 while (*s)
3379 s++;
3380
3381 return s + 1;
3382}
3383
3384
3385void
3386mystrcpy (char *to, char *from)
3387{
3388 while (*from)
3389 {
3390 if (*from == '\\')
3391 from++;
3392 *to++ = *from++;
3393 }
3394 *to = '\0';
3395}
3396
3397
3398/* Start a Mac subprocess. Arguments for it is passed in argv (null
3399 terminated). The process should run with the default directory
3400 "workdir", read input from "infn", and write output and error to
3401 "outfn" and "errfn", resp. The Process Manager call
3402 LaunchApplication is used to start the subprocess. We use high
3403 level events as the mechanism to pass arguments to the subprocess
3404 and to make Emacs wait for the subprocess to terminate and pass
3405 back a result code. The bulk of the code here packs the arguments
3406 into one message to be passed together with the high level event.
3407 Emacs also sometimes starts a subprocess using a shell to perform
3408 wildcard filename expansion. Since we don't really have a shell on
3409 the Mac, this case is detected and the starting of the shell is
3410 by-passed. We really need to add code here to do filename
70e88ff1
YM
3411 expansion to support such functionality.
3412
3413 We can't use this strategy in Carbon because the High Level Event
3414 APIs are not available. */
1a578e9b
AC
3415
3416int
3417run_mac_command (argv, workdir, infn, outfn, errfn)
3418 unsigned char **argv;
3419 const char *workdir;
3420 const char *infn, *outfn, *errfn;
3421{
b15325b2 3422#if TARGET_API_MAC_CARBON
e0f712ba
AC
3423 return -1;
3424#else /* not TARGET_API_MAC_CARBON */
1a578e9b
AC
3425 char macappname[MAXPATHLEN+1], macworkdir[MAXPATHLEN+1];
3426 char macinfn[MAXPATHLEN+1], macoutfn[MAXPATHLEN+1], macerrfn[MAXPATHLEN+1];
3427 int paramlen, argc, newargc, j, retries;
3428 char **newargv, *param, *p;
3429 OSErr iErr;
3430 FSSpec spec;
3431 LaunchParamBlockRec lpbr;
3432 EventRecord send_event, reply_event;
3433 RgnHandle cursor_region_handle;
3434 TargetID targ;
3435 unsigned long ref_con, len;
7d0393cf 3436
60fe1161 3437 if (posix_to_mac_pathname (workdir, macworkdir, MAXPATHLEN+1) == 0)
1a578e9b 3438 return -1;
60fe1161 3439 if (posix_to_mac_pathname (infn, macinfn, MAXPATHLEN+1) == 0)
1a578e9b 3440 return -1;
60fe1161 3441 if (posix_to_mac_pathname (outfn, macoutfn, MAXPATHLEN+1) == 0)
1a578e9b 3442 return -1;
60fe1161 3443 if (posix_to_mac_pathname (errfn, macerrfn, MAXPATHLEN+1) == 0)
1a578e9b 3444 return -1;
7d0393cf 3445
1a578e9b
AC
3446 paramlen = strlen (macworkdir) + strlen (macinfn) + strlen (macoutfn)
3447 + strlen (macerrfn) + 4; /* count nulls at end of strings */
3448
3449 argc = 0;
3450 while (argv[argc])
3451 argc++;
3452
3453 if (argc == 0)
3454 return -1;
3455
3456 /* If a subprocess is invoked with a shell, we receive 3 arguments
3457 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
3458 bins>/<command> <command args>" */
3459 j = strlen (argv[0]);
3460 if (j >= 3 && strcmp (argv[0]+j-3, "/sh") == 0
3461 && argc == 3 && strcmp (argv[1], "-c") == 0)
3462 {
3463 char *command, *t, tempmacpathname[MAXPATHLEN+1];
7d0393cf 3464
1a578e9b
AC
3465 /* The arguments for the command in argv[2] are separated by
3466 spaces. Count them and put the count in newargc. */
3467 command = (char *) alloca (strlen (argv[2])+2);
3468 strcpy (command, argv[2]);
3469 if (command[strlen (command) - 1] != ' ')
3470 strcat (command, " ");
7d0393cf 3471
1a578e9b
AC
3472 t = command;
3473 newargc = 0;
3474 t = mystrchr (t, ' ');
3475 while (t)
3476 {
3477 newargc++;
3478 t = mystrchr (t+1, ' ');
3479 }
7d0393cf 3480
1a578e9b 3481 newargv = (char **) alloca (sizeof (char *) * newargc);
7d0393cf 3482
1a578e9b
AC
3483 t = command;
3484 for (j = 0; j < newargc; j++)
3485 {
3486 newargv[j] = (char *) alloca (strlen (t) + 1);
3487 mystrcpy (newargv[j], t);
3488
3489 t = mystrtok (t);
3490 paramlen += strlen (newargv[j]) + 1;
3491 }
7d0393cf 3492
1a578e9b
AC
3493 if (strncmp (newargv[0], "~emacs/", 7) == 0)
3494 {
60fe1161 3495 if (posix_to_mac_pathname (newargv[0], tempmacpathname, MAXPATHLEN+1)
1a578e9b
AC
3496 == 0)
3497 return -1;
3498 }
3499 else
3500 { /* sometimes Emacs call "sh" without a path for the command */
3501#if 0
3502 char *t = (char *) alloca (strlen (newargv[0]) + 7 + 1);
3503 strcpy (t, "~emacs/");
3504 strcat (t, newargv[0]);
e0f712ba 3505#endif /* 0 */
1a578e9b 3506 Lisp_Object path;
b15325b2 3507 openp (Vexec_path, build_string (newargv[0]), Vexec_suffixes, &path,
141f653a 3508 make_number (X_OK));
1a578e9b
AC
3509
3510 if (NILP (path))
3511 return -1;
d5db4077 3512 if (posix_to_mac_pathname (SDATA (path), tempmacpathname,
1a578e9b
AC
3513 MAXPATHLEN+1) == 0)
3514 return -1;
3515 }
3516 strcpy (macappname, tempmacpathname);
3517 }
3518 else
7d0393cf 3519 {
60fe1161 3520 if (posix_to_mac_pathname (argv[0], macappname, MAXPATHLEN+1) == 0)
1a578e9b
AC
3521 return -1;
3522
3523 newargv = (char **) alloca (sizeof (char *) * argc);
7d0393cf 3524 newargc = argc;
1a578e9b
AC
3525 for (j = 1; j < argc; j++)
3526 {
3527 if (strncmp (argv[j], "~emacs/", 7) == 0)
3528 {
3529 char *t = strchr (argv[j], ' ');
3530 if (t)
3531 {
3532 char tempcmdname[MAXPATHLEN+1], tempmaccmdname[MAXPATHLEN+1];
3533 strncpy (tempcmdname, argv[j], t-argv[j]);
3534 tempcmdname[t-argv[j]] = '\0';
60fe1161 3535 if (posix_to_mac_pathname (tempcmdname, tempmaccmdname,
1a578e9b
AC
3536 MAXPATHLEN+1) == 0)
3537 return -1;
3538 newargv[j] = (char *) alloca (strlen (tempmaccmdname)
3539 + strlen (t) + 1);
3540 strcpy (newargv[j], tempmaccmdname);
3541 strcat (newargv[j], t);
3542 }
3543 else
3544 {
3545 char tempmaccmdname[MAXPATHLEN+1];
60fe1161 3546 if (posix_to_mac_pathname (argv[j], tempmaccmdname,
1a578e9b
AC
3547 MAXPATHLEN+1) == 0)
3548 return -1;
3549 newargv[j] = (char *) alloca (strlen (tempmaccmdname)+1);
3550 strcpy (newargv[j], tempmaccmdname);
3551 }
3552 }
3553 else
7d0393cf 3554 newargv[j] = argv[j];
1a578e9b
AC
3555 paramlen += strlen (newargv[j]) + 1;
3556 }
3557 }
3558
3559 /* After expanding all the arguments, we now know the length of the
3560 parameter block to be sent to the subprocess as a message
3561 attached to the HLE. */
3562 param = (char *) malloc (paramlen + 1);
3563 if (!param)
3564 return -1;
3565
3566 p = param;
3567 *p++ = newargc;
3568 /* first byte of message contains number of arguments for command */
3569 strcpy (p, macworkdir);
3570 p += strlen (macworkdir);
3571 *p++ = '\0';
3572 /* null terminate strings sent so it's possible to use strcpy over there */
3573 strcpy (p, macinfn);
3574 p += strlen (macinfn);
7d0393cf 3575 *p++ = '\0';
1a578e9b
AC
3576 strcpy (p, macoutfn);
3577 p += strlen (macoutfn);
7d0393cf 3578 *p++ = '\0';
1a578e9b
AC
3579 strcpy (p, macerrfn);
3580 p += strlen (macerrfn);
7d0393cf 3581 *p++ = '\0';
1a578e9b
AC
3582 for (j = 1; j < newargc; j++)
3583 {
3584 strcpy (p, newargv[j]);
3585 p += strlen (newargv[j]);
7d0393cf 3586 *p++ = '\0';
1a578e9b 3587 }
7d0393cf 3588
1a578e9b 3589 c2pstr (macappname);
7d0393cf 3590
1a578e9b 3591 iErr = FSMakeFSSpec (0, 0, macappname, &spec);
7d0393cf 3592
1a578e9b
AC
3593 if (iErr != noErr)
3594 {
3595 free (param);
3596 return -1;
3597 }
3598
3599 lpbr.launchBlockID = extendedBlock;
3600 lpbr.launchEPBLength = extendedBlockLen;
3601 lpbr.launchControlFlags = launchContinue + launchNoFileFlags;
3602 lpbr.launchAppSpec = &spec;
3603 lpbr.launchAppParameters = NULL;
3604
3605 iErr = LaunchApplication (&lpbr); /* call the subprocess */
3606 if (iErr != noErr)
3607 {
3608 free (param);
3609 return -1;
3610 }
3611
3612 send_event.what = kHighLevelEvent;
3613 send_event.message = kEmacsSubprocessSend;
3614 /* Event ID stored in "where" unused */
3615
3616 retries = 3;
3617 /* OS may think current subprocess has terminated if previous one
3618 terminated recently. */
3619 do
3620 {
3621 iErr = PostHighLevelEvent (&send_event, &lpbr.launchProcessSN, 0, param,
3622 paramlen + 1, receiverIDisPSN);
3623 }
3624 while (iErr == sessClosedErr && retries-- > 0);
3625
3626 if (iErr != noErr)
3627 {
3628 free (param);
3629 return -1;
3630 }
3631
3632 cursor_region_handle = NewRgn ();
7d0393cf 3633
1a578e9b
AC
3634 /* Wait for the subprocess to finish, when it will send us a ERPY
3635 high level event. */
3636 while (1)
3637 if (WaitNextEvent (highLevelEventMask, &reply_event, 180,
3638 cursor_region_handle)
3639 && reply_event.message == kEmacsSubprocessReply)
3640 break;
7d0393cf 3641
1a578e9b
AC
3642 /* The return code is sent through the refCon */
3643 iErr = AcceptHighLevelEvent (&targ, &ref_con, NULL, &len);
3644 if (iErr != noErr)
3645 {
3646 DisposeHandle ((Handle) cursor_region_handle);
3647 free (param);
3648 return -1;
3649 }
7d0393cf 3650
1a578e9b
AC
3651 DisposeHandle ((Handle) cursor_region_handle);
3652 free (param);
3653
3654 return ref_con;
e0f712ba 3655#endif /* not TARGET_API_MAC_CARBON */
1a578e9b
AC
3656}
3657
3658
3659DIR *
3660opendir (const char *dirname)
3661{
7d0393cf 3662 char true_pathname[MAXPATHLEN+1], fully_resolved_name[MAXPATHLEN+1];
1a578e9b
AC
3663 char mac_pathname[MAXPATHLEN+1], vol_name[MAXPATHLEN+1];
3664 DIR *dirp;
3665 CInfoPBRec cipb;
3666 HVolumeParam vpb;
3667 int len, vol_name_len;
7d0393cf 3668
1a578e9b
AC
3669 if (find_true_pathname (dirname, true_pathname, MAXPATHLEN+1) == -1)
3670 return 0;
7d0393cf 3671
1a578e9b
AC
3672 len = readlink (true_pathname, fully_resolved_name, MAXPATHLEN);
3673 if (len > -1)
3674 fully_resolved_name[len] = '\0';
3675 else
3676 strcpy (fully_resolved_name, true_pathname);
3677
3678 dirp = (DIR *) malloc (sizeof(DIR));
3679 if (!dirp)
3680 return 0;
3681
3682 /* Handle special case when dirname is "/": sets up for readir to
3683 get all mount volumes. */
3684 if (strcmp (fully_resolved_name, "/") == 0)
3685 {
3686 dirp->getting_volumes = 1; /* special all mounted volumes DIR struct */
3687 dirp->current_index = 1; /* index for first volume */
3688 return dirp;
3689 }
3690
3691 /* Handle typical cases: not accessing all mounted volumes. */
60fe1161 3692 if (!posix_to_mac_pathname (fully_resolved_name, mac_pathname, MAXPATHLEN+1))
1a578e9b
AC
3693 return 0;
3694
3695 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3696 len = strlen (mac_pathname);
3697 if (mac_pathname[len - 1] != ':' && len < MAXPATHLEN)
3698 strcat (mac_pathname, ":");
7d0393cf 3699
1a578e9b
AC
3700 /* Extract volume name */
3701 vol_name_len = strchr (mac_pathname, ':') - mac_pathname;
3702 strncpy (vol_name, mac_pathname, vol_name_len);
3703 vol_name[vol_name_len] = '\0';
3704 strcat (vol_name, ":");
3705
3706 c2pstr (mac_pathname);
3707 cipb.hFileInfo.ioNamePtr = mac_pathname;
3708 /* using full pathname so vRefNum and DirID ignored */
3709 cipb.hFileInfo.ioVRefNum = 0;
3710 cipb.hFileInfo.ioDirID = 0;
3711 cipb.hFileInfo.ioFDirIndex = 0;
3712 /* set to 0 to get information about specific dir or file */
7d0393cf 3713
1a578e9b
AC
3714 errno = PBGetCatInfo (&cipb, false);
3715 if (errno != noErr)
3716 {
3717 errno = ENOENT;
3718 return 0;
3719 }
3720
3721 if (!(cipb.hFileInfo.ioFlAttrib & 0x10)) /* bit 4 = 1 for directories */
3722 return 0; /* not a directory */
3723
3724 dirp->dir_id = cipb.dirInfo.ioDrDirID; /* used later in readdir */
3725 dirp->getting_volumes = 0;
3726 dirp->current_index = 1; /* index for first file/directory */
3727
3728 c2pstr (vol_name);
3729 vpb.ioNamePtr = vol_name;
3730 /* using full pathname so vRefNum and DirID ignored */
3731 vpb.ioVRefNum = 0;
3732 vpb.ioVolIndex = -1;
3733 errno = PBHGetVInfo ((union HParamBlockRec *) &vpb, false);
3734 if (errno != noErr)
3735 {
3736 errno = ENOENT;
3737 return 0;
3738 }
3739
3740 dirp->vol_ref_num = vpb.ioVRefNum;
7d0393cf 3741
1a578e9b
AC
3742 return dirp;
3743}
3744
3745int
3746closedir (DIR *dp)
3747{
3748 free (dp);
3749
3750 return 0;
3751}
3752
3753
3754struct dirent *
3755readdir (DIR *dp)
3756{
3757 HParamBlockRec hpblock;
3758 CInfoPBRec cipb;
3759 static struct dirent s_dirent;
3760 static Str255 s_name;
3761 int done;
3762 char *p;
3763
3764 /* Handle the root directory containing the mounted volumes. Call
3765 PBHGetVInfo specifying an index to obtain the info for a volume.
3766 PBHGetVInfo returns an error when it receives an index beyond the
3767 last volume, at which time we should return a nil dirent struct
3768 pointer. */
3769 if (dp->getting_volumes)
3770 {
3771 hpblock.volumeParam.ioNamePtr = s_name;
3772 hpblock.volumeParam.ioVRefNum = 0;
3773 hpblock.volumeParam.ioVolIndex = dp->current_index;
7d0393cf 3774
1a578e9b
AC
3775 errno = PBHGetVInfo (&hpblock, false);
3776 if (errno != noErr)
3777 {
3778 errno = ENOENT;
3779 return 0;
3780 }
7d0393cf 3781
1a578e9b
AC
3782 p2cstr (s_name);
3783 strcat (s_name, "/"); /* need "/" for stat to work correctly */
3784
3785 dp->current_index++;
3786
3787 s_dirent.d_ino = hpblock.volumeParam.ioVRefNum;
3788 s_dirent.d_name = s_name;
7d0393cf 3789
1a578e9b
AC
3790 return &s_dirent;
3791 }
3792 else
3793 {
3794 cipb.hFileInfo.ioVRefNum = dp->vol_ref_num;
3795 cipb.hFileInfo.ioNamePtr = s_name;
3796 /* location to receive filename returned */
3797
3798 /* return only visible files */
3799 done = false;
3800 while (!done)
3801 {
3802 cipb.hFileInfo.ioDirID = dp->dir_id;
3803 /* directory ID found by opendir */
3804 cipb.hFileInfo.ioFDirIndex = dp->current_index;
7d0393cf 3805
1a578e9b
AC
3806 errno = PBGetCatInfo (&cipb, false);
3807 if (errno != noErr)
3808 {
3809 errno = ENOENT;
3810 return 0;
3811 }
7d0393cf
JB
3812
3813 /* insist on a visible entry */
1a578e9b
AC
3814 if (cipb.hFileInfo.ioFlAttrib & 0x10) /* directory? */
3815 done = !(cipb.dirInfo.ioDrUsrWds.frFlags & fInvisible);
3816 else
3817 done = !(cipb.hFileInfo.ioFlFndrInfo.fdFlags & fInvisible);
7d0393cf 3818
1a578e9b
AC
3819 dp->current_index++;
3820 }
3821
3822 p2cstr (s_name);
7d0393cf 3823
1a578e9b
AC
3824 p = s_name;
3825 while (*p)
3826 {
3827 if (*p == '/')
3828 *p = ':';
3829 p++;
3830 }
3831
3832 s_dirent.d_ino = cipb.dirInfo.ioDrDirID;
3833 /* value unimportant: non-zero for valid file */
3834 s_dirent.d_name = s_name;
7d0393cf 3835
1a578e9b
AC
3836 return &s_dirent;
3837 }
3838}
3839
3840
3841char *
3842getwd (char *path)
3843{
3844 char mac_pathname[MAXPATHLEN+1];
3845 Str255 directory_name;
3846 OSErr errno;
3847 CInfoPBRec cipb;
3848
3849 if (path_from_vol_dir_name (mac_pathname, 255, 0, 0, "\p") == 0)
3850 return NULL;
3851
60fe1161 3852 if (mac_to_posix_pathname (mac_pathname, path, MAXPATHLEN+1) == 0)
1a578e9b
AC
3853 return 0;
3854 else
3855 return path;
3856}
3857
e0f712ba
AC
3858#endif /* ! MAC_OSX */
3859
1a578e9b
AC
3860
3861void
3862initialize_applescript ()
3863{
3864 AEDesc null_desc;
3865 OSAError osaerror;
7d0393cf 3866
1a578e9b
AC
3867 /* if open fails, as_scripting_component is set to NULL. Its
3868 subsequent use in OSA calls will fail with badComponentInstance
3869 error. */
3870 as_scripting_component = OpenDefaultComponent (kOSAComponentType,
3871 kAppleScriptSubtype);
3872
3873 null_desc.descriptorType = typeNull;
3874 null_desc.dataHandle = 0;
3875 osaerror = OSAMakeContext (as_scripting_component, &null_desc,
3876 kOSANullScript, &as_script_context);
3877 if (osaerror)
3878 as_script_context = kOSANullScript;
3879 /* use default context if create fails */
3880}
3881
3882
908b0456
YM
3883void
3884terminate_applescript()
1a578e9b
AC
3885{
3886 OSADispose (as_scripting_component, as_script_context);
3887 CloseComponent (as_scripting_component);
3888}
3889
908b0456 3890/* Convert a lisp string to the 4 byte character code. */
5f8080a9 3891
908b0456
YM
3892OSType
3893mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
9a4183e9
ST
3894{
3895 OSType result;
3896 if (NILP(arg))
3897 {
3898 result = defCode;
5f8080a9 3899 }
9a4183e9
ST
3900 else
3901 {
3902 /* check type string */
3903 CHECK_STRING(arg);
908b0456 3904 if (SBYTES (arg) != 4)
9a4183e9
ST
3905 {
3906 error ("Wrong argument: need string of length 4 for code");
3907 }
908b0456 3908 result = EndianU32_BtoN (*((UInt32 *) SDATA (arg)));
9a4183e9
ST
3909 }
3910 return result;
3911}
3912
908b0456
YM
3913/* Convert the 4 byte character code into a 4 byte string. */
3914
3915Lisp_Object
3916mac_get_object_from_code(OSType defCode)
3917{
3918 UInt32 code = EndianU32_NtoB (defCode);
3919
3920 return make_unibyte_string ((char *)&code, 4);
9a4183e9
ST
3921}
3922
3923
3924DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0,
3925 doc: /* Get the creator code of FILENAME as a four character string. */)
fc3216cb 3926 (filename)
908b0456 3927 Lisp_Object filename;
9a4183e9
ST
3928{
3929 OSErr status;
908b0456
YM
3930#ifdef MAC_OSX
3931 FSRef fref;
3932#else
3933 FSSpec fss;
3934#endif
9a4183e9
ST
3935 Lisp_Object result = Qnil;
3936 CHECK_STRING (filename);
3937
3938 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3939 return Qnil;
3940 }
3941 filename = Fexpand_file_name (filename, Qnil);
3942
3943 BLOCK_INPUT;
908b0456
YM
3944#ifdef MAC_OSX
3945 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
3946#else
3947 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
3948#endif
9a4183e9
ST
3949
3950 if (status == noErr)
3951 {
908b0456 3952#ifdef MAC_OSX
9a4183e9 3953 FSCatalogInfo catalogInfo;
908b0456
YM
3954
3955 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
3956 &catalogInfo, NULL, NULL, NULL);
3957#else
3958 FInfo finder_info;
3959
3960 status = FSpGetFInfo (&fss, &finder_info);
3961#endif
5f8080a9 3962 if (status == noErr)
9a4183e9 3963 {
908b0456 3964#ifdef MAC_OSX
9a4183e9 3965 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator);
908b0456
YM
3966#else
3967 result = mac_get_object_from_code (finder_info.fdCreator);
3968#endif
9a4183e9
ST
3969 }
3970 }
3971 UNBLOCK_INPUT;
3972 if (status != noErr) {
3973 error ("Error while getting file information.");
3974 }
3975 return result;
3976}
3977
3978DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0,
3979 doc: /* Get the type code of FILENAME as a four character string. */)
fc3216cb 3980 (filename)
908b0456 3981 Lisp_Object filename;
9a4183e9
ST
3982{
3983 OSErr status;
908b0456
YM
3984#ifdef MAC_OSX
3985 FSRef fref;
3986#else
3987 FSSpec fss;
3988#endif
9a4183e9
ST
3989 Lisp_Object result = Qnil;
3990 CHECK_STRING (filename);
3991
3992 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3993 return Qnil;
3994 }
3995 filename = Fexpand_file_name (filename, Qnil);
3996
3997 BLOCK_INPUT;
908b0456
YM
3998#ifdef MAC_OSX
3999 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4000#else
4001 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4002#endif
9a4183e9
ST
4003
4004 if (status == noErr)
4005 {
908b0456 4006#ifdef MAC_OSX
9a4183e9 4007 FSCatalogInfo catalogInfo;
908b0456
YM
4008
4009 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
4010 &catalogInfo, NULL, NULL, NULL);
4011#else
4012 FInfo finder_info;
4013
4014 status = FSpGetFInfo (&fss, &finder_info);
4015#endif
5f8080a9 4016 if (status == noErr)
9a4183e9 4017 {
908b0456 4018#ifdef MAC_OSX
9a4183e9 4019 result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType);
908b0456
YM
4020#else
4021 result = mac_get_object_from_code (finder_info.fdType);
4022#endif
9a4183e9
ST
4023 }
4024 }
4025 UNBLOCK_INPUT;
4026 if (status != noErr) {
4027 error ("Error while getting file information.");
4028 }
4029 return result;
4030}
4031
4032DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0,
4033 doc: /* Set creator code of file FILENAME to CODE.
908b0456
YM
4034If non-nil, CODE must be a 4-character string. Otherwise, 'EMAx' is
4035assumed. Return non-nil if successful. */)
fc3216cb 4036 (filename, code)
908b0456 4037 Lisp_Object filename, code;
9a4183e9
ST
4038{
4039 OSErr status;
908b0456
YM
4040#ifdef MAC_OSX
4041 FSRef fref;
4042#else
4043 FSSpec fss;
4044#endif
9a4183e9
ST
4045 OSType cCode;
4046 CHECK_STRING (filename);
4047
4048 cCode = mac_get_code_from_arg(code, 'EMAx');
4049
4050 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4051 return Qnil;
4052 }
4053 filename = Fexpand_file_name (filename, Qnil);
4054
4055 BLOCK_INPUT;
908b0456
YM
4056#ifdef MAC_OSX
4057 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4058#else
4059 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4060#endif
9a4183e9
ST
4061
4062 if (status == noErr)
4063 {
908b0456 4064#ifdef MAC_OSX
9a4183e9
ST
4065 FSCatalogInfo catalogInfo;
4066 FSRef parentDir;
908b0456 4067 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
9a4183e9 4068 &catalogInfo, NULL, NULL, &parentDir);
908b0456
YM
4069#else
4070 FInfo finder_info;
4071
4072 status = FSpGetFInfo (&fss, &finder_info);
4073#endif
5f8080a9 4074 if (status == noErr)
9a4183e9 4075 {
908b0456 4076#ifdef MAC_OSX
9a4183e9 4077 ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode;
908b0456 4078 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
9a4183e9 4079 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
908b0456
YM
4080#else
4081 finder_info.fdCreator = cCode;
4082 status = FSpSetFInfo (&fss, &finder_info);
4083#endif
9a4183e9
ST
4084 }
4085 }
4086 UNBLOCK_INPUT;
4087 if (status != noErr) {
4088 error ("Error while setting creator information.");
4089 }
4090 return Qt;
4091}
4092
4093DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0,
4094 doc: /* Set file code of file FILENAME to CODE.
908b0456 4095CODE must be a 4-character string. Return non-nil if successful. */)
fc3216cb 4096 (filename, code)
908b0456 4097 Lisp_Object filename, code;
9a4183e9
ST
4098{
4099 OSErr status;
908b0456
YM
4100#ifdef MAC_OSX
4101 FSRef fref;
4102#else
4103 FSSpec fss;
4104#endif
9a4183e9
ST
4105 OSType cCode;
4106 CHECK_STRING (filename);
4107
4108 cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
4109
4110 if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
4111 return Qnil;
4112 }
4113 filename = Fexpand_file_name (filename, Qnil);
4114
4115 BLOCK_INPUT;
908b0456
YM
4116#ifdef MAC_OSX
4117 status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &fref, NULL);
4118#else
4119 status = posix_pathname_to_fsspec (SDATA (ENCODE_FILE (filename)), &fss);
4120#endif
9a4183e9
ST
4121
4122 if (status == noErr)
4123 {
908b0456 4124#ifdef MAC_OSX
9a4183e9
ST
4125 FSCatalogInfo catalogInfo;
4126 FSRef parentDir;
908b0456 4127 status = FSGetCatalogInfo(&fref, kFSCatInfoFinderInfo,
9a4183e9 4128 &catalogInfo, NULL, NULL, &parentDir);
908b0456
YM
4129#else
4130 FInfo finder_info;
4131
4132 status = FSpGetFInfo (&fss, &finder_info);
4133#endif
5f8080a9 4134 if (status == noErr)
9a4183e9 4135 {
908b0456 4136#ifdef MAC_OSX
9a4183e9 4137 ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode;
908b0456 4138 status = FSSetCatalogInfo(&fref, kFSCatInfoFinderInfo, &catalogInfo);
9a4183e9 4139 /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
908b0456
YM
4140#else
4141 finder_info.fdType = cCode;
4142 status = FSpSetFInfo (&fss, &finder_info);
4143#endif
9a4183e9
ST
4144 }
4145 }
4146 UNBLOCK_INPUT;
4147 if (status != noErr) {
4148 error ("Error while setting creator information.");
4149 }
4150 return Qt;
4151}
4152
1a578e9b
AC
4153
4154/* Compile and execute the AppleScript SCRIPT and return the error
4155 status as function value. A zero is returned if compilation and
70e88ff1
YM
4156 execution is successful, in which case *RESULT is set to a Lisp
4157 string containing the resulting script value. Otherwise, the Mac
4158 error code is returned and *RESULT is set to an error Lisp string.
4159 For documentation on the MacOS scripting architecture, see Inside
4160 Macintosh - Interapplication Communications: Scripting
4161 Components. */
1a578e9b
AC
4162
4163static long
70e88ff1
YM
4164do_applescript (script, result)
4165 Lisp_Object script, *result;
1a578e9b 4166{
70e88ff1 4167 AEDesc script_desc, result_desc, error_desc, *desc = NULL;
1a578e9b
AC
4168 OSErr error;
4169 OSAError osaerror;
1a578e9b 4170
70e88ff1 4171 *result = Qnil;
1a578e9b 4172
84c0c2cc
AC
4173 if (!as_scripting_component)
4174 initialize_applescript();
4175
70e88ff1
YM
4176 error = AECreateDesc (typeChar, SDATA (script), SBYTES (script),
4177 &script_desc);
1a578e9b
AC
4178 if (error)
4179 return error;
4180
4181 osaerror = OSADoScript (as_scripting_component, &script_desc, kOSANullScript,
4182 typeChar, kOSAModeNull, &result_desc);
4183
70e88ff1
YM
4184 if (osaerror == noErr)
4185 /* success: retrieve resulting script value */
4186 desc = &result_desc;
4187 else if (osaerror == errOSAScriptError)
4188 /* error executing AppleScript: retrieve error message */
4189 if (!OSAScriptError (as_scripting_component, kOSAErrorMessage, typeChar,
4190 &error_desc))
4191 desc = &error_desc;
4192
4193 if (desc)
1a578e9b 4194 {
e0f712ba 4195#if TARGET_API_MAC_CARBON
70e88ff1
YM
4196 *result = make_uninit_string (AEGetDescDataSize (desc));
4197 AEGetDescData (desc, SDATA (*result), SBYTES (*result));
e0f712ba 4198#else /* not TARGET_API_MAC_CARBON */
70e88ff1
YM
4199 *result = make_uninit_string (GetHandleSize (desc->dataHandle));
4200 memcpy (SDATA (*result), *(desc->dataHandle), SBYTES (*result));
e0f712ba 4201#endif /* not TARGET_API_MAC_CARBON */
70e88ff1 4202 AEDisposeDesc (desc);
1a578e9b
AC
4203 }
4204
4205 AEDisposeDesc (&script_desc);
1a578e9b
AC
4206
4207 return osaerror;
4208}
4209
4210
4211DEFUN ("do-applescript", Fdo_applescript, Sdo_applescript, 1, 1, 0,
fc3216cb 4212 doc: /* Compile and execute AppleScript SCRIPT and return the result.
e0f712ba
AC
4213If compilation and execution are successful, the resulting script
4214value is returned as a string. Otherwise the function aborts and
4215displays the error message returned by the AppleScript scripting
4216component. */)
fc3216cb 4217 (script)
1a578e9b
AC
4218 Lisp_Object script;
4219{
70e88ff1 4220 Lisp_Object result;
1a578e9b
AC
4221 long status;
4222
e0f712ba 4223 CHECK_STRING (script);
7d0393cf 4224
c3f4c690 4225 BLOCK_INPUT;
70e88ff1 4226 status = do_applescript (script, &result);
c3f4c690 4227 UNBLOCK_INPUT;
70e88ff1
YM
4228 if (status == 0)
4229 return result;
4230 else if (!STRINGP (result))
4231 error ("AppleScript error %d", status);
1a578e9b 4232 else
70e88ff1 4233 error ("%s", SDATA (result));
1a578e9b
AC
4234}
4235
4236
e0f712ba
AC
4237DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix,
4238 Smac_file_name_to_posix, 1, 1, 0,
fc3216cb
YM
4239 doc: /* Convert Macintosh FILENAME to Posix form. */)
4240 (filename)
4241 Lisp_Object filename;
1a578e9b 4242{
60fe1161 4243 char posix_filename[MAXPATHLEN+1];
1a578e9b 4244
fc3216cb 4245 CHECK_STRING (filename);
7d0393cf 4246
fc3216cb 4247 if (mac_to_posix_pathname (SDATA (filename), posix_filename, MAXPATHLEN))
60fe1161 4248 return build_string (posix_filename);
1a578e9b
AC
4249 else
4250 return Qnil;
4251}
4252
4253
e0f712ba
AC
4254DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac,
4255 Sposix_file_name_to_mac, 1, 1, 0,
fc3216cb
YM
4256 doc: /* Convert Posix FILENAME to Mac form. */)
4257 (filename)
4258 Lisp_Object filename;
1a578e9b
AC
4259{
4260 char mac_filename[MAXPATHLEN+1];
4261
fc3216cb 4262 CHECK_STRING (filename);
7d0393cf 4263
fc3216cb 4264 if (posix_to_mac_pathname (SDATA (filename), mac_filename, MAXPATHLEN))
1a578e9b
AC
4265 return build_string (mac_filename);
4266 else
4267 return Qnil;
4268}
4269
4270
31b6888a
YM
4271DEFUN ("mac-coerce-ae-data", Fmac_coerce_ae_data, Smac_coerce_ae_data, 3, 3, 0,
4272 doc: /* Coerce Apple event data SRC-DATA of type SRC-TYPE to DST-TYPE.
4273Each type should be a string of length 4 or the symbol
4274`undecoded-file-name'. */)
4275 (src_type, src_data, dst_type)
4276 Lisp_Object src_type, src_data, dst_type;
4277{
4278 OSErr err;
4279 Lisp_Object result = Qnil;
4280 DescType src_desc_type, dst_desc_type;
4281 AEDesc dst_desc;
31b6888a
YM
4282
4283 CHECK_STRING (src_data);
4284 if (EQ (src_type, Qundecoded_file_name))
7ce8b638 4285 src_desc_type = TYPE_FILE_NAME;
31b6888a
YM
4286 else
4287 src_desc_type = mac_get_code_from_arg (src_type, 0);
4288
4289 if (EQ (dst_type, Qundecoded_file_name))
7ce8b638 4290 dst_desc_type = TYPE_FILE_NAME;
31b6888a
YM
4291 else
4292 dst_desc_type = mac_get_code_from_arg (dst_type, 0);
4293
4294 BLOCK_INPUT;
7ce8b638 4295 err = AECoercePtr (src_desc_type, SDATA (src_data), SBYTES (src_data),
31b6888a 4296 dst_desc_type, &dst_desc);
31b6888a
YM
4297 if (err == noErr)
4298 {
7ce8b638 4299 result = Fcdr (mac_aedesc_to_lisp (&dst_desc));
31b6888a
YM
4300 AEDisposeDesc (&dst_desc);
4301 }
4302 UNBLOCK_INPUT;
4303
4304 return result;
4305}
4306
4307
e4959763 4308#if TARGET_API_MAC_CARBON
eb32b292
YM
4309static Lisp_Object Qxml, Qmime_charset;
4310static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C;
e4959763
YM
4311
4312DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0,
4313 doc: /* Return the application preference value for KEY.
4314KEY is either a string specifying a preference key, or a list of key
4315strings. If it is a list, the (i+1)-th element is used as a key for
fc3216cb
YM
4316the CFDictionary value obtained by the i-th element. Return nil if
4317lookup is failed at some stage.
e4959763
YM
4318
4319Optional arg APPLICATION is an application ID string. If omitted or
4320nil, that stands for the current application.
4321
4322Optional arg FORMAT specifies the data format of the return value. If
4323omitted or nil, each Core Foundation object is converted into a
4324corresponding Lisp object as follows:
4325
4326 Core Foundation Lisp Tag
4327 ------------------------------------------------------------
4328 CFString Multibyte string string
4329 CFNumber Integer or float number
4330 CFBoolean Symbol (t or nil) boolean
4331 CFDate List of three integers date
4332 (cf. `current-time')
4333 CFData Unibyte string data
d440d0de 4334 CFArray Vector array
e4959763
YM
4335 CFDictionary Alist or hash table dictionary
4336 (depending on HASH-BOUND)
4337
4338If it is t, a symbol that represents the type of the original Core
4339Foundation object is prepended. If it is `xml', the value is returned
4340as an XML representation.
4341
4342Optional arg HASH-BOUND specifies which kinds of the list objects,
4343alists or hash tables, are used as the targets of the conversion from
4344CFDictionary. If HASH-BOUND is a negative integer or nil, always
4345generate alists. If HASH-BOUND >= 0, generate an alist if the number
4346of keys in the dictionary is smaller than HASH-BOUND, and a hash table
4347otherwise. */)
fc3216cb 4348 (key, application, format, hash_bound)
e4959763
YM
4349 Lisp_Object key, application, format, hash_bound;
4350{
4351 CFStringRef app_id, key_str;
4352 CFPropertyListRef app_plist = NULL, plist;
4353 Lisp_Object result = Qnil, tmp;
4354
4355 if (STRINGP (key))
4356 key = Fcons (key, Qnil);
4357 else
4358 {
4359 CHECK_CONS (key);
4360 for (tmp = key; CONSP (tmp); tmp = XCDR (tmp))
4361 CHECK_STRING_CAR (tmp);
4362 if (!NILP (tmp))
4363 wrong_type_argument (Qlistp, key);
4364 }
4365 if (!NILP (application))
4366 CHECK_STRING (application);
4367 CHECK_SYMBOL (format);
4368 if (!NILP (hash_bound))
4369 CHECK_NUMBER (hash_bound);
4370
4371 BLOCK_INPUT;
4372
4373 app_id = kCFPreferencesCurrentApplication;
4374 if (!NILP (application))
4375 {
e8d8317c 4376 app_id = cfstring_create_with_string (application);
e4959763
YM
4377 if (app_id == NULL)
4378 goto out;
4379 }
e8d8317c 4380 key_str = cfstring_create_with_string (XCAR (key));
e4959763
YM
4381 if (key_str == NULL)
4382 goto out;
4383 app_plist = CFPreferencesCopyAppValue (key_str, app_id);
4384 CFRelease (key_str);
4385 if (app_plist == NULL)
4386 goto out;
4387
4388 plist = app_plist;
4389 for (key = XCDR (key); CONSP (key); key = XCDR (key))
4390 {
4391 if (CFGetTypeID (plist) != CFDictionaryGetTypeID ())
4392 break;
e8d8317c 4393 key_str = cfstring_create_with_string (XCAR (key));
e4959763
YM
4394 if (key_str == NULL)
4395 goto out;
4396 plist = CFDictionaryGetValue (plist, key_str);
4397 CFRelease (key_str);
4398 if (plist == NULL)
4399 goto out;
4400 }
4401
4402 if (NILP (key))
1fcd1370
YM
4403 {
4404 if (EQ (format, Qxml))
4405 {
4406 CFDataRef data = CFPropertyListCreateXMLData (NULL, plist);
4407 if (data == NULL)
4408 goto out;
4409 result = cfdata_to_lisp (data);
4410 CFRelease (data);
4411 }
4412 else
4413 result =
4414 cfproperty_list_to_lisp (plist, EQ (format, Qt),
4415 NILP (hash_bound) ? -1 : XINT (hash_bound));
4416 }
e4959763
YM
4417
4418 out:
4419 if (app_plist)
4420 CFRelease (app_plist);
4421 CFRelease (app_id);
4422
4423 UNBLOCK_INPUT;
4424
4425 return result;
4426}
eb32b292
YM
4427
4428
4429static CFStringEncoding
4430get_cfstring_encoding_from_lisp (obj)
4431 Lisp_Object obj;
4432{
4433 CFStringRef iana_name;
4434 CFStringEncoding encoding = kCFStringEncodingInvalidId;
4435
5f8080a9
YM
4436 if (NILP (obj))
4437 return kCFStringEncodingUnicode;
4438
eb32b292
YM
4439 if (INTEGERP (obj))
4440 return XINT (obj);
4441
5f8080a9 4442 if (SYMBOLP (obj) && !NILP (Fcoding_system_p (obj)))
eb32b292
YM
4443 {
4444 Lisp_Object coding_spec, plist;
4445
4446 coding_spec = Fget (obj, Qcoding_system);
4447 plist = XVECTOR (coding_spec)->contents[3];
4448 obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset);
4449 }
4450
4451 if (SYMBOLP (obj))
4452 obj = SYMBOL_NAME (obj);
4453
4454 if (STRINGP (obj))
4455 {
4456 iana_name = cfstring_create_with_string (obj);
4457 if (iana_name)
4458 {
4459 encoding = CFStringConvertIANACharSetNameToEncoding (iana_name);
4460 CFRelease (iana_name);
4461 }
4462 }
4463
4464 return encoding;
4465}
4466
4467#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4468static CFStringRef
4469cfstring_create_normalized (str, symbol)
4470 CFStringRef str;
4471 Lisp_Object symbol;
4472{
4473 int form = -1;
4474 TextEncodingVariant variant;
4475 float initial_mag = 0.0;
4476 CFStringRef result = NULL;
4477
4478 if (EQ (symbol, QNFD))
4479 form = kCFStringNormalizationFormD;
4480 else if (EQ (symbol, QNFKD))
4481 form = kCFStringNormalizationFormKD;
4482 else if (EQ (symbol, QNFC))
4483 form = kCFStringNormalizationFormC;
4484 else if (EQ (symbol, QNFKC))
4485 form = kCFStringNormalizationFormKC;
4486 else if (EQ (symbol, QHFS_plus_D))
4487 {
4488 variant = kUnicodeHFSPlusDecompVariant;
4489 initial_mag = 1.5;
4490 }
4491 else if (EQ (symbol, QHFS_plus_C))
4492 {
4493 variant = kUnicodeHFSPlusCompVariant;
4494 initial_mag = 1.0;
4495 }
4496
4497 if (form >= 0)
4498 {
4499 CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str);
4500
4501 if (mut_str)
4502 {
4503 CFStringNormalize (mut_str, form);
4504 result = mut_str;
4505 }
4506 }
4507 else if (initial_mag > 0.0)
4508 {
4509 UnicodeToTextInfo uni = NULL;
4510 UnicodeMapping map;
4511 CFIndex length;
4512 UniChar *in_text, *buffer = NULL, *out_buf = NULL;
4513 OSErr err = noErr;
4514 ByteCount out_read, out_size, out_len;
4515
4516 map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4517 kUnicodeNoSubset,
4518 kTextEncodingDefaultFormat);
4519 map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault,
4520 variant,
4521 kTextEncodingDefaultFormat);
4522 map.mappingVersion = kUnicodeUseLatestMapping;
4523
4524 length = CFStringGetLength (str);
4525 out_size = (int)((float)length * initial_mag) * sizeof (UniChar);
4526 if (out_size < 32)
4527 out_size = 32;
4528
4529 in_text = (UniChar *)CFStringGetCharactersPtr (str);
4530 if (in_text == NULL)
4531 {
4532 buffer = xmalloc (sizeof (UniChar) * length);
305366a3
YM
4533 CFStringGetCharacters (str, CFRangeMake (0, length), buffer);
4534 in_text = buffer;
eb32b292
YM
4535 }
4536
4537 if (in_text)
4538 err = CreateUnicodeToTextInfo(&map, &uni);
4539 while (err == noErr)
4540 {
4541 out_buf = xmalloc (out_size);
305366a3
YM
4542 err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar),
4543 in_text,
4544 kUnicodeDefaultDirectionMask,
4545 0, NULL, NULL, NULL,
4546 out_size, &out_read, &out_len,
4547 out_buf);
eb32b292
YM
4548 if (err == noErr && out_read < length * sizeof (UniChar))
4549 {
4550 xfree (out_buf);
4551 out_size += length;
4552 }
4553 else
4554 break;
4555 }
4556 if (err == noErr)
4557 result = CFStringCreateWithCharacters (NULL, out_buf,
4558 out_len / sizeof (UniChar));
4559 if (uni)
4560 DisposeUnicodeToTextInfo (&uni);
4561 if (out_buf)
4562 xfree (out_buf);
4563 if (buffer)
4564 xfree (buffer);
4565 }
4566 else
4567 {
4568 result = str;
4569 CFRetain (result);
4570 }
4571
4572 return result;
4573}
4574#endif
4575
4576DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0,
4577 doc: /* Convert STRING from SOURCE encoding to TARGET encoding.
4578The conversion is performed using the converter provided by the system.
4579Each encoding is specified by either a coding system symbol, a mime
5f8080a9 4580charset string, or an integer as a CFStringEncoding value. Nil for
10ae126c 4581encoding means UTF-16 in native byte order, no byte order mark.
eb32b292
YM
4582On Mac OS X 10.2 and later, you can do Unicode Normalization by
4583specifying the optional argument NORMALIZATION-FORM with a symbol NFD,
4584NFKD, NFC, NFKC, HFS+D, or HFS+C.
fc3216cb
YM
4585On successful conversion, return the result string, else return nil. */)
4586 (string, source, target, normalization_form)
eb32b292
YM
4587 Lisp_Object string, source, target, normalization_form;
4588{
4589 Lisp_Object result = Qnil;
4590 CFStringEncoding src_encoding, tgt_encoding;
4591 CFStringRef str = NULL;
eb32b292
YM
4592
4593 CHECK_STRING (string);
4594 if (!INTEGERP (source) && !STRINGP (source))
4595 CHECK_SYMBOL (source);
4596 if (!INTEGERP (target) && !STRINGP (target))
4597 CHECK_SYMBOL (target);
4598 CHECK_SYMBOL (normalization_form);
4599
4600 BLOCK_INPUT;
4601
4602 src_encoding = get_cfstring_encoding_from_lisp (source);
4603 tgt_encoding = get_cfstring_encoding_from_lisp (target);
4604
a4ed715a
SM
4605 /* We really want string_to_unibyte, but since it doesn't exist yet, we
4606 use string_as_unibyte which works as well, except for the fact that
4607 it's too permissive (it doesn't check that the multibyte string only
4608 contain single-byte chars). */
407289a4 4609 string = Fstring_as_unibyte (string);
eb32b292
YM
4610 if (src_encoding != kCFStringEncodingInvalidId
4611 && tgt_encoding != kCFStringEncodingInvalidId)
4612 str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string),
5f8080a9 4613 src_encoding, !NILP (source));
eb32b292
YM
4614#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020
4615 if (str)
4616 {
4617 CFStringRef saved_str = str;
4618
4619 str = cfstring_create_normalized (saved_str, normalization_form);
4620 CFRelease (saved_str);
4621 }
4622#endif
4623 if (str)
4624 {
5f8080a9
YM
4625 CFIndex str_len, buf_len;
4626
4627 str_len = CFStringGetLength (str);
4628 if (CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4629 !NILP (target), NULL, 0, &buf_len) == str_len)
4630 {
4631 result = make_uninit_string (buf_len);
4632 CFStringGetBytes (str, CFRangeMake (0, str_len), tgt_encoding, 0,
4633 !NILP (target), SDATA (result), buf_len, NULL);
4634 }
eb32b292
YM
4635 CFRelease (str);
4636 }
eb32b292
YM
4637
4638 UNBLOCK_INPUT;
4639
4640 return result;
4641}
e4959763
YM
4642#endif /* TARGET_API_MAC_CARBON */
4643
b15325b2
ST
4644
4645DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_name_table, 0, 0, 0,
4646 doc: /* Clear the font name table. */)
fc3216cb 4647 ()
b15325b2
ST
4648{
4649 check_mac ();
4650 mac_clear_font_name_table ();
4651 return Qnil;
4652}
4653
10ae126c
YM
4654
4655static Lisp_Object
4656mac_get_system_locale ()
4657{
4658 OSErr err;
4659 LangCode lang;
4660 RegionCode region;
4661 LocaleRef locale;
4662 Str255 str;
4663
4664 lang = GetScriptVariable (smSystemScript, smScriptLang);
4665 region = GetScriptManagerVariable (smRegionCode);
4666 err = LocaleRefFromLangOrRegionCode (lang, region, &locale);
4667 if (err == noErr)
4668 err = LocaleRefGetPartString (locale, kLocaleAllPartsMask,
4669 sizeof (str), str);
4670 if (err == noErr)
4671 return build_string (str);
4672 else
4673 return Qnil;
4674}
4675
4676
8030369c 4677#ifdef MAC_OSX
8030369c
AC
4678
4679extern int inhibit_window_system;
2b187eac 4680extern int noninteractive;
8030369c 4681
b15325b2
ST
4682/* Unlike in X11, window events in Carbon do not come from sockets.
4683 So we cannot simply use `select' to monitor two kinds of inputs:
4684 window events and process outputs. We emulate such functionality
4685 by regarding fd 0 as the window event channel and simultaneously
4686 monitoring both kinds of input channels. It is implemented by
4687 dividing into some cases:
4688 1. The window event channel is not involved.
4689 -> Use `select'.
4690 2. Sockets are not involved.
4691 -> Use ReceiveNextEvent.
4692 3. [If SELECT_USE_CFSOCKET is defined]
4693 Only the window event channel and socket read channels are
4694 involved, and timeout is not too short (greater than
4695 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
4696 -> Create CFSocket for each socket and add it into the current
10ae126c 4697 event RunLoop so that a `ready-to-read' event can be posted
b15325b2
ST
4698 to the event queue that is also used for window events. Then
4699 ReceiveNextEvent can wait for both kinds of inputs.
4700 4. Otherwise.
4701 -> Periodically poll the window input channel while repeatedly
4702 executing `select' with a short timeout
4703 (SELECT_POLLING_PERIOD_USEC microseconds). */
4704
4705#define SELECT_POLLING_PERIOD_USEC 20000
4706#ifdef SELECT_USE_CFSOCKET
4707#define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
4708#define EVENT_CLASS_SOCK 'Sock'
4709
4710static void
4711socket_callback (s, type, address, data, info)
4712 CFSocketRef s;
4713 CFSocketCallBackType type;
4714 CFDataRef address;
4715 const void *data;
4716 void *info;
4717{
4718 EventRef event;
4719
4720 CreateEvent (NULL, EVENT_CLASS_SOCK, 0, 0, kEventAttributeNone, &event);
4721 PostEventToQueue (GetCurrentEventQueue (), event, kEventPriorityStandard);
4722 ReleaseEvent (event);
4723}
4724#endif /* SELECT_USE_CFSOCKET */
4725
4726static int
4727select_and_poll_event (n, rfds, wfds, efds, timeout)
4728 int n;
4729 SELECT_TYPE *rfds;
4730 SELECT_TYPE *wfds;
4731 SELECT_TYPE *efds;
4732 struct timeval *timeout;
4733{
4734 int r;
4735 OSErr err;
4736
4737 r = select (n, rfds, wfds, efds, timeout);
4738 if (r != -1)
4739 {
4740 BLOCK_INPUT;
4741 err = ReceiveNextEvent (0, NULL, kEventDurationNoWait,
4742 kEventLeaveInQueue, NULL);
4743 UNBLOCK_INPUT;
4744 if (err == noErr)
4745 {
4746 FD_SET (0, rfds);
4747 r++;
4748 }
4749 }
4750 return r;
4751}
4752
856a5c5b 4753#if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
b15325b2
ST
4754#undef SELECT_INVALIDATE_CFSOCKET
4755#endif
4756
8030369c
AC
4757int
4758sys_select (n, rfds, wfds, efds, timeout)
bfcf6608
ST
4759 int n;
4760 SELECT_TYPE *rfds;
4761 SELECT_TYPE *wfds;
4762 SELECT_TYPE *efds;
4763 struct timeval *timeout;
8030369c 4764{
bfcf6608 4765 OSErr err;
b15325b2
ST
4766 int i, r;
4767 EMACS_TIME select_timeout;
4768
e082ac9d
ST
4769 if (inhibit_window_system || noninteractive
4770 || rfds == NULL || !FD_ISSET (0, rfds))
bfcf6608 4771 return select (n, rfds, wfds, efds, timeout);
b15325b2
ST
4772
4773 FD_CLR (0, rfds);
4774
bfcf6608 4775 if (wfds == NULL && efds == NULL)
2b187eac 4776 {
b15325b2
ST
4777 int nsocks = 0;
4778 SELECT_TYPE orfds = *rfds;
4779
4780 EventTimeout timeout_sec =
4781 (timeout
4782 ? (EMACS_SECS (*timeout) * kEventDurationSecond
4783 + EMACS_USECS (*timeout) * kEventDurationMicrosecond)
4784 : kEventDurationForever);
bfcf6608
ST
4785
4786 for (i = 1; i < n; i++)
4787 if (FD_ISSET (i, rfds))
b15325b2 4788 nsocks++;
bfcf6608 4789
b15325b2
ST
4790 if (nsocks == 0)
4791 {
bfcf6608
ST
4792 BLOCK_INPUT;
4793 err = ReceiveNextEvent (0, NULL, timeout_sec,
4794 kEventLeaveInQueue, NULL);
4795 UNBLOCK_INPUT;
4796 if (err == noErr)
96720f09 4797 {
e082ac9d
ST
4798 FD_SET (0, rfds);
4799 return 1;
96720f09 4800 }
bfcf6608
ST
4801 else
4802 return 0;
2b187eac 4803 }
2b187eac 4804
5093b9dc
YM
4805#if USE_CG_DRAWING
4806 mac_prepare_for_quickdraw (NULL);
4807#endif
b15325b2
ST
4808 /* Avoid initial overhead of RunLoop setup for the case that
4809 some input is already available. */
4810 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
4811 r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
4812 if (r != 0 || timeout_sec == 0.0)
4813 return r;
177c0ea7 4814
b15325b2 4815 *rfds = orfds;
bfcf6608 4816
b15325b2
ST
4817#ifdef SELECT_USE_CFSOCKET
4818 if (timeout_sec > 0 && timeout_sec <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
4819 goto poll_periodically;
bfcf6608 4820
b15325b2
ST
4821 {
4822 CFRunLoopRef runloop =
4823 (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
4824 EventTypeSpec specs[] = {{EVENT_CLASS_SOCK, 0}};
4825#ifdef SELECT_INVALIDATE_CFSOCKET
4826 CFSocketRef *shead, *s;
4827#else
4828 CFRunLoopSourceRef *shead, *s;
4829#endif
4830
4831 BLOCK_INPUT;
4832
4833#ifdef SELECT_INVALIDATE_CFSOCKET
4834 shead = xmalloc (sizeof (CFSocketRef) * nsocks);
4835#else
4836 shead = xmalloc (sizeof (CFRunLoopSourceRef) * nsocks);
4837#endif
4838 s = shead;
4839 for (i = 1; i < n; i++)
4840 if (FD_ISSET (i, rfds))
bfcf6608 4841 {
b15325b2
ST
4842 CFSocketRef socket =
4843 CFSocketCreateWithNative (NULL, i, kCFSocketReadCallBack,
4844 socket_callback, NULL);
4845 CFRunLoopSourceRef source =
4846 CFSocketCreateRunLoopSource (NULL, socket, 0);
4847
4848#ifdef SELECT_INVALIDATE_CFSOCKET
4849 CFSocketSetSocketFlags (socket, 0);
4850#endif
4851 CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode);
4852#ifdef SELECT_INVALIDATE_CFSOCKET
4853 CFRelease (source);
4854 *s = socket;
4855#else
4856 CFRelease (socket);
4857 *s = source;
4858#endif
4859 s++;
bfcf6608 4860 }
1000788b 4861
b15325b2
ST
4862 err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL);
4863
4864 do
4865 {
4866 --s;
4867#ifdef SELECT_INVALIDATE_CFSOCKET
4868 CFSocketInvalidate (*s);
4869#else
4870 CFRunLoopRemoveSource (runloop, *s, kCFRunLoopDefaultMode);
4871#endif
4872 CFRelease (*s);
4873 }
4874 while (s != shead);
4875
4876 xfree (shead);
4877
4878 if (err)
4879 {
4880 FD_ZERO (rfds);
4881 r = 0;
4882 }
4883 else
4884 {
4885 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4886 GetEventTypeCount (specs),
4887 specs);
4888 EMACS_SET_SECS_USECS (select_timeout, 0, 0);
4889 r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
4890 }
4891
4892 UNBLOCK_INPUT;
4893
4894 return r;
4895 }
4896#endif /* SELECT_USE_CFSOCKET */
bfcf6608 4897 }
bfcf6608 4898
b15325b2
ST
4899 poll_periodically:
4900 {
4901 EMACS_TIME end_time, now, remaining_time;
4902 SELECT_TYPE orfds = *rfds, owfds, oefds;
4903
4904 if (wfds)
4905 owfds = *wfds;
4906 if (efds)
4907 oefds = *efds;
4908 if (timeout)
4909 {
4910 remaining_time = *timeout;
4911 EMACS_GET_TIME (now);
4912 EMACS_ADD_TIME (end_time, now, remaining_time);
4913 }
4914
4915 do
4916 {
4917 EMACS_SET_SECS_USECS (select_timeout, 0, SELECT_POLLING_PERIOD_USEC);
4918 if (timeout && EMACS_TIME_LT (remaining_time, select_timeout))
4919 select_timeout = remaining_time;
4920 r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout);
4921 if (r != 0)
4922 return r;
4923
4924 *rfds = orfds;
4925 if (wfds)
4926 *wfds = owfds;
4927 if (efds)
4928 *efds = oefds;
4929
4930 if (timeout)
4931 {
4932 EMACS_GET_TIME (now);
4933 EMACS_SUB_TIME (remaining_time, end_time, now);
4934 }
4935 }
4936 while (!timeout || EMACS_TIME_LT (now, end_time));
4937
4938 FD_ZERO (rfds);
4939 if (wfds)
4940 FD_ZERO (wfds);
4941 if (efds)
4942 FD_ZERO (efds);
4943 return 0;
4944 }
bfcf6608 4945}
1000788b
AC
4946
4947/* Set up environment variables so that Emacs can correctly find its
4948 support files when packaged as an application bundle. Directories
4949 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4950 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4951 by `make install' by default can instead be placed in
4952 .../Emacs.app/Contents/Resources/ and
4953 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4954 is changed only if it is not already set. Presumably if the user
4955 sets an environment variable, he will want to use files in his path
4956 instead of ones in the application bundle. */
4957void
4958init_mac_osx_environment ()
4959{
4960 CFBundleRef bundle;
4961 CFURLRef bundleURL;
4962 CFStringRef cf_app_bundle_pathname;
4963 int app_bundle_pathname_len;
4964 char *app_bundle_pathname;
4965 char *p, *q;
4966 struct stat st;
4967
10ae126c
YM
4968 /* Initialize locale related variables. */
4969 mac_system_script_code =
4970 (ScriptCode) GetScriptManagerVariable (smSysScript);
4971 Vmac_system_locale = mac_get_system_locale ();
4972
1000788b
AC
4973 /* Fetch the pathname of the application bundle as a C string into
4974 app_bundle_pathname. */
4975
4976 bundle = CFBundleGetMainBundle ();
fc3216cb
YM
4977 if (!bundle || CFBundleGetIdentifier (bundle) == NULL)
4978 {
4979 /* We could not find the bundle identifier. For now, prevent
4980 the fatal error by bringing it up in the terminal. */
4981 inhibit_window_system = 1;
4982 return;
4983 }
1000788b
AC
4984
4985 bundleURL = CFBundleCopyBundleURL (bundle);
4986 if (!bundleURL)
4987 return;
4988
4989 cf_app_bundle_pathname = CFURLCopyFileSystemPath (bundleURL,
4990 kCFURLPOSIXPathStyle);
4991 app_bundle_pathname_len = CFStringGetLength (cf_app_bundle_pathname);
4992 app_bundle_pathname = (char *) alloca (app_bundle_pathname_len + 1);
4993
4994 if (!CFStringGetCString (cf_app_bundle_pathname,
4995 app_bundle_pathname,
4996 app_bundle_pathname_len + 1,
4997 kCFStringEncodingISOLatin1))
4998 {
4999 CFRelease (cf_app_bundle_pathname);
5000 return;
5001 }
5002
5003 CFRelease (cf_app_bundle_pathname);
5004
5005 /* P should have sufficient room for the pathname of the bundle plus
5006 the subpath in it leading to the respective directories. Q
5007 should have three times that much room because EMACSLOADPATH can
5008 have the value "<path to lisp dir>:<path to leim dir>:<path to
5009 site-lisp dir>". */
5010 p = (char *) alloca (app_bundle_pathname_len + 50);
5011 q = (char *) alloca (3 * app_bundle_pathname_len + 150);
5012 if (!getenv ("EMACSLOADPATH"))
5013 {
5014 q[0] = '\0';
5015
5016 strcpy (p, app_bundle_pathname);
5017 strcat (p, "/Contents/Resources/lisp");
5018 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5019 strcat (q, p);
5020
5021 strcpy (p, app_bundle_pathname);
5022 strcat (p, "/Contents/Resources/leim");
5023 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5024 {
5025 if (q[0] != '\0')
5026 strcat (q, ":");
5027 strcat (q, p);
5028 }
5029
5030 strcpy (p, app_bundle_pathname);
5031 strcat (p, "/Contents/Resources/site-lisp");
5032 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5033 {
5034 if (q[0] != '\0')
5035 strcat (q, ":");
5036 strcat (q, p);
5037 }
5038
5039 if (q[0] != '\0')
5040 setenv ("EMACSLOADPATH", q, 1);
5041 }
5042
5043 if (!getenv ("EMACSPATH"))
5044 {
5045 q[0] = '\0';
5046
5047 strcpy (p, app_bundle_pathname);
e8f25745 5048 strcat (p, "/Contents/MacOS/libexec");
1000788b
AC
5049 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5050 strcat (q, p);
5051
5052 strcpy (p, app_bundle_pathname);
e8f25745 5053 strcat (p, "/Contents/MacOS/bin");
1000788b
AC
5054 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5055 {
5056 if (q[0] != '\0')
5057 strcat (q, ":");
5058 strcat (q, p);
5059 }
5060
5061 if (q[0] != '\0')
5062 setenv ("EMACSPATH", q, 1);
5063 }
5064
5065 if (!getenv ("EMACSDATA"))
5066 {
5067 strcpy (p, app_bundle_pathname);
5068 strcat (p, "/Contents/Resources/etc");
5069 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5070 setenv ("EMACSDATA", p, 1);
5071 }
5072
5073 if (!getenv ("EMACSDOC"))
5074 {
5075 strcpy (p, app_bundle_pathname);
5076 strcat (p, "/Contents/Resources/etc");
5077 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5078 setenv ("EMACSDOC", p, 1);
5079 }
5080
5081 if (!getenv ("INFOPATH"))
5082 {
5083 strcpy (p, app_bundle_pathname);
5084 strcat (p, "/Contents/Resources/info");
5085 if (stat (p, &st) == 0 && (st.st_mode & S_IFMT) == S_IFDIR)
5086 setenv ("INFOPATH", p, 1);
5087 }
5088}
8030369c 5089#endif /* MAC_OSX */
1a578e9b 5090
42c6741e 5091
1a578e9b
AC
5092void
5093syms_of_mac ()
5094{
31b6888a
YM
5095 Qundecoded_file_name = intern ("undecoded-file-name");
5096 staticpro (&Qundecoded_file_name);
5097
e4959763 5098#if TARGET_API_MAC_CARBON
d440d0de
YM
5099 Qstring = intern ("string"); staticpro (&Qstring);
5100 Qnumber = intern ("number"); staticpro (&Qnumber);
5101 Qboolean = intern ("boolean"); staticpro (&Qboolean);
5102 Qdate = intern ("date"); staticpro (&Qdate);
5103 Qdata = intern ("data"); staticpro (&Qdata);
5104 Qarray = intern ("array"); staticpro (&Qarray);
5105 Qdictionary = intern ("dictionary"); staticpro (&Qdictionary);
e4959763
YM
5106
5107 Qxml = intern ("xml");
5108 staticpro (&Qxml);
eb32b292
YM
5109
5110 Qmime_charset = intern ("mime-charset");
5111 staticpro (&Qmime_charset);
5112
5113 QNFD = intern ("NFD"); staticpro (&QNFD);
5114 QNFKD = intern ("NFKD"); staticpro (&QNFKD);
5115 QNFC = intern ("NFC"); staticpro (&QNFC);
5116 QNFKC = intern ("NFKC"); staticpro (&QNFKC);
5117 QHFS_plus_D = intern ("HFS+D"); staticpro (&QHFS_plus_D);
5118 QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C);
e4959763
YM
5119#endif
5120
31b6888a 5121 defsubr (&Smac_coerce_ae_data);
e4959763
YM
5122#if TARGET_API_MAC_CARBON
5123 defsubr (&Smac_get_preference);
eb32b292 5124 defsubr (&Smac_code_convert_string);
e4959763 5125#endif
b15325b2 5126 defsubr (&Smac_clear_font_name_table);
1a578e9b 5127
9a4183e9
ST
5128 defsubr (&Smac_set_file_creator);
5129 defsubr (&Smac_set_file_type);
5130 defsubr (&Smac_get_file_creator);
5131 defsubr (&Smac_get_file_type);
1a578e9b 5132 defsubr (&Sdo_applescript);
60fe1161
AC
5133 defsubr (&Smac_file_name_to_posix);
5134 defsubr (&Sposix_file_name_to_mac);
42c6741e
YM
5135
5136 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code,
5137 doc: /* The system script code. */);
5138 mac_system_script_code = (ScriptCode) GetScriptManagerVariable (smSysScript);
5139
5140 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale,
5141 doc: /* The system locale identifier string.
5142This is not a POSIX locale ID, but an ICU locale ID. So encoding
5143information is not included. */);
5144 Vmac_system_locale = mac_get_system_locale ();
1a578e9b 5145}
ab5796a9
MB
5146
5147/* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
5148 (do not change this comment) */