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