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