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