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