1 /* Unix emulation routines for GNU Emacs on the Mac OS.
2 Copyright (C) 2000, 2001 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
31 #include "sysselect.h"
33 #include "blockinput.h"
40 #include <TextUtils.h>
42 #include <Resources.h>
47 #include <AppleScript.h>
50 #include <Processes.h>
52 #endif /* not HAVE_CARBON */
56 #include <sys/types.h>
61 #include <sys/param.h>
68 Lisp_Object QCLIPBOARD
;
70 /* An instance of the AppleScript component. */
71 static ComponentInstance as_scripting_component
;
72 /* The single script context used for all script executions. */
73 static OSAID as_script_context
;
76 /* When converting from Mac to Unix pathnames, /'s in folder names are
77 converted to :'s. This function, used in copying folder names,
78 performs a strncat and converts all character a to b in the copy of
79 the string s2 appended to the end of s1. */
82 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
90 for (i
= 0; i
< l2
; i
++)
99 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
100 that does not begin with a ':' and contains at least one ':'. A Mac
101 full pathname causes a '/' to be prepended to the Posix pathname.
102 The algorithm for the rest of the pathname is as follows:
103 For each segment between two ':',
104 if it is non-null, copy as is and then add a '/' at the end,
105 otherwise, insert a "../" into the Posix pathname.
106 Returns 1 if successful; 0 if fails. */
109 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
111 const char *p
, *q
, *pe
;
118 p
= strchr (mfn
, ':');
119 if (p
!= 0 && p
!= mfn
) /* full pathname */
126 pe
= mfn
+ strlen (mfn
);
133 { /* two consecutive ':' */
134 if (strlen (ufn
) + 3 >= ufnbuflen
)
140 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
142 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
149 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
151 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
152 /* no separator for last one */
161 extern char *get_temp_dir_name ();
164 /* Convert a Posix pathname to Mac form. Approximately reverse of the
165 above in algorithm. */
168 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
170 const char *p
, *q
, *pe
;
171 char expanded_pathname
[MAXPATHLEN
+1];
180 /* Check for and handle volume names. Last comparison: strangely
181 somewhere "/.emacs" is passed. A temporary fix for now. */
182 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
184 if (strlen (p
) + 1 > mfnbuflen
)
191 /* expand to emacs dir found by init_emacs_passwd_dir */
192 if (strncmp (p
, "~emacs/", 7) == 0)
194 struct passwd
*pw
= getpwnam ("emacs");
196 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
198 strcpy (expanded_pathname
, pw
->pw_dir
);
199 strcat (expanded_pathname
, p
);
200 p
= expanded_pathname
;
201 /* now p points to the pathname with emacs dir prefix */
203 else if (strncmp (p
, "/tmp/", 5) == 0)
205 char *t
= get_temp_dir_name ();
207 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
209 strcpy (expanded_pathname
, t
);
210 strcat (expanded_pathname
, p
);
211 p
= expanded_pathname
;
212 /* now p points to the pathname with emacs dir prefix */
214 else if (*p
!= '/') /* relative pathname */
226 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
228 if (strlen (mfn
) + 1 >= mfnbuflen
)
234 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
236 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
243 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
245 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
254 /***********************************************************************
255 Conversion between Lisp and Core Foundation objects
256 ***********************************************************************/
258 #if TARGET_API_MAC_CARBON
259 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
260 static Lisp_Object Qarray
, Qdictionary
;
261 extern Lisp_Object Qutf_8
;
262 #define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
264 struct cfdict_context
267 int with_tag
, hash_bound
;
270 /* C string to CFString. */
273 cfstring_create_with_utf8_cstring (c_str
)
278 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
280 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
281 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
287 /* From CFData to a lisp string. Always returns a unibyte string. */
290 cfdata_to_lisp (data
)
293 CFIndex len
= CFDataGetLength (data
);
294 Lisp_Object result
= make_uninit_string (len
);
296 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
302 /* From CFString to a lisp string. Never returns a unibyte string
303 (even if it only contains ASCII characters).
304 This may cause GC during code conversion. */
307 cfstring_to_lisp (string
)
310 Lisp_Object result
= Qnil
;
311 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
314 result
= make_unibyte_string (s
, strlen (s
));
318 CFStringCreateExternalRepresentation (NULL
, string
,
319 kCFStringEncodingUTF8
, '?');
323 result
= cfdata_to_lisp (data
);
330 result
= DECODE_UTF_8 (result
);
331 /* This may be superfluous. Just to make sure that the result
332 is a multibyte string. */
333 result
= string_to_multibyte (result
);
340 /* CFNumber to a lisp integer or a lisp float. */
343 cfnumber_to_lisp (number
)
346 Lisp_Object result
= Qnil
;
347 #if BITS_PER_EMACS_INT > 32
349 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
352 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
356 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
357 && !FIXNUM_OVERFLOW_P (int_val
))
358 result
= make_number (int_val
);
360 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
361 result
= make_float (float_val
);
366 /* CFDate to a list of three integers as in a return value of
370 cfdate_to_lisp (date
)
373 static CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
374 static CFAbsoluteTime epoch
= 0.0, sec
;
378 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
380 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
381 high
= sec
/ 65536.0;
382 low
= sec
- high
* 65536.0;
384 return list3 (make_number (high
), make_number (low
), make_number (0));
388 /* CFBoolean to a lisp symbol, `t' or `nil'. */
391 cfboolean_to_lisp (boolean
)
392 CFBooleanRef boolean
;
394 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
398 /* Any Core Foundation object to a (lengthy) lisp string. */
401 cfobject_desc_to_lisp (object
)
404 Lisp_Object result
= Qnil
;
405 CFStringRef desc
= CFCopyDescription (object
);
409 result
= cfstring_to_lisp (desc
);
417 /* Callback functions for cfproperty_list_to_lisp. */
420 cfdictionary_add_to_list (key
, value
, context
)
425 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
428 Fcons (Fcons (cfstring_to_lisp (key
),
429 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
435 cfdictionary_puthash (key
, value
, context
)
440 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
441 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
442 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
445 hash_lookup (h
, lisp_key
, &hash_code
);
446 hash_put (h
, lisp_key
,
447 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
452 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
453 non-zero, a symbol that represents the type of the original Core
454 Foundation object is prepended. HASH_BOUND specifies which kinds
455 of the lisp objects, alists or hash tables, are used as the targets
456 of the conversion from CFDictionary. If HASH_BOUND is negative,
457 always generate alists. If HASH_BOUND >= 0, generate an alist if
458 the number of keys in the dictionary is smaller than HASH_BOUND,
459 and a hash table otherwise. */
462 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
463 CFPropertyListRef plist
;
464 int with_tag
, hash_bound
;
466 CFTypeID type_id
= CFGetTypeID (plist
);
467 Lisp_Object tag
= Qnil
, result
= Qnil
;
468 struct gcpro gcpro1
, gcpro2
;
470 GCPRO2 (tag
, result
);
472 if (type_id
== CFStringGetTypeID ())
475 result
= cfstring_to_lisp (plist
);
477 else if (type_id
== CFNumberGetTypeID ())
480 result
= cfnumber_to_lisp (plist
);
482 else if (type_id
== CFBooleanGetTypeID ())
485 result
= cfboolean_to_lisp (plist
);
487 else if (type_id
== CFDateGetTypeID ())
490 result
= cfdate_to_lisp (plist
);
492 else if (type_id
== CFDataGetTypeID ())
495 result
= cfdata_to_lisp (plist
);
497 else if (type_id
== CFArrayGetTypeID ())
499 CFIndex index
, count
= CFArrayGetCount (plist
);
502 result
= Fmake_vector (make_number (count
), Qnil
);
503 for (index
= 0; index
< count
; index
++)
504 XVECTOR (result
)->contents
[index
] =
505 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
506 with_tag
, hash_bound
);
508 else if (type_id
== CFDictionaryGetTypeID ())
510 struct cfdict_context context
;
511 CFIndex count
= CFDictionaryGetCount (plist
);
514 context
.result
= &result
;
515 context
.with_tag
= with_tag
;
516 context
.hash_bound
= hash_bound
;
517 if (hash_bound
< 0 || count
< hash_bound
)
520 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
525 result
= make_hash_table (Qequal
,
527 make_float (DEFAULT_REHASH_SIZE
),
528 make_float (DEFAULT_REHASH_THRESHOLD
),
530 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
540 result
= Fcons (tag
, result
);
547 /***********************************************************************
548 Emulation of the X Resource Manager
549 ***********************************************************************/
551 /* Parser functions for resource lines. Each function takes an
552 address of a variable whose value points to the head of a string.
553 The value will be advanced so that it points to the next character
554 of the parsed part when the function returns.
556 A resource name such as "Emacs*font" is parsed into a non-empty
557 list called `quarks'. Each element is either a Lisp string that
558 represents a concrete component, a Lisp symbol LOOSE_BINDING
559 (actually Qlambda) that represents any number (>=0) of intervening
560 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
561 that represents as any single component. */
565 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
566 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
572 /* WhiteSpace = {<space> | <horizontal tab>} */
573 while (*P
== ' ' || *P
== '\t')
581 /* Comment = "!" {<any character except null or newline>} */
594 /* Don't interpret filename. Just skip until the newline. */
596 parse_include_file (p
)
599 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
616 /* Binding = "." | "*" */
617 if (*P
== '.' || *P
== '*')
621 while (*P
== '.' || *P
== '*')
634 /* Component = "?" | ComponentName
635 ComponentName = NameChar {NameChar}
636 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
640 return SINGLE_COMPONENT
;
642 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
646 while (isalnum (*P
) || *P
== '_' || *P
== '-')
649 return make_unibyte_string (start
, P
- start
);
656 parse_resource_name (p
)
659 Lisp_Object result
= Qnil
, component
;
662 /* ResourceName = [Binding] {Component Binding} ComponentName */
663 if (parse_binding (p
) == '*')
664 result
= Fcons (LOOSE_BINDING
, result
);
666 component
= parse_component (p
);
667 if (NILP (component
))
670 result
= Fcons (component
, result
);
671 while (binding
= parse_binding (p
))
674 result
= Fcons (LOOSE_BINDING
, result
);
675 component
= parse_component (p
);
676 if (NILP (component
))
679 result
= Fcons (component
, result
);
682 /* The final component should not be '?'. */
683 if (EQ (component
, SINGLE_COMPONENT
))
686 return Fnreverse (result
);
694 Lisp_Object seq
= Qnil
, result
;
695 int buf_len
, total_len
= 0, len
, continue_p
;
697 q
= strchr (P
, '\n');
698 buf_len
= q
? q
- P
: strlen (P
);
699 buf
= xmalloc (buf_len
);
728 else if ('0' <= P
[0] && P
[0] <= '7'
729 && '0' <= P
[1] && P
[1] <= '7'
730 && '0' <= P
[2] && P
[2] <= '7')
732 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
742 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
747 q
= strchr (P
, '\n');
748 len
= q
? q
- P
: strlen (P
);
753 buf
= xmalloc (buf_len
);
761 if (SBYTES (XCAR (seq
)) == total_len
)
762 return make_string (SDATA (XCAR (seq
)), total_len
);
765 buf
= xmalloc (total_len
);
767 for (; CONSP (seq
); seq
= XCDR (seq
))
769 len
= SBYTES (XCAR (seq
));
771 memcpy (q
, SDATA (XCAR (seq
)), len
);
773 result
= make_string (buf
, total_len
);
780 parse_resource_line (p
)
783 Lisp_Object quarks
, value
;
785 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
786 if (parse_comment (p
) || parse_include_file (p
))
789 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
790 skip_white_space (p
);
791 quarks
= parse_resource_name (p
);
794 skip_white_space (p
);
798 skip_white_space (p
);
799 value
= parse_value (p
);
800 return Fcons (quarks
, value
);
803 /* Skip the remaining data as a dummy value. */
810 /* Equivalents of X Resource Manager functions.
812 An X Resource Database acts as a collection of resource names and
813 associated values. It is implemented as a trie on quarks. Namely,
814 each edge is labeled by either a string, LOOSE_BINDING, or
815 SINGLE_COMPONENT. Nodes of the trie are implemented as Lisp hash
816 tables, and a value associated with a resource name is recorded as
817 a value for HASHKEY_TERMINAL at the hash table whose path from the
818 root is the quarks of the resource name. */
820 #define HASHKEY_TERMINAL Qt /* "T"erminal */
823 xrm_create_database ()
825 return make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
826 make_float (DEFAULT_REHASH_SIZE
),
827 make_float (DEFAULT_REHASH_THRESHOLD
),
832 xrm_q_put_resource (database
, quarks
, value
)
833 XrmDatabase database
;
834 Lisp_Object quarks
, value
;
836 struct Lisp_Hash_Table
*h
;
840 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
842 h
= XHASH_TABLE (database
);
843 i
= hash_lookup (h
, XCAR (quarks
), &hash_code
);
846 database
= xrm_create_database ();
847 hash_put (h
, XCAR (quarks
), database
, hash_code
);
850 database
= HASH_VALUE (h
, i
);
853 Fputhash (HASHKEY_TERMINAL
, value
, database
);
856 /* Merge multiple resource entries specified by DATA into a resource
857 database DATABASE. DATA points to the head of a null-terminated
858 string consisting of multiple resource lines. It's like a
859 combination of XrmGetStringDatabase and XrmMergeDatabases. */
862 xrm_merge_string_database (database
, data
)
863 XrmDatabase database
;
866 Lisp_Object quarks_value
;
870 quarks_value
= parse_resource_line (&data
);
871 if (!NILP (quarks_value
))
872 xrm_q_put_resource (database
,
873 XCAR (quarks_value
), XCDR (quarks_value
));
878 xrm_q_get_resource (database
, quark_name
, quark_class
)
879 XrmDatabase database
;
880 Lisp_Object quark_name
, quark_class
;
882 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
883 Lisp_Object keys
[3], value
;
886 if (!CONSP (quark_name
))
887 return Fgethash (HASHKEY_TERMINAL
, database
, Qnil
);
889 /* First, try tight bindings */
890 keys
[0] = XCAR (quark_name
);
891 keys
[1] = XCAR (quark_class
);
892 keys
[2] = SINGLE_COMPONENT
;
894 for (k
= 0; k
< sizeof (keys
) / sizeof (*keys
); k
++)
896 i
= hash_lookup (h
, keys
[k
], NULL
);
899 value
= xrm_q_get_resource (HASH_VALUE (h
, i
),
900 XCDR (quark_name
), XCDR (quark_class
));
906 /* Then, try loose bindings */
907 i
= hash_lookup (h
, LOOSE_BINDING
, NULL
);
910 value
= xrm_q_get_resource (HASH_VALUE (h
, i
), quark_name
, quark_class
);
914 return xrm_q_get_resource (database
,
915 XCDR (quark_name
), XCDR (quark_class
));
921 /* Retrieve a resource value for the specified NAME and CLASS from the
922 resource database DATABASE. It corresponds to XrmGetResource. */
925 xrm_get_resource (database
, name
, class)
926 XrmDatabase database
;
929 Lisp_Object quark_name
, quark_class
, tmp
;
932 quark_name
= parse_resource_name (&name
);
935 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
936 if (!STRINGP (XCAR (tmp
)))
939 quark_class
= parse_resource_name (&class);
942 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
943 if (!STRINGP (XCAR (tmp
)))
949 return xrm_q_get_resource (database
, quark_name
, quark_class
);
952 #if TARGET_API_MAC_CARBON
954 xrm_cfproperty_list_to_value (plist
)
955 CFPropertyListRef plist
;
957 CFTypeID type_id
= CFGetTypeID (plist
);
959 if (type_id
== CFStringGetTypeID ())
960 return cfstring_to_lisp (plist
);
961 else if (type_id
== CFNumberGetTypeID ())
964 Lisp_Object result
= Qnil
;
966 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
969 result
= cfstring_to_lisp (string
);
974 else if (type_id
== CFBooleanGetTypeID ())
976 static value_true
= NULL
, value_false
= NULL
;
978 if (value_true
== NULL
)
980 value_true
= build_string ("true");
981 value_false
= build_string ("false");
983 return CFBooleanGetValue (plist
) ? value_true
: value_false
;
985 else if (type_id
== CFDataGetTypeID ())
986 return cfdata_to_lisp (plist
);
992 /* Create a new resource database from the preferences for the
993 application APPLICATION. APPLICATION is either a string that
994 specifies an application ID, or NULL that represents the current
998 xrm_get_preference_database (application
)
1001 #if TARGET_API_MAC_CARBON
1002 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1003 CFMutableSetRef key_set
= NULL
;
1004 CFArrayRef key_array
;
1005 CFIndex index
, count
;
1007 XrmDatabase database
;
1008 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1009 CFPropertyListRef plist
;
1011 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1013 user_doms
[0] = kCFPreferencesCurrentUser
;
1014 user_doms
[1] = kCFPreferencesAnyUser
;
1015 host_doms
[0] = kCFPreferencesCurrentHost
;
1016 host_doms
[1] = kCFPreferencesAnyHost
;
1018 database
= xrm_create_database ();
1020 GCPRO3 (database
, quarks
, value
);
1024 app_id
= kCFPreferencesCurrentApplication
;
1027 app_id
= cfstring_create_with_utf8_cstring (application
);
1032 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1033 if (key_set
== NULL
)
1035 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1036 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1038 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1042 count
= CFArrayGetCount (key_array
);
1043 for (index
= 0; index
< count
; index
++)
1044 CFSetAddValue (key_set
,
1045 CFArrayGetValueAtIndex (key_array
, index
));
1046 CFRelease (key_array
);
1050 count
= CFSetGetCount (key_set
);
1051 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1054 CFSetGetValues (key_set
, (const void **)keys
);
1055 for (index
= 0; index
< count
; index
++)
1057 res_name
= SDATA (cfstring_to_lisp (keys
[index
]));
1058 quarks
= parse_resource_name (&res_name
);
1059 if (!(NILP (quarks
) || *res_name
))
1061 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1062 value
= xrm_cfproperty_list_to_value (plist
);
1065 xrm_q_put_resource (database
, quarks
, value
);
1072 CFRelease (key_set
);
1081 return xrm_create_database ();
1088 /* The following functions with "sys_" prefix are stubs to Unix
1089 functions that have already been implemented by CW or MPW. The
1090 calls to them in Emacs source course are #define'd to call the sys_
1091 versions by the header files s-mac.h. In these stubs pathnames are
1092 converted between their Unix and Mac forms. */
1095 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1096 + 17 leap days. These are for adjusting time values returned by
1097 MacOS Toolbox functions. */
1099 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1102 #if __MSL__ < 0x6000
1103 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1104 a leap year! This is for adjusting time_t values returned by MSL
1106 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1107 #else /* __MSL__ >= 0x6000 */
1108 /* CW changes Pro 6 to follow Unix! */
1109 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1110 #endif /* __MSL__ >= 0x6000 */
1112 /* MPW library functions follow Unix (confused?). */
1113 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1114 #else /* not __MRC__ */
1116 #endif /* not __MRC__ */
1119 /* Define our own stat function for both MrC and CW. The reason for
1120 doing this: "stat" is both the name of a struct and function name:
1121 can't use the same trick like that for sys_open, sys_close, etc. to
1122 redirect Emacs's calls to our own version that converts Unix style
1123 filenames to Mac style filename because all sorts of compilation
1124 errors will be generated if stat is #define'd to be sys_stat. */
1127 stat_noalias (const char *path
, struct stat
*buf
)
1129 char mac_pathname
[MAXPATHLEN
+1];
1132 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1135 c2pstr (mac_pathname
);
1136 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1137 cipb
.hFileInfo
.ioVRefNum
= 0;
1138 cipb
.hFileInfo
.ioDirID
= 0;
1139 cipb
.hFileInfo
.ioFDirIndex
= 0;
1140 /* set to 0 to get information about specific dir or file */
1142 errno
= PBGetCatInfo (&cipb
, false);
1143 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1148 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1150 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1152 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1153 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1154 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1155 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1156 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1157 /* size of dir = number of files and dirs */
1160 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1161 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1165 buf
->st_mode
= S_IFREG
| S_IREAD
;
1166 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1167 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1168 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1169 buf
->st_mode
|= S_IEXEC
;
1170 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1171 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1172 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1175 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1176 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1179 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1181 /* identify alias files as symlinks */
1182 buf
->st_mode
&= ~S_IFREG
;
1183 buf
->st_mode
|= S_IFLNK
;
1187 buf
->st_uid
= getuid ();
1188 buf
->st_gid
= getgid ();
1196 lstat (const char *path
, struct stat
*buf
)
1199 char true_pathname
[MAXPATHLEN
+1];
1201 /* Try looking for the file without resolving aliases first. */
1202 if ((result
= stat_noalias (path
, buf
)) >= 0)
1205 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1208 return stat_noalias (true_pathname
, buf
);
1213 stat (const char *path
, struct stat
*sb
)
1216 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1219 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1220 ! (sb
->st_mode
& S_IFLNK
))
1223 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1226 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1229 fully_resolved_name
[len
] = '\0';
1230 /* in fact our readlink terminates strings */
1231 return lstat (fully_resolved_name
, sb
);
1234 return lstat (true_pathname
, sb
);
1239 /* CW defines fstat in stat.mac.c while MPW does not provide this
1240 function. Without the information of how to get from a file
1241 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1242 to implement this function. Fortunately, there is only one place
1243 where this function is called in our configuration: in fileio.c,
1244 where only the st_dev and st_ino fields are used to determine
1245 whether two fildes point to different i-nodes to prevent copying
1246 a file onto itself equal. What we have here probably needs
1250 fstat (int fildes
, struct stat
*buf
)
1253 buf
->st_ino
= fildes
;
1254 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1255 return 0; /* success */
1257 #endif /* __MRC__ */
1261 mkdir (const char *dirname
, int mode
)
1263 #pragma unused(mode)
1266 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1268 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1271 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1274 c2pstr (mac_pathname
);
1275 hfpb
.ioNamePtr
= mac_pathname
;
1276 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1277 hfpb
.ioDirID
= 0; /* parent is the root */
1279 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1280 /* just return the Mac OSErr code for now */
1281 return errno
== noErr
? 0 : -1;
1286 sys_rmdir (const char *dirname
)
1289 char mac_pathname
[MAXPATHLEN
+1];
1291 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1294 c2pstr (mac_pathname
);
1295 hfpb
.ioNamePtr
= mac_pathname
;
1296 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1297 hfpb
.ioDirID
= 0; /* parent is the root */
1299 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1300 return errno
== noErr
? 0 : -1;
1305 /* No implementation yet. */
1307 execvp (const char *path
, ...)
1311 #endif /* __MRC__ */
1315 utime (const char *path
, const struct utimbuf
*times
)
1317 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1319 char mac_pathname
[MAXPATHLEN
+1];
1322 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1325 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1327 fully_resolved_name
[len
] = '\0';
1329 strcpy (fully_resolved_name
, true_pathname
);
1331 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1334 c2pstr (mac_pathname
);
1335 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1336 cipb
.hFileInfo
.ioVRefNum
= 0;
1337 cipb
.hFileInfo
.ioDirID
= 0;
1338 cipb
.hFileInfo
.ioFDirIndex
= 0;
1339 /* set to 0 to get information about specific dir or file */
1341 errno
= PBGetCatInfo (&cipb
, false);
1345 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1348 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1350 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1355 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1357 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1360 errno
= PBSetCatInfo (&cipb
, false);
1361 return errno
== noErr
? 0 : -1;
1375 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1377 access (const char *path
, int mode
)
1379 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1381 char mac_pathname
[MAXPATHLEN
+1];
1384 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1387 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1389 fully_resolved_name
[len
] = '\0';
1391 strcpy (fully_resolved_name
, true_pathname
);
1393 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1396 c2pstr (mac_pathname
);
1397 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1398 cipb
.hFileInfo
.ioVRefNum
= 0;
1399 cipb
.hFileInfo
.ioDirID
= 0;
1400 cipb
.hFileInfo
.ioFDirIndex
= 0;
1401 /* set to 0 to get information about specific dir or file */
1403 errno
= PBGetCatInfo (&cipb
, false);
1407 if (mode
== F_OK
) /* got this far, file exists */
1411 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1415 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1422 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1423 /* don't allow if lock bit is on */
1429 #define DEV_NULL_FD 0x10000
1433 sys_open (const char *path
, int oflag
)
1435 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1437 char mac_pathname
[MAXPATHLEN
+1];
1439 if (strcmp (path
, "/dev/null") == 0)
1440 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1442 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1445 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1447 fully_resolved_name
[len
] = '\0';
1449 strcpy (fully_resolved_name
, true_pathname
);
1451 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1456 int res
= open (mac_pathname
, oflag
);
1457 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1458 if (oflag
& O_CREAT
)
1459 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1461 #else /* not __MRC__ */
1462 return open (mac_pathname
, oflag
);
1463 #endif /* not __MRC__ */
1470 sys_creat (const char *path
, mode_t mode
)
1472 char true_pathname
[MAXPATHLEN
+1];
1474 char mac_pathname
[MAXPATHLEN
+1];
1476 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1479 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1484 int result
= creat (mac_pathname
);
1485 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1487 #else /* not __MRC__ */
1488 return creat (mac_pathname
, mode
);
1489 #endif /* not __MRC__ */
1496 sys_unlink (const char *path
)
1498 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1500 char mac_pathname
[MAXPATHLEN
+1];
1502 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1505 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1507 fully_resolved_name
[len
] = '\0';
1509 strcpy (fully_resolved_name
, true_pathname
);
1511 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1514 return unlink (mac_pathname
);
1520 sys_read (int fildes
, char *buf
, int count
)
1522 if (fildes
== 0) /* this should not be used for console input */
1525 #if __MSL__ >= 0x6000
1526 return _read (fildes
, buf
, count
);
1528 return read (fildes
, buf
, count
);
1535 sys_write (int fildes
, const char *buf
, int count
)
1537 if (fildes
== DEV_NULL_FD
)
1540 #if __MSL__ >= 0x6000
1541 return _write (fildes
, buf
, count
);
1543 return write (fildes
, buf
, count
);
1550 sys_rename (const char * old_name
, const char * new_name
)
1552 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1553 char fully_resolved_old_name
[MAXPATHLEN
+1];
1555 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1557 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1560 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1562 fully_resolved_old_name
[len
] = '\0';
1564 strcpy (fully_resolved_old_name
, true_old_pathname
);
1566 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1569 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1572 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1577 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1580 /* If a file with new_name already exists, rename deletes the old
1581 file in Unix. CW version fails in these situation. So we add a
1582 call to unlink here. */
1583 (void) unlink (mac_new_name
);
1585 return rename (mac_old_name
, mac_new_name
);
1590 extern FILE *fopen (const char *name
, const char *mode
);
1592 sys_fopen (const char *name
, const char *mode
)
1594 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1596 char mac_pathname
[MAXPATHLEN
+1];
1598 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1601 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1603 fully_resolved_name
[len
] = '\0';
1605 strcpy (fully_resolved_name
, true_pathname
);
1607 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1612 if (mode
[0] == 'w' || mode
[0] == 'a')
1613 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1614 #endif /* not __MRC__ */
1615 return fopen (mac_pathname
, mode
);
1620 long target_ticks
= 0;
1623 __sigfun alarm_signal_func
= (__sigfun
) 0;
1625 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
1626 #else /* not __MRC__ and not __MWERKS__ */
1628 #endif /* not __MRC__ and not __MWERKS__ */
1631 /* These functions simulate SIG_ALRM. The stub for function signal
1632 stores the signal handler function in alarm_signal_func if a
1633 SIG_ALRM is encountered. check_alarm is called in XTread_socket,
1634 which emacs calls periodically. A pending alarm is represented by
1635 a non-zero target_ticks value. check_alarm calls the handler
1636 function pointed to by alarm_signal_func if one has been set up and
1637 an alarm is pending. */
1642 if (target_ticks
&& TickCount () > target_ticks
)
1645 if (alarm_signal_func
)
1646 (*alarm_signal_func
)(SIGALRM
);
1651 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1654 select (n
, rfds
, wfds
, efds
, timeout
)
1659 struct timeval
*timeout
;
1661 #if TARGET_API_MAC_CARBON
1663 EventTimeout timeout_sec
=
1665 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1666 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1667 : kEventDurationForever
);
1669 if (FD_ISSET (0, rfds
))
1672 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1680 #else /* not TARGET_API_MAC_CARBON */
1682 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1683 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1685 /* Can only handle wait for keyboard input. */
1686 if (n
> 1 || wfds
|| efds
)
1689 /* Also return true if an event other than a keyDown has occurred.
1690 This causes kbd_buffer_get_event in keyboard.c to call
1691 read_avail_input which in turn calls XTread_socket to poll for
1692 these events. Otherwise these never get processed except but a
1693 very slow poll timer. */
1694 if (FD_ISSET (0, rfds
) && mac_wait_next_event (&e
, sleep_time
, false))
1698 #endif /* not TARGET_API_MAC_CARBON */
1702 /* Called in sys_select to wait for an alarm signal to arrive. */
1710 if (!target_ticks
) /* no alarm pending */
1713 if ((tick
= TickCount ()) < target_ticks
)
1714 WaitNextEvent (0, &e
, target_ticks
- tick
, NULL
); /* Accept no event;
1715 just wait. by T.I. */
1718 if (alarm_signal_func
)
1719 (*alarm_signal_func
)(SIGALRM
);
1728 long remaining
= target_ticks
? (TickCount () - target_ticks
) / 60 : 0;
1730 target_ticks
= seconds
? TickCount () + 60 * seconds
: 0;
1732 return (remaining
< 0) ? 0 : (unsigned int) remaining
;
1738 extern __sigfun
signal (int signal
, __sigfun signal_func
);
1740 sys_signal (int signal_num
, __sigfun signal_func
)
1742 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
1744 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
1745 #else /* not __MRC__ and not __MWERKS__ */
1747 #endif /* not __MRC__ and not __MWERKS__ */
1749 if (signal_num
!= SIGALRM
)
1750 return signal (signal_num
, signal_func
);
1754 __sigfun old_signal_func
;
1756 __signal_func_ptr old_signal_func
;
1760 old_signal_func
= alarm_signal_func
;
1761 alarm_signal_func
= signal_func
;
1762 return old_signal_func
;
1767 /* gettimeofday should return the amount of time (in a timeval
1768 structure) since midnight today. The toolbox function Microseconds
1769 returns the number of microseconds (in a UnsignedWide value) since
1770 the machine was booted. Also making this complicated is WideAdd,
1771 WideSubtract, etc. take wide values. */
1778 static wide wall_clock_at_epoch
, clicks_at_epoch
;
1779 UnsignedWide uw_microseconds
;
1780 wide w_microseconds
;
1781 time_t sys_time (time_t *);
1783 /* If this function is called for the first time, record the number
1784 of seconds since midnight and the number of microseconds since
1785 boot at the time of this first call. */
1790 systime
= sys_time (NULL
);
1791 /* Store microseconds since midnight in wall_clock_at_epoch. */
1792 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
1793 Microseconds (&uw_microseconds
);
1794 /* Store microseconds since boot in clicks_at_epoch. */
1795 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
1796 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
1799 /* Get time since boot */
1800 Microseconds (&uw_microseconds
);
1802 /* Convert to time since midnight*/
1803 w_microseconds
.hi
= uw_microseconds
.hi
;
1804 w_microseconds
.lo
= uw_microseconds
.lo
;
1805 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
1806 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
1807 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
1815 sleep (unsigned int seconds
)
1817 unsigned long time_up
;
1820 time_up
= TickCount () + seconds
* 60;
1821 while (TickCount () < time_up
)
1823 /* Accept no event; just wait. by T.I. */
1824 WaitNextEvent (0, &e
, 30, NULL
);
1829 #endif /* __MRC__ */
1832 /* The time functions adjust time values according to the difference
1833 between the Unix and CW epoches. */
1836 extern struct tm
*gmtime (const time_t *);
1838 sys_gmtime (const time_t *timer
)
1840 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1842 return gmtime (&unix_time
);
1847 extern struct tm
*localtime (const time_t *);
1849 sys_localtime (const time_t *timer
)
1851 #if __MSL__ >= 0x6000
1852 time_t unix_time
= *timer
;
1854 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1857 return localtime (&unix_time
);
1862 extern char *ctime (const time_t *);
1864 sys_ctime (const time_t *timer
)
1866 #if __MSL__ >= 0x6000
1867 time_t unix_time
= *timer
;
1869 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1872 return ctime (&unix_time
);
1877 extern time_t time (time_t *);
1879 sys_time (time_t *timer
)
1881 #if __MSL__ >= 0x6000
1882 time_t mac_time
= time (NULL
);
1884 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
1894 /* MPW strftime broken for "%p" format */
1899 sys_strftime (char * s
, size_t maxsize
, const char * format
,
1900 const struct tm
* timeptr
)
1902 if (strcmp (format
, "%p") == 0)
1906 if (timeptr
->tm_hour
< 12)
1918 return strftime (s
, maxsize
, format
, timeptr
);
1920 #endif /* __MRC__ */
1923 /* no subprocesses, empty wait */
1933 croak (char *badfunc
)
1935 printf ("%s not yet implemented\r\n", badfunc
);
1941 index (const char * str
, int chr
)
1943 return strchr (str
, chr
);
1948 mktemp (char *template)
1953 len
= strlen (template);
1955 while (k
>= 0 && template[k
] == 'X')
1958 k
++; /* make k index of first 'X' */
1962 /* Zero filled, number of digits equal to the number of X's. */
1963 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
1972 /* Emulate getpwuid, getpwnam and others. */
1974 #define PASSWD_FIELD_SIZE 256
1976 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
1977 static char my_passwd_dir
[MAXPATHLEN
+1];
1979 static struct passwd my_passwd
=
1985 static struct group my_group
=
1987 /* There are no groups on the mac, so we just return "root" as the
1993 /* Initialized by main () in macterm.c to pathname of emacs directory. */
1995 char emacs_passwd_dir
[MAXPATHLEN
+1];
2001 init_emacs_passwd_dir ()
2005 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2007 /* Need pathname of first ancestor that begins with "emacs"
2008 since Mac emacs application is somewhere in the emacs-*
2010 int len
= strlen (emacs_passwd_dir
);
2012 /* j points to the "/" following the directory name being
2015 while (i
>= 0 && !found
)
2017 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2019 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2020 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2022 emacs_passwd_dir
[j
+1] = '\0';
2033 /* Setting to "/" probably won't work but set it to something
2035 strcpy (emacs_passwd_dir
, "/");
2036 strcpy (my_passwd_dir
, "/");
2041 static struct passwd emacs_passwd
=
2047 static int my_passwd_inited
= 0;
2055 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2056 directory where Emacs was started. */
2058 owner_name
= (char **) GetResource ('STR ',-16096);
2062 BlockMove ((unsigned char *) *owner_name
,
2063 (unsigned char *) my_passwd_name
,
2065 HUnlock (owner_name
);
2066 p2cstr ((unsigned char *) my_passwd_name
);
2069 my_passwd_name
[0] = 0;
2074 getpwuid (uid_t uid
)
2076 if (!my_passwd_inited
)
2079 my_passwd_inited
= 1;
2087 getgrgid (gid_t gid
)
2094 getpwnam (const char *name
)
2096 if (strcmp (name
, "emacs") == 0)
2097 return &emacs_passwd
;
2099 if (!my_passwd_inited
)
2102 my_passwd_inited
= 1;
2109 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2110 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2131 error ("Can't spawn subshell");
2150 request_sigio (void)
2156 unrequest_sigio (void)
2171 pipe (int _fildes
[2])
2178 /* Hard and symbolic links. */
2181 symlink (const char *name1
, const char *name2
)
2189 link (const char *name1
, const char *name2
)
2195 #endif /* ! MAC_OSX */
2197 /* Determine the path name of the file specified by VREFNUM, DIRID,
2198 and NAME and place that in the buffer PATH of length
2201 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2202 long dir_id
, ConstStr255Param name
)
2208 if (strlen (name
) > man_path_len
)
2211 memcpy (dir_name
, name
, name
[0]+1);
2212 memcpy (path
, name
, name
[0]+1);
2215 cipb
.dirInfo
.ioDrParID
= dir_id
;
2216 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2220 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2221 cipb
.dirInfo
.ioFDirIndex
= -1;
2222 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2223 /* go up to parent each time */
2225 err
= PBGetCatInfo (&cipb
, false);
2230 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2233 strcat (dir_name
, ":");
2234 strcat (dir_name
, path
);
2235 /* attach to front since we're going up directory tree */
2236 strcpy (path
, dir_name
);
2238 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2239 /* stop when we see the volume's root directory */
2241 return 1; /* success */
2246 posix_pathname_to_fsspec (ufn
, fs
)
2250 Str255 mac_pathname
;
2252 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2256 c2pstr (mac_pathname
);
2257 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2262 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2267 char mac_pathname
[MAXPATHLEN
];
2269 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2270 fs
->vRefNum
, fs
->parID
, fs
->name
)
2271 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2280 readlink (const char *path
, char *buf
, int bufsiz
)
2282 char mac_sym_link_name
[MAXPATHLEN
+1];
2285 Boolean target_is_folder
, was_aliased
;
2286 Str255 directory_name
, mac_pathname
;
2289 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2292 c2pstr (mac_sym_link_name
);
2293 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2300 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2301 if (err
!= noErr
|| !was_aliased
)
2307 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2314 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2320 return strlen (buf
);
2324 /* Convert a path to one with aliases fully expanded. */
2327 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2329 char *q
, temp
[MAXPATHLEN
+1];
2333 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2340 q
= strchr (p
+ 1, '/');
2342 q
= strchr (p
, '/');
2343 len
= 0; /* loop may not be entered, e.g., for "/" */
2348 strncat (temp
, p
, q
- p
);
2349 len
= readlink (temp
, buf
, bufsiz
);
2352 if (strlen (temp
) + 1 > bufsiz
)
2362 if (len
+ strlen (p
) + 1 >= bufsiz
)
2366 return len
+ strlen (p
);
2371 umask (mode_t numask
)
2373 static mode_t mask
= 022;
2374 mode_t oldmask
= mask
;
2381 chmod (const char *path
, mode_t mode
)
2383 /* say it always succeed for now */
2392 return fcntl (oldd
, F_DUPFD
, 0);
2394 /* current implementation of fcntl in fcntl.mac.c simply returns old
2396 return fcntl (oldd
, F_DUPFD
);
2403 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2404 newd if it already exists. Then, attempt to dup oldd. If not
2405 successful, call dup2 recursively until we are, then close the
2406 unsuccessful ones. */
2409 dup2 (int oldd
, int newd
)
2420 ret
= dup2 (oldd
, newd
);
2426 /* let it fail for now */
2443 ioctl (int d
, int request
, void *argp
)
2453 if (fildes
>=0 && fildes
<= 2)
2486 #endif /* __MRC__ */
2490 #if __MSL__ < 0x6000
2498 #endif /* __MWERKS__ */
2500 #endif /* ! MAC_OSX */
2503 /* Return the path to the directory in which Emacs can create
2504 temporary files. The MacOS "temporary items" directory cannot be
2505 used because it removes the file written by a process when it
2506 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2507 again not exactly). And of course Emacs needs to read back the
2508 files written by its subprocesses. So here we write the files to a
2509 directory "Emacs" in the Preferences Folder. This directory is
2510 created if it does not exist. */
2513 get_temp_dir_name ()
2515 static char *temp_dir_name
= NULL
;
2519 Str255 dir_name
, full_path
;
2521 char unix_dir_name
[MAXPATHLEN
+1];
2524 /* Cache directory name with pointer temp_dir_name.
2525 Look for it only the first time. */
2528 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2529 &vol_ref_num
, &dir_id
);
2533 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2536 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2537 strcat (full_path
, "Emacs:");
2541 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2544 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2547 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2550 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2551 strcpy (temp_dir_name
, unix_dir_name
);
2554 return temp_dir_name
;
2559 /* Allocate and construct an array of pointers to strings from a list
2560 of strings stored in a 'STR#' resource. The returned pointer array
2561 is stored in the style of argv and environ: if the 'STR#' resource
2562 contains numString strings, a pointer array with numString+1
2563 elements is returned in which the last entry contains a null
2564 pointer. The pointer to the pointer array is passed by pointer in
2565 parameter t. The resource ID of the 'STR#' resource is passed in
2566 parameter StringListID.
2570 get_string_list (char ***t
, short string_list_id
)
2576 h
= GetResource ('STR#', string_list_id
);
2581 num_strings
= * (short *) p
;
2583 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2584 for (i
= 0; i
< num_strings
; i
++)
2586 short length
= *p
++;
2587 (*t
)[i
] = (char *) malloc (length
+ 1);
2588 strncpy ((*t
)[i
], p
, length
);
2589 (*t
)[i
][length
] = '\0';
2592 (*t
)[num_strings
] = 0;
2597 /* Return no string in case GetResource fails. Bug fixed by
2598 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2599 option (no sym -on implies -opt local). */
2600 *t
= (char **) malloc (sizeof (char *));
2607 get_path_to_system_folder ()
2612 Str255 dir_name
, full_path
;
2614 static char system_folder_unix_name
[MAXPATHLEN
+1];
2617 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2618 &vol_ref_num
, &dir_id
);
2622 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2625 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2629 return system_folder_unix_name
;
2635 #define ENVIRON_STRING_LIST_ID 128
2637 /* Get environment variable definitions from STR# resource. */
2644 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2650 /* Make HOME directory the one Emacs starts up in if not specified
2652 if (getenv ("HOME") == NULL
)
2654 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2657 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2660 strcpy (environ
[i
], "HOME=");
2661 strcat (environ
[i
], my_passwd_dir
);
2668 /* Make HOME directory the one Emacs starts up in if not specified
2670 if (getenv ("MAIL") == NULL
)
2672 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2675 char * path_to_system_folder
= get_path_to_system_folder ();
2676 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2679 strcpy (environ
[i
], "MAIL=");
2680 strcat (environ
[i
], path_to_system_folder
);
2681 strcat (environ
[i
], "Eudora Folder/In");
2689 /* Return the value of the environment variable NAME. */
2692 getenv (const char *name
)
2694 int length
= strlen(name
);
2697 for (e
= environ
; *e
!= 0; e
++)
2698 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2699 return &(*e
)[length
+ 1];
2701 if (strcmp (name
, "TMPDIR") == 0)
2702 return get_temp_dir_name ();
2709 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2710 char *sys_siglist
[] =
2712 "Zero is not a signal!!!",
2714 "Interactive user interrupt", /* 2 */ "?",
2715 "Floating point exception", /* 4 */ "?", "?", "?",
2716 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2717 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2718 "?", "?", "?", "?", "?", "?", "?", "?",
2722 char *sys_siglist
[] =
2724 "Zero is not a signal!!!",
2726 "Floating point exception",
2727 "Illegal instruction",
2728 "Interactive user interrupt",
2729 "Segment violation",
2732 #else /* not __MRC__ and not __MWERKS__ */
2734 #endif /* not __MRC__ and not __MWERKS__ */
2737 #include <utsname.h>
2740 uname (struct utsname
*name
)
2743 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2746 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2747 p2cstr (name
->nodename
);
2755 /* Event class of HLE sent to subprocess. */
2756 const OSType kEmacsSubprocessSend
= 'ESND';
2758 /* Event class of HLE sent back from subprocess. */
2759 const OSType kEmacsSubprocessReply
= 'ERPY';
2763 mystrchr (char *s
, char c
)
2765 while (*s
&& *s
!= c
)
2793 mystrcpy (char *to
, char *from
)
2805 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2806 terminated). The process should run with the default directory
2807 "workdir", read input from "infn", and write output and error to
2808 "outfn" and "errfn", resp. The Process Manager call
2809 LaunchApplication is used to start the subprocess. We use high
2810 level events as the mechanism to pass arguments to the subprocess
2811 and to make Emacs wait for the subprocess to terminate and pass
2812 back a result code. The bulk of the code here packs the arguments
2813 into one message to be passed together with the high level event.
2814 Emacs also sometimes starts a subprocess using a shell to perform
2815 wildcard filename expansion. Since we don't really have a shell on
2816 the Mac, this case is detected and the starting of the shell is
2817 by-passed. We really need to add code here to do filename
2818 expansion to support such functionality. */
2821 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2822 unsigned char **argv
;
2823 const char *workdir
;
2824 const char *infn
, *outfn
, *errfn
;
2826 #if TARGET_API_MAC_CARBON
2828 #else /* not TARGET_API_MAC_CARBON */
2829 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2830 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2831 int paramlen
, argc
, newargc
, j
, retries
;
2832 char **newargv
, *param
, *p
;
2835 LaunchParamBlockRec lpbr
;
2836 EventRecord send_event
, reply_event
;
2837 RgnHandle cursor_region_handle
;
2839 unsigned long ref_con
, len
;
2841 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2843 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2845 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2847 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2850 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2851 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2860 /* If a subprocess is invoked with a shell, we receive 3 arguments
2861 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2862 bins>/<command> <command args>" */
2863 j
= strlen (argv
[0]);
2864 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2865 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2867 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2869 /* The arguments for the command in argv[2] are separated by
2870 spaces. Count them and put the count in newargc. */
2871 command
= (char *) alloca (strlen (argv
[2])+2);
2872 strcpy (command
, argv
[2]);
2873 if (command
[strlen (command
) - 1] != ' ')
2874 strcat (command
, " ");
2878 t
= mystrchr (t
, ' ');
2882 t
= mystrchr (t
+1, ' ');
2885 newargv
= (char **) alloca (sizeof (char *) * newargc
);
2888 for (j
= 0; j
< newargc
; j
++)
2890 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
2891 mystrcpy (newargv
[j
], t
);
2894 paramlen
+= strlen (newargv
[j
]) + 1;
2897 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
2899 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
2904 { /* sometimes Emacs call "sh" without a path for the command */
2906 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
2907 strcpy (t
, "~emacs/");
2908 strcat (t
, newargv
[0]);
2911 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
2912 make_number (X_OK
));
2916 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
2920 strcpy (macappname
, tempmacpathname
);
2924 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
2927 newargv
= (char **) alloca (sizeof (char *) * argc
);
2929 for (j
= 1; j
< argc
; j
++)
2931 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
2933 char *t
= strchr (argv
[j
], ' ');
2936 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
2937 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
2938 tempcmdname
[t
-argv
[j
]] = '\0';
2939 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
2942 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
2944 strcpy (newargv
[j
], tempmaccmdname
);
2945 strcat (newargv
[j
], t
);
2949 char tempmaccmdname
[MAXPATHLEN
+1];
2950 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
2953 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
2954 strcpy (newargv
[j
], tempmaccmdname
);
2958 newargv
[j
] = argv
[j
];
2959 paramlen
+= strlen (newargv
[j
]) + 1;
2963 /* After expanding all the arguments, we now know the length of the
2964 parameter block to be sent to the subprocess as a message
2965 attached to the HLE. */
2966 param
= (char *) malloc (paramlen
+ 1);
2972 /* first byte of message contains number of arguments for command */
2973 strcpy (p
, macworkdir
);
2974 p
+= strlen (macworkdir
);
2976 /* null terminate strings sent so it's possible to use strcpy over there */
2977 strcpy (p
, macinfn
);
2978 p
+= strlen (macinfn
);
2980 strcpy (p
, macoutfn
);
2981 p
+= strlen (macoutfn
);
2983 strcpy (p
, macerrfn
);
2984 p
+= strlen (macerrfn
);
2986 for (j
= 1; j
< newargc
; j
++)
2988 strcpy (p
, newargv
[j
]);
2989 p
+= strlen (newargv
[j
]);
2993 c2pstr (macappname
);
2995 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3003 lpbr
.launchBlockID
= extendedBlock
;
3004 lpbr
.launchEPBLength
= extendedBlockLen
;
3005 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3006 lpbr
.launchAppSpec
= &spec
;
3007 lpbr
.launchAppParameters
= NULL
;
3009 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3016 send_event
.what
= kHighLevelEvent
;
3017 send_event
.message
= kEmacsSubprocessSend
;
3018 /* Event ID stored in "where" unused */
3021 /* OS may think current subprocess has terminated if previous one
3022 terminated recently. */
3025 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3026 paramlen
+ 1, receiverIDisPSN
);
3028 while (iErr
== sessClosedErr
&& retries
-- > 0);
3036 cursor_region_handle
= NewRgn ();
3038 /* Wait for the subprocess to finish, when it will send us a ERPY
3039 high level event. */
3041 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3042 cursor_region_handle
)
3043 && reply_event
.message
== kEmacsSubprocessReply
)
3046 /* The return code is sent through the refCon */
3047 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3050 DisposeHandle ((Handle
) cursor_region_handle
);
3055 DisposeHandle ((Handle
) cursor_region_handle
);
3059 #endif /* not TARGET_API_MAC_CARBON */
3064 opendir (const char *dirname
)
3066 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3067 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3071 int len
, vol_name_len
;
3073 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3076 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3078 fully_resolved_name
[len
] = '\0';
3080 strcpy (fully_resolved_name
, true_pathname
);
3082 dirp
= (DIR *) malloc (sizeof(DIR));
3086 /* Handle special case when dirname is "/": sets up for readir to
3087 get all mount volumes. */
3088 if (strcmp (fully_resolved_name
, "/") == 0)
3090 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3091 dirp
->current_index
= 1; /* index for first volume */
3095 /* Handle typical cases: not accessing all mounted volumes. */
3096 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3099 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3100 len
= strlen (mac_pathname
);
3101 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3102 strcat (mac_pathname
, ":");
3104 /* Extract volume name */
3105 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3106 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3107 vol_name
[vol_name_len
] = '\0';
3108 strcat (vol_name
, ":");
3110 c2pstr (mac_pathname
);
3111 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3112 /* using full pathname so vRefNum and DirID ignored */
3113 cipb
.hFileInfo
.ioVRefNum
= 0;
3114 cipb
.hFileInfo
.ioDirID
= 0;
3115 cipb
.hFileInfo
.ioFDirIndex
= 0;
3116 /* set to 0 to get information about specific dir or file */
3118 errno
= PBGetCatInfo (&cipb
, false);
3125 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3126 return 0; /* not a directory */
3128 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3129 dirp
->getting_volumes
= 0;
3130 dirp
->current_index
= 1; /* index for first file/directory */
3133 vpb
.ioNamePtr
= vol_name
;
3134 /* using full pathname so vRefNum and DirID ignored */
3136 vpb
.ioVolIndex
= -1;
3137 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3144 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3161 HParamBlockRec hpblock
;
3163 static struct dirent s_dirent
;
3164 static Str255 s_name
;
3168 /* Handle the root directory containing the mounted volumes. Call
3169 PBHGetVInfo specifying an index to obtain the info for a volume.
3170 PBHGetVInfo returns an error when it receives an index beyond the
3171 last volume, at which time we should return a nil dirent struct
3173 if (dp
->getting_volumes
)
3175 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3176 hpblock
.volumeParam
.ioVRefNum
= 0;
3177 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3179 errno
= PBHGetVInfo (&hpblock
, false);
3187 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3189 dp
->current_index
++;
3191 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3192 s_dirent
.d_name
= s_name
;
3198 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3199 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3200 /* location to receive filename returned */
3202 /* return only visible files */
3206 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3207 /* directory ID found by opendir */
3208 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3210 errno
= PBGetCatInfo (&cipb
, false);
3217 /* insist on a visible entry */
3218 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3219 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3221 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3223 dp
->current_index
++;
3236 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3237 /* value unimportant: non-zero for valid file */
3238 s_dirent
.d_name
= s_name
;
3248 char mac_pathname
[MAXPATHLEN
+1];
3249 Str255 directory_name
;
3253 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3256 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3262 #endif /* ! MAC_OSX */
3266 initialize_applescript ()
3271 /* if open fails, as_scripting_component is set to NULL. Its
3272 subsequent use in OSA calls will fail with badComponentInstance
3274 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3275 kAppleScriptSubtype
);
3277 null_desc
.descriptorType
= typeNull
;
3278 null_desc
.dataHandle
= 0;
3279 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3280 kOSANullScript
, &as_script_context
);
3282 as_script_context
= kOSANullScript
;
3283 /* use default context if create fails */
3287 void terminate_applescript()
3289 OSADispose (as_scripting_component
, as_script_context
);
3290 CloseComponent (as_scripting_component
);
3294 /* Compile and execute the AppleScript SCRIPT and return the error
3295 status as function value. A zero is returned if compilation and
3296 execution is successful, in which case RESULT returns a pointer to
3297 a string containing the resulting script value. Otherwise, the Mac
3298 error code is returned and RESULT returns a pointer to an error
3299 string. In both cases the caller should deallocate the storage
3300 used by the string pointed to by RESULT if it is non-NULL. For
3301 documentation on the MacOS scripting architecture, see Inside
3302 Macintosh - Interapplication Communications: Scripting Components. */
3305 do_applescript (char *script
, char **result
)
3307 AEDesc script_desc
, result_desc
, error_desc
;
3314 if (!as_scripting_component
)
3315 initialize_applescript();
3317 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3321 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3322 typeChar
, kOSAModeNull
, &result_desc
);
3324 if (osaerror
== errOSAScriptError
)
3326 /* error executing AppleScript: retrieve error message */
3327 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3330 #if TARGET_API_MAC_CARBON
3331 length
= AEGetDescDataSize (&error_desc
);
3332 *result
= (char *) xmalloc (length
+ 1);
3335 AEGetDescData (&error_desc
, *result
, length
);
3336 *(*result
+ length
) = '\0';
3338 #else /* not TARGET_API_MAC_CARBON */
3339 HLock (error_desc
.dataHandle
);
3340 length
= GetHandleSize(error_desc
.dataHandle
);
3341 *result
= (char *) xmalloc (length
+ 1);
3344 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3345 *(*result
+ length
) = '\0';
3347 HUnlock (error_desc
.dataHandle
);
3348 #endif /* not TARGET_API_MAC_CARBON */
3349 AEDisposeDesc (&error_desc
);
3352 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3354 #if TARGET_API_MAC_CARBON
3355 length
= AEGetDescDataSize (&result_desc
);
3356 *result
= (char *) xmalloc (length
+ 1);
3359 AEGetDescData (&result_desc
, *result
, length
);
3360 *(*result
+ length
) = '\0';
3362 #else /* not TARGET_API_MAC_CARBON */
3363 HLock (result_desc
.dataHandle
);
3364 length
= GetHandleSize(result_desc
.dataHandle
);
3365 *result
= (char *) xmalloc (length
+ 1);
3368 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3369 *(*result
+ length
) = '\0';
3371 HUnlock (result_desc
.dataHandle
);
3372 #endif /* not TARGET_API_MAC_CARBON */
3373 AEDisposeDesc (&result_desc
);
3376 AEDisposeDesc (&script_desc
);
3382 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3383 doc
: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
3384 If compilation and execution are successful, the resulting script
3385 value is returned as a string. Otherwise the function aborts and
3386 displays the error message returned by the AppleScript scripting
3391 char *result
, *temp
;
3392 Lisp_Object lisp_result
;
3395 CHECK_STRING (script
);
3398 status
= do_applescript (SDATA (script
), &result
);
3403 error ("AppleScript error %d", status
);
3406 /* Unfortunately only OSADoScript in do_applescript knows how
3407 how large the resulting script value or error message is
3408 going to be and therefore as caller memory must be
3409 deallocated here. It is necessary to free the error
3410 message before calling error to avoid a memory leak. */
3411 temp
= (char *) alloca (strlen (result
) + 1);
3412 strcpy (temp
, result
);
3419 lisp_result
= build_string (result
);
3426 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3427 Smac_file_name_to_posix
, 1, 1, 0,
3428 doc
: /* Convert Macintosh filename to Posix form. */)
3430 Lisp_Object mac_filename
;
3432 char posix_filename
[MAXPATHLEN
+1];
3434 CHECK_STRING (mac_filename
);
3436 if (mac_to_posix_pathname (SDATA (mac_filename
), posix_filename
,
3438 return build_string (posix_filename
);
3444 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3445 Sposix_file_name_to_mac
, 1, 1, 0,
3446 doc
: /* Convert Posix filename to Mac form. */)
3448 Lisp_Object posix_filename
;
3450 char mac_filename
[MAXPATHLEN
+1];
3452 CHECK_STRING (posix_filename
);
3454 if (posix_to_mac_pathname (SDATA (posix_filename
), mac_filename
,
3456 return build_string (mac_filename
);
3462 /* set interprogram-paste-function to mac-paste-function in mac-win.el
3463 to enable Emacs to obtain the contents of the Mac clipboard. */
3464 DEFUN ("mac-paste-function", Fmac_paste_function
, Smac_paste_function
, 0, 0, 0,
3465 doc
: /* Return the contents of the Mac clipboard as a string. */)
3468 #if TARGET_API_MAC_CARBON
3471 ScrapFlavorFlags sff
;
3477 err
= GetCurrentScrap (&scrap
);
3479 err
= GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
);
3481 err
= GetScrapFlavorSize (scrap
, kScrapFlavorTypeText
, &s
);
3482 if (err
== noErr
&& (data
= (char*) alloca (s
)))
3483 err
= GetScrapFlavorData (scrap
, kScrapFlavorTypeText
, &s
, data
);
3485 if (err
!= noErr
|| s
== 0)
3488 /* Emacs expects clipboard contents have Unix-style eol's */
3489 for (i
= 0; i
< s
; i
++)
3490 if (data
[i
] == '\r')
3493 return make_string (data
, s
);
3494 #else /* not TARGET_API_MAC_CARBON */
3497 long scrap_offset
, rc
, i
;
3499 my_handle
= NewHandle (0); /* allocate 0-length data area */
3501 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3507 /* Emacs expects clipboard contents have Unix-style eol's */
3508 for (i
= 0; i
< rc
; i
++)
3509 if ((*my_handle
)[i
] == '\r')
3510 (*my_handle
)[i
] = '\n';
3512 value
= make_string (*my_handle
, rc
);
3514 HUnlock (my_handle
);
3516 DisposeHandle (my_handle
);
3519 #endif /* not TARGET_API_MAC_CARBON */
3523 /* set interprogram-cut-function to mac-cut-function in mac-win.el
3524 to enable Emacs to write the top of the kill-ring to the Mac clipboard. */
3525 DEFUN ("mac-cut-function", Fmac_cut_function
, Smac_cut_function
, 1, 2, 0,
3526 doc
: /* Put the value of the string parameter to the Mac clipboard. */)
3528 Lisp_Object value
, push
;
3533 /* fixme: ignore the push flag for now */
3535 CHECK_STRING (value
);
3537 len
= SCHARS (value
);
3538 buf
= (char *) alloca (len
+1);
3539 bcopy (SDATA (value
), buf
, len
);
3542 /* convert to Mac-style eol's before sending to clipboard */
3543 for (i
= 0; i
< len
; i
++)
3547 #if TARGET_API_MAC_CARBON
3552 ClearCurrentScrap ();
3553 if (GetCurrentScrap (&scrap
) != noErr
)
3556 error ("cannot get current scrap");
3559 if (PutScrapFlavor (scrap
, kScrapFlavorTypeText
, kScrapFlavorMaskNone
, len
,
3563 error ("cannot put to scrap");
3567 #else /* not TARGET_API_MAC_CARBON */
3569 PutScrap (len
, 'TEXT', buf
);
3570 #endif /* not TARGET_API_MAC_CARBON */
3576 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
3578 doc
: /* Whether there is an owner for the given X Selection.
3579 The arg should be the name of the selection in question, typically one of
3580 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
3581 \(Those are literal upper-case symbol names, since that's what X expects.)
3582 For convenience, the symbol nil is the same as `PRIMARY',
3583 and t is the same as `SECONDARY'. */)
3585 Lisp_Object selection
;
3587 CHECK_SYMBOL (selection
);
3589 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
3590 if the clipboard currently has valid text format contents. */
3592 if (EQ (selection
, QCLIPBOARD
))
3594 Lisp_Object val
= Qnil
;
3596 #if TARGET_API_MAC_CARBON
3598 ScrapFlavorFlags sff
;
3601 if (GetCurrentScrap (&scrap
) == noErr
)
3602 if (GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
) == noErr
)
3605 #else /* not TARGET_API_MAC_CARBON */
3607 long rc
, scrap_offset
;
3609 my_handle
= NewHandle (0);
3611 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3615 DisposeHandle (my_handle
);
3616 #endif /* not TARGET_API_MAC_CARBON */
3623 #if TARGET_API_MAC_CARBON
3624 static Lisp_Object Qxml
;
3626 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3627 doc
: /* Return the application preference value for KEY.
3628 KEY is either a string specifying a preference key, or a list of key
3629 strings. If it is a list, the (i+1)-th element is used as a key for
3630 the CFDictionary value obtained by the i-th element. If lookup is
3631 failed at some stage, nil is returned.
3633 Optional arg APPLICATION is an application ID string. If omitted or
3634 nil, that stands for the current application.
3636 Optional arg FORMAT specifies the data format of the return value. If
3637 omitted or nil, each Core Foundation object is converted into a
3638 corresponding Lisp object as follows:
3640 Core Foundation Lisp Tag
3641 ------------------------------------------------------------
3642 CFString Multibyte string string
3643 CFNumber Integer or float number
3644 CFBoolean Symbol (t or nil) boolean
3645 CFDate List of three integers date
3646 (cf. `current-time')
3647 CFData Unibyte string data
3649 CFDictionary Alist or hash table dictionary
3650 (depending on HASH-BOUND)
3652 If it is t, a symbol that represents the type of the original Core
3653 Foundation object is prepended. If it is `xml', the value is returned
3654 as an XML representation.
3656 Optional arg HASH-BOUND specifies which kinds of the list objects,
3657 alists or hash tables, are used as the targets of the conversion from
3658 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3659 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3660 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3662 (key
, application
, format
, hash_bound
)
3663 Lisp_Object key
, application
, format
, hash_bound
;
3665 CFStringRef app_id
, key_str
;
3666 CFPropertyListRef app_plist
= NULL
, plist
;
3667 Lisp_Object result
= Qnil
, tmp
;
3670 key
= Fcons (key
, Qnil
);
3674 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3675 CHECK_STRING_CAR (tmp
);
3677 wrong_type_argument (Qlistp
, key
);
3679 if (!NILP (application
))
3680 CHECK_STRING (application
);
3681 CHECK_SYMBOL (format
);
3682 if (!NILP (hash_bound
))
3683 CHECK_NUMBER (hash_bound
);
3687 app_id
= kCFPreferencesCurrentApplication
;
3688 if (!NILP (application
))
3690 app_id
= cfstring_create_with_utf8_cstring (SDATA (application
));
3694 key_str
= cfstring_create_with_utf8_cstring (SDATA (XCAR (key
)));
3695 if (key_str
== NULL
)
3697 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3698 CFRelease (key_str
);
3699 if (app_plist
== NULL
)
3703 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3705 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3707 key_str
= cfstring_create_with_utf8_cstring (SDATA (XCAR (key
)));
3708 if (key_str
== NULL
)
3710 plist
= CFDictionaryGetValue (plist
, key_str
);
3711 CFRelease (key_str
);
3717 if (EQ (format
, Qxml
))
3719 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3722 result
= cfdata_to_lisp (data
);
3727 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3728 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3732 CFRelease (app_plist
);
3739 #endif /* TARGET_API_MAC_CARBON */
3742 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
3743 doc
: /* Clear the font name table. */)
3747 mac_clear_font_name_table ();
3754 extern int inhibit_window_system
;
3755 extern int noninteractive
;
3757 /* Unlike in X11, window events in Carbon do not come from sockets.
3758 So we cannot simply use `select' to monitor two kinds of inputs:
3759 window events and process outputs. We emulate such functionality
3760 by regarding fd 0 as the window event channel and simultaneously
3761 monitoring both kinds of input channels. It is implemented by
3762 dividing into some cases:
3763 1. The window event channel is not involved.
3765 2. Sockets are not involved.
3766 -> Use ReceiveNextEvent.
3767 3. [If SELECT_USE_CFSOCKET is defined]
3768 Only the window event channel and socket read channels are
3769 involved, and timeout is not too short (greater than
3770 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
3771 -> Create CFSocket for each socket and add it into the current
3772 event RunLoop so that an `ready-to-read' event can be posted
3773 to the event queue that is also used for window events. Then
3774 ReceiveNextEvent can wait for both kinds of inputs.
3776 -> Periodically poll the window input channel while repeatedly
3777 executing `select' with a short timeout
3778 (SELECT_POLLING_PERIOD_USEC microseconds). */
3780 #define SELECT_POLLING_PERIOD_USEC 20000
3781 #ifdef SELECT_USE_CFSOCKET
3782 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
3783 #define EVENT_CLASS_SOCK 'Sock'
3786 socket_callback (s
, type
, address
, data
, info
)
3788 CFSocketCallBackType type
;
3795 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
3796 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
3797 ReleaseEvent (event
);
3799 #endif /* SELECT_USE_CFSOCKET */
3802 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
3807 struct timeval
*timeout
;
3812 r
= select (n
, rfds
, wfds
, efds
, timeout
);
3816 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
3817 kEventLeaveInQueue
, NULL
);
3828 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
3829 #undef SELECT_INVALIDATE_CFSOCKET
3833 sys_select (n
, rfds
, wfds
, efds
, timeout
)
3838 struct timeval
*timeout
;
3842 EMACS_TIME select_timeout
;
3844 if (inhibit_window_system
|| noninteractive
3845 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
3846 return select (n
, rfds
, wfds
, efds
, timeout
);
3850 if (wfds
== NULL
&& efds
== NULL
)
3853 SELECT_TYPE orfds
= *rfds
;
3855 EventTimeout timeout_sec
=
3857 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
3858 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
3859 : kEventDurationForever
);
3861 for (i
= 1; i
< n
; i
++)
3862 if (FD_ISSET (i
, rfds
))
3868 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
3869 kEventLeaveInQueue
, NULL
);
3880 /* Avoid initial overhead of RunLoop setup for the case that
3881 some input is already available. */
3882 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
3883 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
3884 if (r
!= 0 || timeout_sec
== 0.0)
3889 #ifdef SELECT_USE_CFSOCKET
3890 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
3891 goto poll_periodically
;
3894 CFRunLoopRef runloop
=
3895 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
3896 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
3897 #ifdef SELECT_INVALIDATE_CFSOCKET
3898 CFSocketRef
*shead
, *s
;
3900 CFRunLoopSourceRef
*shead
, *s
;
3905 #ifdef SELECT_INVALIDATE_CFSOCKET
3906 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
3908 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
3911 for (i
= 1; i
< n
; i
++)
3912 if (FD_ISSET (i
, rfds
))
3914 CFSocketRef socket
=
3915 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
3916 socket_callback
, NULL
);
3917 CFRunLoopSourceRef source
=
3918 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
3920 #ifdef SELECT_INVALIDATE_CFSOCKET
3921 CFSocketSetSocketFlags (socket
, 0);
3923 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
3924 #ifdef SELECT_INVALIDATE_CFSOCKET
3934 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
3939 #ifdef SELECT_INVALIDATE_CFSOCKET
3940 CFSocketInvalidate (*s
);
3942 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
3957 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
3958 GetEventTypeCount (specs
),
3960 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
3961 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
3968 #endif /* SELECT_USE_CFSOCKET */
3973 EMACS_TIME end_time
, now
, remaining_time
;
3974 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
3982 remaining_time
= *timeout
;
3983 EMACS_GET_TIME (now
);
3984 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
3989 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
3990 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
3991 select_timeout
= remaining_time
;
3992 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4004 EMACS_GET_TIME (now
);
4005 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4008 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4019 /* Set up environment variables so that Emacs can correctly find its
4020 support files when packaged as an application bundle. Directories
4021 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4022 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4023 by `make install' by default can instead be placed in
4024 .../Emacs.app/Contents/Resources/ and
4025 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4026 is changed only if it is not already set. Presumably if the user
4027 sets an environment variable, he will want to use files in his path
4028 instead of ones in the application bundle. */
4030 init_mac_osx_environment ()
4034 CFStringRef cf_app_bundle_pathname
;
4035 int app_bundle_pathname_len
;
4036 char *app_bundle_pathname
;
4040 /* Fetch the pathname of the application bundle as a C string into
4041 app_bundle_pathname. */
4043 bundle
= CFBundleGetMainBundle ();
4047 bundleURL
= CFBundleCopyBundleURL (bundle
);
4051 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4052 kCFURLPOSIXPathStyle
);
4053 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4054 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4056 if (!CFStringGetCString (cf_app_bundle_pathname
,
4057 app_bundle_pathname
,
4058 app_bundle_pathname_len
+ 1,
4059 kCFStringEncodingISOLatin1
))
4061 CFRelease (cf_app_bundle_pathname
);
4065 CFRelease (cf_app_bundle_pathname
);
4067 /* P should have sufficient room for the pathname of the bundle plus
4068 the subpath in it leading to the respective directories. Q
4069 should have three times that much room because EMACSLOADPATH can
4070 have the value "<path to lisp dir>:<path to leim dir>:<path to
4072 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4073 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4074 if (!getenv ("EMACSLOADPATH"))
4078 strcpy (p
, app_bundle_pathname
);
4079 strcat (p
, "/Contents/Resources/lisp");
4080 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4083 strcpy (p
, app_bundle_pathname
);
4084 strcat (p
, "/Contents/Resources/leim");
4085 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4092 strcpy (p
, app_bundle_pathname
);
4093 strcat (p
, "/Contents/Resources/site-lisp");
4094 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4102 setenv ("EMACSLOADPATH", q
, 1);
4105 if (!getenv ("EMACSPATH"))
4109 strcpy (p
, app_bundle_pathname
);
4110 strcat (p
, "/Contents/MacOS/libexec");
4111 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4114 strcpy (p
, app_bundle_pathname
);
4115 strcat (p
, "/Contents/MacOS/bin");
4116 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4124 setenv ("EMACSPATH", q
, 1);
4127 if (!getenv ("EMACSDATA"))
4129 strcpy (p
, app_bundle_pathname
);
4130 strcat (p
, "/Contents/Resources/etc");
4131 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4132 setenv ("EMACSDATA", p
, 1);
4135 if (!getenv ("EMACSDOC"))
4137 strcpy (p
, app_bundle_pathname
);
4138 strcat (p
, "/Contents/Resources/etc");
4139 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4140 setenv ("EMACSDOC", p
, 1);
4143 if (!getenv ("INFOPATH"))
4145 strcpy (p
, app_bundle_pathname
);
4146 strcat (p
, "/Contents/Resources/info");
4147 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4148 setenv ("INFOPATH", p
, 1);
4151 #endif /* MAC_OSX */
4156 QCLIPBOARD
= intern ("CLIPBOARD");
4157 staticpro (&QCLIPBOARD
);
4159 #if TARGET_API_MAC_CARBON
4160 Qstring
= intern ("string");
4161 staticpro (&Qstring
);
4163 Qnumber
= intern ("number");
4164 staticpro (&Qnumber
);
4166 Qboolean
= intern ("boolean");
4167 staticpro (&Qboolean
);
4169 Qdate
= intern ("date");
4172 Qdata
= intern ("data");
4175 Qarray
= intern ("array");
4176 staticpro (&Qarray
);
4178 Qdictionary
= intern ("dictionary");
4179 staticpro (&Qdictionary
);
4181 Qxml
= intern ("xml");
4185 defsubr (&Smac_paste_function
);
4186 defsubr (&Smac_cut_function
);
4187 defsubr (&Sx_selection_exists_p
);
4188 #if TARGET_API_MAC_CARBON
4189 defsubr (&Smac_get_preference
);
4191 defsubr (&Smac_clear_font_name_table
);
4193 defsubr (&Sdo_applescript
);
4194 defsubr (&Smac_file_name_to_posix
);
4195 defsubr (&Sposix_file_name_to_mac
);
4198 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4199 (do not change this comment) */