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