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"
42 #include <TextUtils.h>
44 #include <Resources.h>
49 #include <AppleScript.h>
52 #include <Processes.h>
54 #include <MacLocales.h>
55 #endif /* not HAVE_CARBON */
59 #include <sys/types.h>
64 #include <sys/param.h>
71 Lisp_Object QCLIPBOARD
;
73 /* The system script code. */
74 static int mac_system_script_code
;
76 /* The system locale identifier string. */
77 static Lisp_Object Vmac_system_locale
;
79 /* An instance of the AppleScript component. */
80 static ComponentInstance as_scripting_component
;
81 /* The single script context used for all script executions. */
82 static OSAID as_script_context
;
85 /* When converting from Mac to Unix pathnames, /'s in folder names are
86 converted to :'s. This function, used in copying folder names,
87 performs a strncat and converts all character a to b in the copy of
88 the string s2 appended to the end of s1. */
91 string_cat_and_replace (char *s1
, const char *s2
, int n
, char a
, char b
)
99 for (i
= 0; i
< l2
; i
++)
108 /* Convert a Mac pathname to Posix form. A Mac full pathname is one
109 that does not begin with a ':' and contains at least one ':'. A Mac
110 full pathname causes a '/' to be prepended to the Posix pathname.
111 The algorithm for the rest of the pathname is as follows:
112 For each segment between two ':',
113 if it is non-null, copy as is and then add a '/' at the end,
114 otherwise, insert a "../" into the Posix pathname.
115 Returns 1 if successful; 0 if fails. */
118 mac_to_posix_pathname (const char *mfn
, char *ufn
, int ufnbuflen
)
120 const char *p
, *q
, *pe
;
127 p
= strchr (mfn
, ':');
128 if (p
!= 0 && p
!= mfn
) /* full pathname */
135 pe
= mfn
+ strlen (mfn
);
142 { /* two consecutive ':' */
143 if (strlen (ufn
) + 3 >= ufnbuflen
)
149 if (strlen (ufn
) + (q
- p
) + 1 >= ufnbuflen
)
151 string_cat_and_replace (ufn
, p
, q
- p
, '/', ':');
158 if (strlen (ufn
) + (pe
- p
) >= ufnbuflen
)
160 string_cat_and_replace (ufn
, p
, pe
- p
, '/', ':');
161 /* no separator for last one */
170 extern char *get_temp_dir_name ();
173 /* Convert a Posix pathname to Mac form. Approximately reverse of the
174 above in algorithm. */
177 posix_to_mac_pathname (const char *ufn
, char *mfn
, int mfnbuflen
)
179 const char *p
, *q
, *pe
;
180 char expanded_pathname
[MAXPATHLEN
+1];
189 /* Check for and handle volume names. Last comparison: strangely
190 somewhere "/.emacs" is passed. A temporary fix for now. */
191 if (*p
== '/' && strchr (p
+1, '/') == NULL
&& strcmp (p
, "/.emacs") != 0)
193 if (strlen (p
) + 1 > mfnbuflen
)
200 /* expand to emacs dir found by init_emacs_passwd_dir */
201 if (strncmp (p
, "~emacs/", 7) == 0)
203 struct passwd
*pw
= getpwnam ("emacs");
205 if (strlen (pw
->pw_dir
) + strlen (p
) > MAXPATHLEN
)
207 strcpy (expanded_pathname
, pw
->pw_dir
);
208 strcat (expanded_pathname
, p
);
209 p
= expanded_pathname
;
210 /* now p points to the pathname with emacs dir prefix */
212 else if (strncmp (p
, "/tmp/", 5) == 0)
214 char *t
= get_temp_dir_name ();
216 if (strlen (t
) + strlen (p
) > MAXPATHLEN
)
218 strcpy (expanded_pathname
, t
);
219 strcat (expanded_pathname
, p
);
220 p
= expanded_pathname
;
221 /* now p points to the pathname with emacs dir prefix */
223 else if (*p
!= '/') /* relative pathname */
235 if (q
- p
== 2 && *p
== '.' && *(p
+1) == '.')
237 if (strlen (mfn
) + 1 >= mfnbuflen
)
243 if (strlen (mfn
) + (q
- p
) + 1 >= mfnbuflen
)
245 string_cat_and_replace (mfn
, p
, q
- p
, ':', '/');
252 if (strlen (mfn
) + (pe
- p
) >= mfnbuflen
)
254 string_cat_and_replace (mfn
, p
, pe
- p
, ':', '/');
263 /***********************************************************************
264 Conversion between Lisp and Core Foundation objects
265 ***********************************************************************/
267 #if TARGET_API_MAC_CARBON
268 static Lisp_Object Qstring
, Qnumber
, Qboolean
, Qdate
, Qdata
;
269 static Lisp_Object Qarray
, Qdictionary
;
270 #define DECODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 0)
272 struct cfdict_context
275 int with_tag
, hash_bound
;
278 /* C string to CFString. */
281 cfstring_create_with_utf8_cstring (c_str
)
286 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingUTF8
);
288 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
289 str
= CFStringCreateWithCString (NULL
, c_str
, kCFStringEncodingMacRoman
);
295 /* Lisp string to CFString. */
298 cfstring_create_with_string (s
)
301 CFStringRef string
= NULL
;
303 if (STRING_MULTIBYTE (s
))
305 char *p
, *end
= SDATA (s
) + SBYTES (s
);
307 for (p
= SDATA (s
); p
< end
; p
++)
310 s
= ENCODE_UTF_8 (s
);
313 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
314 kCFStringEncodingUTF8
, false);
318 /* Failed to interpret as UTF 8. Fall back on Mac Roman. */
319 string
= CFStringCreateWithBytes (NULL
, SDATA (s
), SBYTES (s
),
320 kCFStringEncodingMacRoman
, false);
326 /* From CFData to a lisp string. Always returns a unibyte string. */
329 cfdata_to_lisp (data
)
332 CFIndex len
= CFDataGetLength (data
);
333 Lisp_Object result
= make_uninit_string (len
);
335 CFDataGetBytes (data
, CFRangeMake (0, len
), SDATA (result
));
341 /* From CFString to a lisp string. Never returns a unibyte string
342 (even if it only contains ASCII characters).
343 This may cause GC during code conversion. */
346 cfstring_to_lisp (string
)
349 Lisp_Object result
= Qnil
;
350 const char *s
= CFStringGetCStringPtr (string
, kCFStringEncodingUTF8
);
353 result
= make_unibyte_string (s
, strlen (s
));
357 CFStringCreateExternalRepresentation (NULL
, string
,
358 kCFStringEncodingUTF8
, '?');
362 result
= cfdata_to_lisp (data
);
369 result
= DECODE_UTF_8 (result
);
370 /* This may be superfluous. Just to make sure that the result
371 is a multibyte string. */
372 result
= string_to_multibyte (result
);
379 /* CFNumber to a lisp integer or a lisp float. */
382 cfnumber_to_lisp (number
)
385 Lisp_Object result
= Qnil
;
386 #if BITS_PER_EMACS_INT > 32
388 CFNumberType emacs_int_type
= kCFNumberSInt64Type
;
391 CFNumberType emacs_int_type
= kCFNumberSInt32Type
;
395 if (CFNumberGetValue (number
, emacs_int_type
, &int_val
)
396 && !FIXNUM_OVERFLOW_P (int_val
))
397 result
= make_number (int_val
);
399 if (CFNumberGetValue (number
, kCFNumberDoubleType
, &float_val
))
400 result
= make_float (float_val
);
405 /* CFDate to a list of three integers as in a return value of
409 cfdate_to_lisp (date
)
412 static const CFGregorianDate epoch_gdate
= {1970, 1, 1, 0, 0, 0.0};
413 static CFAbsoluteTime epoch
= 0.0, sec
;
417 epoch
= CFGregorianDateGetAbsoluteTime (epoch_gdate
, NULL
);
419 sec
= CFDateGetAbsoluteTime (date
) - epoch
;
420 high
= sec
/ 65536.0;
421 low
= sec
- high
* 65536.0;
423 return list3 (make_number (high
), make_number (low
), make_number (0));
427 /* CFBoolean to a lisp symbol, `t' or `nil'. */
430 cfboolean_to_lisp (boolean
)
431 CFBooleanRef boolean
;
433 return CFBooleanGetValue (boolean
) ? Qt
: Qnil
;
437 /* Any Core Foundation object to a (lengthy) lisp string. */
440 cfobject_desc_to_lisp (object
)
443 Lisp_Object result
= Qnil
;
444 CFStringRef desc
= CFCopyDescription (object
);
448 result
= cfstring_to_lisp (desc
);
456 /* Callback functions for cfproperty_list_to_lisp. */
459 cfdictionary_add_to_list (key
, value
, context
)
464 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
467 Fcons (Fcons (cfstring_to_lisp (key
),
468 cfproperty_list_to_lisp (value
, cxt
->with_tag
,
474 cfdictionary_puthash (key
, value
, context
)
479 Lisp_Object lisp_key
= cfstring_to_lisp (key
);
480 struct cfdict_context
*cxt
= (struct cfdict_context
*)context
;
481 struct Lisp_Hash_Table
*h
= XHASH_TABLE (*(cxt
->result
));
484 hash_lookup (h
, lisp_key
, &hash_code
);
485 hash_put (h
, lisp_key
,
486 cfproperty_list_to_lisp (value
, cxt
->with_tag
, cxt
->hash_bound
),
491 /* Convert CFPropertyList PLIST to a lisp object. If WITH_TAG is
492 non-zero, a symbol that represents the type of the original Core
493 Foundation object is prepended. HASH_BOUND specifies which kinds
494 of the lisp objects, alists or hash tables, are used as the targets
495 of the conversion from CFDictionary. If HASH_BOUND is negative,
496 always generate alists. If HASH_BOUND >= 0, generate an alist if
497 the number of keys in the dictionary is smaller than HASH_BOUND,
498 and a hash table otherwise. */
501 cfproperty_list_to_lisp (plist
, with_tag
, hash_bound
)
502 CFPropertyListRef plist
;
503 int with_tag
, hash_bound
;
505 CFTypeID type_id
= CFGetTypeID (plist
);
506 Lisp_Object tag
= Qnil
, result
= Qnil
;
507 struct gcpro gcpro1
, gcpro2
;
509 GCPRO2 (tag
, result
);
511 if (type_id
== CFStringGetTypeID ())
514 result
= cfstring_to_lisp (plist
);
516 else if (type_id
== CFNumberGetTypeID ())
519 result
= cfnumber_to_lisp (plist
);
521 else if (type_id
== CFBooleanGetTypeID ())
524 result
= cfboolean_to_lisp (plist
);
526 else if (type_id
== CFDateGetTypeID ())
529 result
= cfdate_to_lisp (plist
);
531 else if (type_id
== CFDataGetTypeID ())
534 result
= cfdata_to_lisp (plist
);
536 else if (type_id
== CFArrayGetTypeID ())
538 CFIndex index
, count
= CFArrayGetCount (plist
);
541 result
= Fmake_vector (make_number (count
), Qnil
);
542 for (index
= 0; index
< count
; index
++)
543 XVECTOR (result
)->contents
[index
] =
544 cfproperty_list_to_lisp (CFArrayGetValueAtIndex (plist
, index
),
545 with_tag
, hash_bound
);
547 else if (type_id
== CFDictionaryGetTypeID ())
549 struct cfdict_context context
;
550 CFIndex count
= CFDictionaryGetCount (plist
);
553 context
.result
= &result
;
554 context
.with_tag
= with_tag
;
555 context
.hash_bound
= hash_bound
;
556 if (hash_bound
< 0 || count
< hash_bound
)
559 CFDictionaryApplyFunction (plist
, cfdictionary_add_to_list
,
564 result
= make_hash_table (Qequal
,
566 make_float (DEFAULT_REHASH_SIZE
),
567 make_float (DEFAULT_REHASH_THRESHOLD
),
569 CFDictionaryApplyFunction (plist
, cfdictionary_puthash
,
579 result
= Fcons (tag
, result
);
586 /***********************************************************************
587 Emulation of the X Resource Manager
588 ***********************************************************************/
590 /* Parser functions for resource lines. Each function takes an
591 address of a variable whose value points to the head of a string.
592 The value will be advanced so that it points to the next character
593 of the parsed part when the function returns.
595 A resource name such as "Emacs*font" is parsed into a non-empty
596 list called `quarks'. Each element is either a Lisp string that
597 represents a concrete component, a Lisp symbol LOOSE_BINDING
598 (actually Qlambda) that represents any number (>=0) of intervening
599 components, or a Lisp symbol SINGLE_COMPONENT (actually Qquote)
600 that represents as any single component. */
604 #define LOOSE_BINDING Qlambda /* '*' ("L"oose) */
605 #define SINGLE_COMPONENT Qquote /* '?' ("Q"uestion) */
611 /* WhiteSpace = {<space> | <horizontal tab>} */
612 while (*P
== ' ' || *P
== '\t')
620 /* Comment = "!" {<any character except null or newline>} */
633 /* Don't interpret filename. Just skip until the newline. */
635 parse_include_file (p
)
638 /* IncludeFile = "#" WhiteSpace "include" WhiteSpace FileName WhiteSpace */
655 /* Binding = "." | "*" */
656 if (*P
== '.' || *P
== '*')
660 while (*P
== '.' || *P
== '*')
673 /* Component = "?" | ComponentName
674 ComponentName = NameChar {NameChar}
675 NameChar = "a"-"z" | "A"-"Z" | "0"-"9" | "_" | "-" */
679 return SINGLE_COMPONENT
;
681 else if (isalnum (*P
) || *P
== '_' || *P
== '-')
685 while (isalnum (*P
) || *P
== '_' || *P
== '-')
688 return make_unibyte_string (start
, P
- start
);
695 parse_resource_name (p
)
698 Lisp_Object result
= Qnil
, component
;
701 /* ResourceName = [Binding] {Component Binding} ComponentName */
702 if (parse_binding (p
) == '*')
703 result
= Fcons (LOOSE_BINDING
, result
);
705 component
= parse_component (p
);
706 if (NILP (component
))
709 result
= Fcons (component
, result
);
710 while ((binding
= parse_binding (p
)) != '\0')
713 result
= Fcons (LOOSE_BINDING
, result
);
714 component
= parse_component (p
);
715 if (NILP (component
))
718 result
= Fcons (component
, result
);
721 /* The final component should not be '?'. */
722 if (EQ (component
, SINGLE_COMPONENT
))
725 return Fnreverse (result
);
733 Lisp_Object seq
= Qnil
, result
;
734 int buf_len
, total_len
= 0, len
, continue_p
;
736 q
= strchr (P
, '\n');
737 buf_len
= q
? q
- P
: strlen (P
);
738 buf
= xmalloc (buf_len
);
767 else if ('0' <= P
[0] && P
[0] <= '7'
768 && '0' <= P
[1] && P
[1] <= '7'
769 && '0' <= P
[2] && P
[2] <= '7')
771 *q
++ = (P
[0] - '0' << 6) + (P
[1] - '0' << 3) + (P
[2] - '0');
781 seq
= Fcons (make_unibyte_string (buf
, len
), seq
);
786 q
= strchr (P
, '\n');
787 len
= q
? q
- P
: strlen (P
);
792 buf
= xmalloc (buf_len
);
800 if (SBYTES (XCAR (seq
)) == total_len
)
801 return make_string (SDATA (XCAR (seq
)), total_len
);
804 buf
= xmalloc (total_len
);
806 for (; CONSP (seq
); seq
= XCDR (seq
))
808 len
= SBYTES (XCAR (seq
));
810 memcpy (q
, SDATA (XCAR (seq
)), len
);
812 result
= make_string (buf
, total_len
);
819 parse_resource_line (p
)
822 Lisp_Object quarks
, value
;
824 /* ResourceLine = Comment | IncludeFile | ResourceSpec | <empty line> */
825 if (parse_comment (p
) || parse_include_file (p
))
828 /* ResourceSpec = WhiteSpace ResourceName WhiteSpace ":" WhiteSpace Value */
829 skip_white_space (p
);
830 quarks
= parse_resource_name (p
);
833 skip_white_space (p
);
837 skip_white_space (p
);
838 value
= parse_value (p
);
839 return Fcons (quarks
, value
);
842 /* Skip the remaining data as a dummy value. */
849 /* Equivalents of X Resource Manager functions.
851 An X Resource Database acts as a collection of resource names and
852 associated values. It is implemented as a trie on quarks. Namely,
853 each edge is labeled by either a string, LOOSE_BINDING, or
854 SINGLE_COMPONENT. Each node has a node id, which is a unique
855 nonnegative integer, and the root node id is 0. A database is
856 implemented as a hash table that maps a pair (SRC-NODE-ID .
857 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
858 in the table as a value for HASHKEY_MAX_NID. A value associated to
859 a node is recorded as a value for the node id. */
861 #define HASHKEY_MAX_NID (make_number (0))
864 xrm_create_database ()
866 XrmDatabase database
;
868 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
869 make_float (DEFAULT_REHASH_SIZE
),
870 make_float (DEFAULT_REHASH_THRESHOLD
),
872 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
878 xrm_q_put_resource (database
, quarks
, value
)
879 XrmDatabase database
;
880 Lisp_Object quarks
, value
;
882 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
885 Lisp_Object node_id
, key
;
887 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
889 XSETINT (node_id
, 0);
890 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
892 key
= Fcons (node_id
, XCAR (quarks
));
893 i
= hash_lookup (h
, key
, &hash_code
);
897 XSETINT (node_id
, max_nid
);
898 hash_put (h
, key
, node_id
, hash_code
);
901 node_id
= HASH_VALUE (h
, i
);
903 Fputhash (node_id
, value
, database
);
905 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
908 /* Merge multiple resource entries specified by DATA into a resource
909 database DATABASE. DATA points to the head of a null-terminated
910 string consisting of multiple resource lines. It's like a
911 combination of XrmGetStringDatabase and XrmMergeDatabases. */
914 xrm_merge_string_database (database
, data
)
915 XrmDatabase database
;
918 Lisp_Object quarks_value
;
922 quarks_value
= parse_resource_line (&data
);
923 if (!NILP (quarks_value
))
924 xrm_q_put_resource (database
,
925 XCAR (quarks_value
), XCDR (quarks_value
));
930 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
931 XrmDatabase database
;
932 Lisp_Object node_id
, quark_name
, quark_class
;
934 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
935 Lisp_Object key
, labels
[3], value
;
938 if (!CONSP (quark_name
))
939 return Fgethash (node_id
, database
, Qnil
);
941 /* First, try tight bindings */
942 labels
[0] = XCAR (quark_name
);
943 labels
[1] = XCAR (quark_class
);
944 labels
[2] = SINGLE_COMPONENT
;
946 key
= Fcons (node_id
, Qnil
);
947 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
949 XSETCDR (key
, labels
[k
]);
950 i
= hash_lookup (h
, key
, NULL
);
953 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
954 XCDR (quark_name
), XCDR (quark_class
));
960 /* Then, try loose bindings */
961 XSETCDR (key
, LOOSE_BINDING
);
962 i
= hash_lookup (h
, key
, NULL
);
965 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
966 quark_name
, quark_class
);
970 return xrm_q_get_resource_1 (database
, node_id
,
971 XCDR (quark_name
), XCDR (quark_class
));
978 xrm_q_get_resource (database
, quark_name
, quark_class
)
979 XrmDatabase database
;
980 Lisp_Object quark_name
, quark_class
;
982 return xrm_q_get_resource_1 (database
, make_number (0),
983 quark_name
, quark_class
);
986 /* Retrieve a resource value for the specified NAME and CLASS from the
987 resource database DATABASE. It corresponds to XrmGetResource. */
990 xrm_get_resource (database
, name
, class)
991 XrmDatabase database
;
994 Lisp_Object quark_name
, quark_class
, tmp
;
997 quark_name
= parse_resource_name (&name
);
1000 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
1001 if (!STRINGP (XCAR (tmp
)))
1004 quark_class
= parse_resource_name (&class);
1007 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
1008 if (!STRINGP (XCAR (tmp
)))
1014 return xrm_q_get_resource (database
, quark_name
, quark_class
);
1017 #if TARGET_API_MAC_CARBON
1019 xrm_cfproperty_list_to_value (plist
)
1020 CFPropertyListRef plist
;
1022 CFTypeID type_id
= CFGetTypeID (plist
);
1024 if (type_id
== CFStringGetTypeID ())
1025 return cfstring_to_lisp (plist
);
1026 else if (type_id
== CFNumberGetTypeID ())
1029 Lisp_Object result
= Qnil
;
1031 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
1034 result
= cfstring_to_lisp (string
);
1039 else if (type_id
== CFBooleanGetTypeID ())
1040 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1041 else if (type_id
== CFDataGetTypeID ())
1042 return cfdata_to_lisp (plist
);
1048 /* Create a new resource database from the preferences for the
1049 application APPLICATION. APPLICATION is either a string that
1050 specifies an application ID, or NULL that represents the current
1054 xrm_get_preference_database (application
)
1057 #if TARGET_API_MAC_CARBON
1058 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1059 CFMutableSetRef key_set
= NULL
;
1060 CFArrayRef key_array
;
1061 CFIndex index
, count
;
1063 XrmDatabase database
;
1064 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1065 CFPropertyListRef plist
;
1067 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1069 user_doms
[0] = kCFPreferencesCurrentUser
;
1070 user_doms
[1] = kCFPreferencesAnyUser
;
1071 host_doms
[0] = kCFPreferencesCurrentHost
;
1072 host_doms
[1] = kCFPreferencesAnyHost
;
1074 database
= xrm_create_database ();
1076 GCPRO3 (database
, quarks
, value
);
1080 app_id
= kCFPreferencesCurrentApplication
;
1083 app_id
= cfstring_create_with_utf8_cstring (application
);
1088 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1089 if (key_set
== NULL
)
1091 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1092 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1094 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1098 count
= CFArrayGetCount (key_array
);
1099 for (index
= 0; index
< count
; index
++)
1100 CFSetAddValue (key_set
,
1101 CFArrayGetValueAtIndex (key_array
, index
));
1102 CFRelease (key_array
);
1106 count
= CFSetGetCount (key_set
);
1107 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1110 CFSetGetValues (key_set
, (const void **)keys
);
1111 for (index
= 0; index
< count
; index
++)
1113 res_name
= SDATA (cfstring_to_lisp (keys
[index
]));
1114 quarks
= parse_resource_name (&res_name
);
1115 if (!(NILP (quarks
) || *res_name
))
1117 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1118 value
= xrm_cfproperty_list_to_value (plist
);
1121 xrm_q_put_resource (database
, quarks
, value
);
1128 CFRelease (key_set
);
1137 return xrm_create_database ();
1144 /* The following functions with "sys_" prefix are stubs to Unix
1145 functions that have already been implemented by CW or MPW. The
1146 calls to them in Emacs source course are #define'd to call the sys_
1147 versions by the header files s-mac.h. In these stubs pathnames are
1148 converted between their Unix and Mac forms. */
1151 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1152 + 17 leap days. These are for adjusting time values returned by
1153 MacOS Toolbox functions. */
1155 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1158 #if __MSL__ < 0x6000
1159 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1160 a leap year! This is for adjusting time_t values returned by MSL
1162 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1163 #else /* __MSL__ >= 0x6000 */
1164 /* CW changes Pro 6 to follow Unix! */
1165 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1166 #endif /* __MSL__ >= 0x6000 */
1168 /* MPW library functions follow Unix (confused?). */
1169 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1170 #else /* not __MRC__ */
1172 #endif /* not __MRC__ */
1175 /* Define our own stat function for both MrC and CW. The reason for
1176 doing this: "stat" is both the name of a struct and function name:
1177 can't use the same trick like that for sys_open, sys_close, etc. to
1178 redirect Emacs's calls to our own version that converts Unix style
1179 filenames to Mac style filename because all sorts of compilation
1180 errors will be generated if stat is #define'd to be sys_stat. */
1183 stat_noalias (const char *path
, struct stat
*buf
)
1185 char mac_pathname
[MAXPATHLEN
+1];
1188 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1191 c2pstr (mac_pathname
);
1192 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1193 cipb
.hFileInfo
.ioVRefNum
= 0;
1194 cipb
.hFileInfo
.ioDirID
= 0;
1195 cipb
.hFileInfo
.ioFDirIndex
= 0;
1196 /* set to 0 to get information about specific dir or file */
1198 errno
= PBGetCatInfo (&cipb
, false);
1199 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1204 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1206 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1208 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1209 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1210 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1211 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1212 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1213 /* size of dir = number of files and dirs */
1216 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1217 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1221 buf
->st_mode
= S_IFREG
| S_IREAD
;
1222 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1223 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1224 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1225 buf
->st_mode
|= S_IEXEC
;
1226 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1227 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1228 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1231 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1232 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1235 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1237 /* identify alias files as symlinks */
1238 buf
->st_mode
&= ~S_IFREG
;
1239 buf
->st_mode
|= S_IFLNK
;
1243 buf
->st_uid
= getuid ();
1244 buf
->st_gid
= getgid ();
1252 lstat (const char *path
, struct stat
*buf
)
1255 char true_pathname
[MAXPATHLEN
+1];
1257 /* Try looking for the file without resolving aliases first. */
1258 if ((result
= stat_noalias (path
, buf
)) >= 0)
1261 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1264 return stat_noalias (true_pathname
, buf
);
1269 stat (const char *path
, struct stat
*sb
)
1272 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1275 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1276 ! (sb
->st_mode
& S_IFLNK
))
1279 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1282 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1285 fully_resolved_name
[len
] = '\0';
1286 /* in fact our readlink terminates strings */
1287 return lstat (fully_resolved_name
, sb
);
1290 return lstat (true_pathname
, sb
);
1295 /* CW defines fstat in stat.mac.c while MPW does not provide this
1296 function. Without the information of how to get from a file
1297 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1298 to implement this function. Fortunately, there is only one place
1299 where this function is called in our configuration: in fileio.c,
1300 where only the st_dev and st_ino fields are used to determine
1301 whether two fildes point to different i-nodes to prevent copying
1302 a file onto itself equal. What we have here probably needs
1306 fstat (int fildes
, struct stat
*buf
)
1309 buf
->st_ino
= fildes
;
1310 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1311 return 0; /* success */
1313 #endif /* __MRC__ */
1317 mkdir (const char *dirname
, int mode
)
1319 #pragma unused(mode)
1322 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1324 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1327 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1330 c2pstr (mac_pathname
);
1331 hfpb
.ioNamePtr
= mac_pathname
;
1332 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1333 hfpb
.ioDirID
= 0; /* parent is the root */
1335 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1336 /* just return the Mac OSErr code for now */
1337 return errno
== noErr
? 0 : -1;
1342 sys_rmdir (const char *dirname
)
1345 char mac_pathname
[MAXPATHLEN
+1];
1347 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1350 c2pstr (mac_pathname
);
1351 hfpb
.ioNamePtr
= mac_pathname
;
1352 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1353 hfpb
.ioDirID
= 0; /* parent is the root */
1355 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1356 return errno
== noErr
? 0 : -1;
1361 /* No implementation yet. */
1363 execvp (const char *path
, ...)
1367 #endif /* __MRC__ */
1371 utime (const char *path
, const struct utimbuf
*times
)
1373 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1375 char mac_pathname
[MAXPATHLEN
+1];
1378 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1381 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1383 fully_resolved_name
[len
] = '\0';
1385 strcpy (fully_resolved_name
, true_pathname
);
1387 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1390 c2pstr (mac_pathname
);
1391 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1392 cipb
.hFileInfo
.ioVRefNum
= 0;
1393 cipb
.hFileInfo
.ioDirID
= 0;
1394 cipb
.hFileInfo
.ioFDirIndex
= 0;
1395 /* set to 0 to get information about specific dir or file */
1397 errno
= PBGetCatInfo (&cipb
, false);
1401 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1404 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1406 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1411 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1413 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1416 errno
= PBSetCatInfo (&cipb
, false);
1417 return errno
== noErr
? 0 : -1;
1431 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1433 access (const char *path
, int mode
)
1435 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1437 char mac_pathname
[MAXPATHLEN
+1];
1440 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1443 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1445 fully_resolved_name
[len
] = '\0';
1447 strcpy (fully_resolved_name
, true_pathname
);
1449 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1452 c2pstr (mac_pathname
);
1453 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1454 cipb
.hFileInfo
.ioVRefNum
= 0;
1455 cipb
.hFileInfo
.ioDirID
= 0;
1456 cipb
.hFileInfo
.ioFDirIndex
= 0;
1457 /* set to 0 to get information about specific dir or file */
1459 errno
= PBGetCatInfo (&cipb
, false);
1463 if (mode
== F_OK
) /* got this far, file exists */
1467 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1471 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1478 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1479 /* don't allow if lock bit is on */
1485 #define DEV_NULL_FD 0x10000
1489 sys_open (const char *path
, int oflag
)
1491 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1493 char mac_pathname
[MAXPATHLEN
+1];
1495 if (strcmp (path
, "/dev/null") == 0)
1496 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1498 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1501 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1503 fully_resolved_name
[len
] = '\0';
1505 strcpy (fully_resolved_name
, true_pathname
);
1507 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1512 int res
= open (mac_pathname
, oflag
);
1513 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1514 if (oflag
& O_CREAT
)
1515 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1517 #else /* not __MRC__ */
1518 return open (mac_pathname
, oflag
);
1519 #endif /* not __MRC__ */
1526 sys_creat (const char *path
, mode_t mode
)
1528 char true_pathname
[MAXPATHLEN
+1];
1530 char mac_pathname
[MAXPATHLEN
+1];
1532 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1535 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1540 int result
= creat (mac_pathname
);
1541 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1543 #else /* not __MRC__ */
1544 return creat (mac_pathname
, mode
);
1545 #endif /* not __MRC__ */
1552 sys_unlink (const char *path
)
1554 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1556 char mac_pathname
[MAXPATHLEN
+1];
1558 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1561 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1563 fully_resolved_name
[len
] = '\0';
1565 strcpy (fully_resolved_name
, true_pathname
);
1567 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1570 return unlink (mac_pathname
);
1576 sys_read (int fildes
, char *buf
, int count
)
1578 if (fildes
== 0) /* this should not be used for console input */
1581 #if __MSL__ >= 0x6000
1582 return _read (fildes
, buf
, count
);
1584 return read (fildes
, buf
, count
);
1591 sys_write (int fildes
, const char *buf
, int count
)
1593 if (fildes
== DEV_NULL_FD
)
1596 #if __MSL__ >= 0x6000
1597 return _write (fildes
, buf
, count
);
1599 return write (fildes
, buf
, count
);
1606 sys_rename (const char * old_name
, const char * new_name
)
1608 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1609 char fully_resolved_old_name
[MAXPATHLEN
+1];
1611 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1613 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1616 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1618 fully_resolved_old_name
[len
] = '\0';
1620 strcpy (fully_resolved_old_name
, true_old_pathname
);
1622 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1625 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1628 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1633 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1636 /* If a file with new_name already exists, rename deletes the old
1637 file in Unix. CW version fails in these situation. So we add a
1638 call to unlink here. */
1639 (void) unlink (mac_new_name
);
1641 return rename (mac_old_name
, mac_new_name
);
1646 extern FILE *fopen (const char *name
, const char *mode
);
1648 sys_fopen (const char *name
, const char *mode
)
1650 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1652 char mac_pathname
[MAXPATHLEN
+1];
1654 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1657 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1659 fully_resolved_name
[len
] = '\0';
1661 strcpy (fully_resolved_name
, true_pathname
);
1663 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1668 if (mode
[0] == 'w' || mode
[0] == 'a')
1669 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1670 #endif /* not __MRC__ */
1671 return fopen (mac_pathname
, mode
);
1676 long target_ticks
= 0;
1679 __sigfun alarm_signal_func
= (__sigfun
) 0;
1681 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
1682 #else /* not __MRC__ and not __MWERKS__ */
1684 #endif /* not __MRC__ and not __MWERKS__ */
1687 /* These functions simulate SIG_ALRM. The stub for function signal
1688 stores the signal handler function in alarm_signal_func if a
1689 SIG_ALRM is encountered. check_alarm is called in XTread_socket,
1690 which emacs calls periodically. A pending alarm is represented by
1691 a non-zero target_ticks value. check_alarm calls the handler
1692 function pointed to by alarm_signal_func if one has been set up and
1693 an alarm is pending. */
1698 if (target_ticks
&& TickCount () > target_ticks
)
1701 if (alarm_signal_func
)
1702 (*alarm_signal_func
)(SIGALRM
);
1707 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1710 select (n
, rfds
, wfds
, efds
, timeout
)
1715 struct timeval
*timeout
;
1717 #if TARGET_API_MAC_CARBON
1719 EventTimeout timeout_sec
=
1721 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1722 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1723 : kEventDurationForever
);
1725 if (FD_ISSET (0, rfds
))
1728 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1736 #else /* not TARGET_API_MAC_CARBON */
1738 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1739 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1741 /* Can only handle wait for keyboard input. */
1742 if (n
> 1 || wfds
|| efds
)
1745 /* Also return true if an event other than a keyDown has occurred.
1746 This causes kbd_buffer_get_event in keyboard.c to call
1747 read_avail_input which in turn calls XTread_socket to poll for
1748 these events. Otherwise these never get processed except but a
1749 very slow poll timer. */
1750 if (FD_ISSET (0, rfds
) && mac_wait_next_event (&e
, sleep_time
, false))
1754 #endif /* not TARGET_API_MAC_CARBON */
1758 /* Called in sys_select to wait for an alarm signal to arrive. */
1766 if (!target_ticks
) /* no alarm pending */
1769 if ((tick
= TickCount ()) < target_ticks
)
1770 WaitNextEvent (0, &e
, target_ticks
- tick
, NULL
); /* Accept no event;
1771 just wait. by T.I. */
1774 if (alarm_signal_func
)
1775 (*alarm_signal_func
)(SIGALRM
);
1784 long remaining
= target_ticks
? (TickCount () - target_ticks
) / 60 : 0;
1786 target_ticks
= seconds
? TickCount () + 60 * seconds
: 0;
1788 return (remaining
< 0) ? 0 : (unsigned int) remaining
;
1794 extern __sigfun
signal (int signal
, __sigfun signal_func
);
1796 sys_signal (int signal_num
, __sigfun signal_func
)
1798 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
1800 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
1801 #else /* not __MRC__ and not __MWERKS__ */
1803 #endif /* not __MRC__ and not __MWERKS__ */
1805 if (signal_num
!= SIGALRM
)
1806 return signal (signal_num
, signal_func
);
1810 __sigfun old_signal_func
;
1812 __signal_func_ptr old_signal_func
;
1816 old_signal_func
= alarm_signal_func
;
1817 alarm_signal_func
= signal_func
;
1818 return old_signal_func
;
1823 /* gettimeofday should return the amount of time (in a timeval
1824 structure) since midnight today. The toolbox function Microseconds
1825 returns the number of microseconds (in a UnsignedWide value) since
1826 the machine was booted. Also making this complicated is WideAdd,
1827 WideSubtract, etc. take wide values. */
1834 static wide wall_clock_at_epoch
, clicks_at_epoch
;
1835 UnsignedWide uw_microseconds
;
1836 wide w_microseconds
;
1837 time_t sys_time (time_t *);
1839 /* If this function is called for the first time, record the number
1840 of seconds since midnight and the number of microseconds since
1841 boot at the time of this first call. */
1846 systime
= sys_time (NULL
);
1847 /* Store microseconds since midnight in wall_clock_at_epoch. */
1848 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
1849 Microseconds (&uw_microseconds
);
1850 /* Store microseconds since boot in clicks_at_epoch. */
1851 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
1852 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
1855 /* Get time since boot */
1856 Microseconds (&uw_microseconds
);
1858 /* Convert to time since midnight*/
1859 w_microseconds
.hi
= uw_microseconds
.hi
;
1860 w_microseconds
.lo
= uw_microseconds
.lo
;
1861 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
1862 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
1863 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
1871 sleep (unsigned int seconds
)
1873 unsigned long time_up
;
1876 time_up
= TickCount () + seconds
* 60;
1877 while (TickCount () < time_up
)
1879 /* Accept no event; just wait. by T.I. */
1880 WaitNextEvent (0, &e
, 30, NULL
);
1885 #endif /* __MRC__ */
1888 /* The time functions adjust time values according to the difference
1889 between the Unix and CW epoches. */
1892 extern struct tm
*gmtime (const time_t *);
1894 sys_gmtime (const time_t *timer
)
1896 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1898 return gmtime (&unix_time
);
1903 extern struct tm
*localtime (const time_t *);
1905 sys_localtime (const time_t *timer
)
1907 #if __MSL__ >= 0x6000
1908 time_t unix_time
= *timer
;
1910 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1913 return localtime (&unix_time
);
1918 extern char *ctime (const time_t *);
1920 sys_ctime (const time_t *timer
)
1922 #if __MSL__ >= 0x6000
1923 time_t unix_time
= *timer
;
1925 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1928 return ctime (&unix_time
);
1933 extern time_t time (time_t *);
1935 sys_time (time_t *timer
)
1937 #if __MSL__ >= 0x6000
1938 time_t mac_time
= time (NULL
);
1940 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
1950 /* MPW strftime broken for "%p" format */
1955 sys_strftime (char * s
, size_t maxsize
, const char * format
,
1956 const struct tm
* timeptr
)
1958 if (strcmp (format
, "%p") == 0)
1962 if (timeptr
->tm_hour
< 12)
1974 return strftime (s
, maxsize
, format
, timeptr
);
1976 #endif /* __MRC__ */
1979 /* no subprocesses, empty wait */
1989 croak (char *badfunc
)
1991 printf ("%s not yet implemented\r\n", badfunc
);
1997 index (const char * str
, int chr
)
1999 return strchr (str
, chr
);
2004 mktemp (char *template)
2009 len
= strlen (template);
2011 while (k
>= 0 && template[k
] == 'X')
2014 k
++; /* make k index of first 'X' */
2018 /* Zero filled, number of digits equal to the number of X's. */
2019 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
2028 /* Emulate getpwuid, getpwnam and others. */
2030 #define PASSWD_FIELD_SIZE 256
2032 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
2033 static char my_passwd_dir
[MAXPATHLEN
+1];
2035 static struct passwd my_passwd
=
2041 static struct group my_group
=
2043 /* There are no groups on the mac, so we just return "root" as the
2049 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2051 char emacs_passwd_dir
[MAXPATHLEN
+1];
2057 init_emacs_passwd_dir ()
2061 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2063 /* Need pathname of first ancestor that begins with "emacs"
2064 since Mac emacs application is somewhere in the emacs-*
2066 int len
= strlen (emacs_passwd_dir
);
2068 /* j points to the "/" following the directory name being
2071 while (i
>= 0 && !found
)
2073 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2075 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2076 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2078 emacs_passwd_dir
[j
+1] = '\0';
2089 /* Setting to "/" probably won't work but set it to something
2091 strcpy (emacs_passwd_dir
, "/");
2092 strcpy (my_passwd_dir
, "/");
2097 static struct passwd emacs_passwd
=
2103 static int my_passwd_inited
= 0;
2111 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2112 directory where Emacs was started. */
2114 owner_name
= (char **) GetResource ('STR ',-16096);
2118 BlockMove ((unsigned char *) *owner_name
,
2119 (unsigned char *) my_passwd_name
,
2121 HUnlock (owner_name
);
2122 p2cstr ((unsigned char *) my_passwd_name
);
2125 my_passwd_name
[0] = 0;
2130 getpwuid (uid_t uid
)
2132 if (!my_passwd_inited
)
2135 my_passwd_inited
= 1;
2143 getgrgid (gid_t gid
)
2150 getpwnam (const char *name
)
2152 if (strcmp (name
, "emacs") == 0)
2153 return &emacs_passwd
;
2155 if (!my_passwd_inited
)
2158 my_passwd_inited
= 1;
2165 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2166 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2187 error ("Can't spawn subshell");
2206 request_sigio (void)
2212 unrequest_sigio (void)
2227 pipe (int _fildes
[2])
2234 /* Hard and symbolic links. */
2237 symlink (const char *name1
, const char *name2
)
2245 link (const char *name1
, const char *name2
)
2251 #endif /* ! MAC_OSX */
2253 /* Determine the path name of the file specified by VREFNUM, DIRID,
2254 and NAME and place that in the buffer PATH of length
2257 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2258 long dir_id
, ConstStr255Param name
)
2264 if (strlen (name
) > man_path_len
)
2267 memcpy (dir_name
, name
, name
[0]+1);
2268 memcpy (path
, name
, name
[0]+1);
2271 cipb
.dirInfo
.ioDrParID
= dir_id
;
2272 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2276 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2277 cipb
.dirInfo
.ioFDirIndex
= -1;
2278 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2279 /* go up to parent each time */
2281 err
= PBGetCatInfo (&cipb
, false);
2286 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2289 strcat (dir_name
, ":");
2290 strcat (dir_name
, path
);
2291 /* attach to front since we're going up directory tree */
2292 strcpy (path
, dir_name
);
2294 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2295 /* stop when we see the volume's root directory */
2297 return 1; /* success */
2302 posix_pathname_to_fsspec (ufn
, fs
)
2306 Str255 mac_pathname
;
2308 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2312 c2pstr (mac_pathname
);
2313 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2318 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2323 char mac_pathname
[MAXPATHLEN
];
2325 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2326 fs
->vRefNum
, fs
->parID
, fs
->name
)
2327 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2336 readlink (const char *path
, char *buf
, int bufsiz
)
2338 char mac_sym_link_name
[MAXPATHLEN
+1];
2341 Boolean target_is_folder
, was_aliased
;
2342 Str255 directory_name
, mac_pathname
;
2345 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2348 c2pstr (mac_sym_link_name
);
2349 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2356 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2357 if (err
!= noErr
|| !was_aliased
)
2363 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2370 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2376 return strlen (buf
);
2380 /* Convert a path to one with aliases fully expanded. */
2383 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2385 char *q
, temp
[MAXPATHLEN
+1];
2389 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2396 q
= strchr (p
+ 1, '/');
2398 q
= strchr (p
, '/');
2399 len
= 0; /* loop may not be entered, e.g., for "/" */
2404 strncat (temp
, p
, q
- p
);
2405 len
= readlink (temp
, buf
, bufsiz
);
2408 if (strlen (temp
) + 1 > bufsiz
)
2418 if (len
+ strlen (p
) + 1 >= bufsiz
)
2422 return len
+ strlen (p
);
2427 umask (mode_t numask
)
2429 static mode_t mask
= 022;
2430 mode_t oldmask
= mask
;
2437 chmod (const char *path
, mode_t mode
)
2439 /* say it always succeed for now */
2448 return fcntl (oldd
, F_DUPFD
, 0);
2450 /* current implementation of fcntl in fcntl.mac.c simply returns old
2452 return fcntl (oldd
, F_DUPFD
);
2459 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2460 newd if it already exists. Then, attempt to dup oldd. If not
2461 successful, call dup2 recursively until we are, then close the
2462 unsuccessful ones. */
2465 dup2 (int oldd
, int newd
)
2476 ret
= dup2 (oldd
, newd
);
2482 /* let it fail for now */
2499 ioctl (int d
, int request
, void *argp
)
2509 if (fildes
>=0 && fildes
<= 2)
2542 #endif /* __MRC__ */
2546 #if __MSL__ < 0x6000
2554 #endif /* __MWERKS__ */
2556 #endif /* ! MAC_OSX */
2559 /* Return the path to the directory in which Emacs can create
2560 temporary files. The MacOS "temporary items" directory cannot be
2561 used because it removes the file written by a process when it
2562 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2563 again not exactly). And of course Emacs needs to read back the
2564 files written by its subprocesses. So here we write the files to a
2565 directory "Emacs" in the Preferences Folder. This directory is
2566 created if it does not exist. */
2569 get_temp_dir_name ()
2571 static char *temp_dir_name
= NULL
;
2575 Str255 dir_name
, full_path
;
2577 char unix_dir_name
[MAXPATHLEN
+1];
2580 /* Cache directory name with pointer temp_dir_name.
2581 Look for it only the first time. */
2584 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2585 &vol_ref_num
, &dir_id
);
2589 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2592 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2593 strcat (full_path
, "Emacs:");
2597 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2600 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2603 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2606 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2607 strcpy (temp_dir_name
, unix_dir_name
);
2610 return temp_dir_name
;
2615 /* Allocate and construct an array of pointers to strings from a list
2616 of strings stored in a 'STR#' resource. The returned pointer array
2617 is stored in the style of argv and environ: if the 'STR#' resource
2618 contains numString strings, a pointer array with numString+1
2619 elements is returned in which the last entry contains a null
2620 pointer. The pointer to the pointer array is passed by pointer in
2621 parameter t. The resource ID of the 'STR#' resource is passed in
2622 parameter StringListID.
2626 get_string_list (char ***t
, short string_list_id
)
2632 h
= GetResource ('STR#', string_list_id
);
2637 num_strings
= * (short *) p
;
2639 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2640 for (i
= 0; i
< num_strings
; i
++)
2642 short length
= *p
++;
2643 (*t
)[i
] = (char *) malloc (length
+ 1);
2644 strncpy ((*t
)[i
], p
, length
);
2645 (*t
)[i
][length
] = '\0';
2648 (*t
)[num_strings
] = 0;
2653 /* Return no string in case GetResource fails. Bug fixed by
2654 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2655 option (no sym -on implies -opt local). */
2656 *t
= (char **) malloc (sizeof (char *));
2663 get_path_to_system_folder ()
2668 Str255 dir_name
, full_path
;
2670 static char system_folder_unix_name
[MAXPATHLEN
+1];
2673 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2674 &vol_ref_num
, &dir_id
);
2678 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2681 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2685 return system_folder_unix_name
;
2691 #define ENVIRON_STRING_LIST_ID 128
2693 /* Get environment variable definitions from STR# resource. */
2700 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2706 /* Make HOME directory the one Emacs starts up in if not specified
2708 if (getenv ("HOME") == NULL
)
2710 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2713 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2716 strcpy (environ
[i
], "HOME=");
2717 strcat (environ
[i
], my_passwd_dir
);
2724 /* Make HOME directory the one Emacs starts up in if not specified
2726 if (getenv ("MAIL") == NULL
)
2728 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2731 char * path_to_system_folder
= get_path_to_system_folder ();
2732 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2735 strcpy (environ
[i
], "MAIL=");
2736 strcat (environ
[i
], path_to_system_folder
);
2737 strcat (environ
[i
], "Eudora Folder/In");
2745 /* Return the value of the environment variable NAME. */
2748 getenv (const char *name
)
2750 int length
= strlen(name
);
2753 for (e
= environ
; *e
!= 0; e
++)
2754 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2755 return &(*e
)[length
+ 1];
2757 if (strcmp (name
, "TMPDIR") == 0)
2758 return get_temp_dir_name ();
2765 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2766 char *sys_siglist
[] =
2768 "Zero is not a signal!!!",
2770 "Interactive user interrupt", /* 2 */ "?",
2771 "Floating point exception", /* 4 */ "?", "?", "?",
2772 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2773 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2774 "?", "?", "?", "?", "?", "?", "?", "?",
2778 char *sys_siglist
[] =
2780 "Zero is not a signal!!!",
2782 "Floating point exception",
2783 "Illegal instruction",
2784 "Interactive user interrupt",
2785 "Segment violation",
2788 #else /* not __MRC__ and not __MWERKS__ */
2790 #endif /* not __MRC__ and not __MWERKS__ */
2793 #include <utsname.h>
2796 uname (struct utsname
*name
)
2799 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2802 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2803 p2cstr (name
->nodename
);
2811 /* Event class of HLE sent to subprocess. */
2812 const OSType kEmacsSubprocessSend
= 'ESND';
2814 /* Event class of HLE sent back from subprocess. */
2815 const OSType kEmacsSubprocessReply
= 'ERPY';
2819 mystrchr (char *s
, char c
)
2821 while (*s
&& *s
!= c
)
2849 mystrcpy (char *to
, char *from
)
2861 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2862 terminated). The process should run with the default directory
2863 "workdir", read input from "infn", and write output and error to
2864 "outfn" and "errfn", resp. The Process Manager call
2865 LaunchApplication is used to start the subprocess. We use high
2866 level events as the mechanism to pass arguments to the subprocess
2867 and to make Emacs wait for the subprocess to terminate and pass
2868 back a result code. The bulk of the code here packs the arguments
2869 into one message to be passed together with the high level event.
2870 Emacs also sometimes starts a subprocess using a shell to perform
2871 wildcard filename expansion. Since we don't really have a shell on
2872 the Mac, this case is detected and the starting of the shell is
2873 by-passed. We really need to add code here to do filename
2874 expansion to support such functionality. */
2877 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2878 unsigned char **argv
;
2879 const char *workdir
;
2880 const char *infn
, *outfn
, *errfn
;
2882 #if TARGET_API_MAC_CARBON
2884 #else /* not TARGET_API_MAC_CARBON */
2885 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2886 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2887 int paramlen
, argc
, newargc
, j
, retries
;
2888 char **newargv
, *param
, *p
;
2891 LaunchParamBlockRec lpbr
;
2892 EventRecord send_event
, reply_event
;
2893 RgnHandle cursor_region_handle
;
2895 unsigned long ref_con
, len
;
2897 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2899 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2901 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2903 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2906 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2907 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2916 /* If a subprocess is invoked with a shell, we receive 3 arguments
2917 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2918 bins>/<command> <command args>" */
2919 j
= strlen (argv
[0]);
2920 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2921 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2923 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2925 /* The arguments for the command in argv[2] are separated by
2926 spaces. Count them and put the count in newargc. */
2927 command
= (char *) alloca (strlen (argv
[2])+2);
2928 strcpy (command
, argv
[2]);
2929 if (command
[strlen (command
) - 1] != ' ')
2930 strcat (command
, " ");
2934 t
= mystrchr (t
, ' ');
2938 t
= mystrchr (t
+1, ' ');
2941 newargv
= (char **) alloca (sizeof (char *) * newargc
);
2944 for (j
= 0; j
< newargc
; j
++)
2946 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
2947 mystrcpy (newargv
[j
], t
);
2950 paramlen
+= strlen (newargv
[j
]) + 1;
2953 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
2955 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
2960 { /* sometimes Emacs call "sh" without a path for the command */
2962 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
2963 strcpy (t
, "~emacs/");
2964 strcat (t
, newargv
[0]);
2967 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
2968 make_number (X_OK
));
2972 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
2976 strcpy (macappname
, tempmacpathname
);
2980 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
2983 newargv
= (char **) alloca (sizeof (char *) * argc
);
2985 for (j
= 1; j
< argc
; j
++)
2987 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
2989 char *t
= strchr (argv
[j
], ' ');
2992 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
2993 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
2994 tempcmdname
[t
-argv
[j
]] = '\0';
2995 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
2998 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
3000 strcpy (newargv
[j
], tempmaccmdname
);
3001 strcat (newargv
[j
], t
);
3005 char tempmaccmdname
[MAXPATHLEN
+1];
3006 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
3009 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
3010 strcpy (newargv
[j
], tempmaccmdname
);
3014 newargv
[j
] = argv
[j
];
3015 paramlen
+= strlen (newargv
[j
]) + 1;
3019 /* After expanding all the arguments, we now know the length of the
3020 parameter block to be sent to the subprocess as a message
3021 attached to the HLE. */
3022 param
= (char *) malloc (paramlen
+ 1);
3028 /* first byte of message contains number of arguments for command */
3029 strcpy (p
, macworkdir
);
3030 p
+= strlen (macworkdir
);
3032 /* null terminate strings sent so it's possible to use strcpy over there */
3033 strcpy (p
, macinfn
);
3034 p
+= strlen (macinfn
);
3036 strcpy (p
, macoutfn
);
3037 p
+= strlen (macoutfn
);
3039 strcpy (p
, macerrfn
);
3040 p
+= strlen (macerrfn
);
3042 for (j
= 1; j
< newargc
; j
++)
3044 strcpy (p
, newargv
[j
]);
3045 p
+= strlen (newargv
[j
]);
3049 c2pstr (macappname
);
3051 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3059 lpbr
.launchBlockID
= extendedBlock
;
3060 lpbr
.launchEPBLength
= extendedBlockLen
;
3061 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3062 lpbr
.launchAppSpec
= &spec
;
3063 lpbr
.launchAppParameters
= NULL
;
3065 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3072 send_event
.what
= kHighLevelEvent
;
3073 send_event
.message
= kEmacsSubprocessSend
;
3074 /* Event ID stored in "where" unused */
3077 /* OS may think current subprocess has terminated if previous one
3078 terminated recently. */
3081 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3082 paramlen
+ 1, receiverIDisPSN
);
3084 while (iErr
== sessClosedErr
&& retries
-- > 0);
3092 cursor_region_handle
= NewRgn ();
3094 /* Wait for the subprocess to finish, when it will send us a ERPY
3095 high level event. */
3097 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3098 cursor_region_handle
)
3099 && reply_event
.message
== kEmacsSubprocessReply
)
3102 /* The return code is sent through the refCon */
3103 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3106 DisposeHandle ((Handle
) cursor_region_handle
);
3111 DisposeHandle ((Handle
) cursor_region_handle
);
3115 #endif /* not TARGET_API_MAC_CARBON */
3120 opendir (const char *dirname
)
3122 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3123 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3127 int len
, vol_name_len
;
3129 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3132 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3134 fully_resolved_name
[len
] = '\0';
3136 strcpy (fully_resolved_name
, true_pathname
);
3138 dirp
= (DIR *) malloc (sizeof(DIR));
3142 /* Handle special case when dirname is "/": sets up for readir to
3143 get all mount volumes. */
3144 if (strcmp (fully_resolved_name
, "/") == 0)
3146 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3147 dirp
->current_index
= 1; /* index for first volume */
3151 /* Handle typical cases: not accessing all mounted volumes. */
3152 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3155 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3156 len
= strlen (mac_pathname
);
3157 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3158 strcat (mac_pathname
, ":");
3160 /* Extract volume name */
3161 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3162 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3163 vol_name
[vol_name_len
] = '\0';
3164 strcat (vol_name
, ":");
3166 c2pstr (mac_pathname
);
3167 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3168 /* using full pathname so vRefNum and DirID ignored */
3169 cipb
.hFileInfo
.ioVRefNum
= 0;
3170 cipb
.hFileInfo
.ioDirID
= 0;
3171 cipb
.hFileInfo
.ioFDirIndex
= 0;
3172 /* set to 0 to get information about specific dir or file */
3174 errno
= PBGetCatInfo (&cipb
, false);
3181 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3182 return 0; /* not a directory */
3184 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3185 dirp
->getting_volumes
= 0;
3186 dirp
->current_index
= 1; /* index for first file/directory */
3189 vpb
.ioNamePtr
= vol_name
;
3190 /* using full pathname so vRefNum and DirID ignored */
3192 vpb
.ioVolIndex
= -1;
3193 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3200 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3217 HParamBlockRec hpblock
;
3219 static struct dirent s_dirent
;
3220 static Str255 s_name
;
3224 /* Handle the root directory containing the mounted volumes. Call
3225 PBHGetVInfo specifying an index to obtain the info for a volume.
3226 PBHGetVInfo returns an error when it receives an index beyond the
3227 last volume, at which time we should return a nil dirent struct
3229 if (dp
->getting_volumes
)
3231 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3232 hpblock
.volumeParam
.ioVRefNum
= 0;
3233 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3235 errno
= PBHGetVInfo (&hpblock
, false);
3243 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3245 dp
->current_index
++;
3247 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3248 s_dirent
.d_name
= s_name
;
3254 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3255 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3256 /* location to receive filename returned */
3258 /* return only visible files */
3262 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3263 /* directory ID found by opendir */
3264 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3266 errno
= PBGetCatInfo (&cipb
, false);
3273 /* insist on a visible entry */
3274 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3275 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3277 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3279 dp
->current_index
++;
3292 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3293 /* value unimportant: non-zero for valid file */
3294 s_dirent
.d_name
= s_name
;
3304 char mac_pathname
[MAXPATHLEN
+1];
3305 Str255 directory_name
;
3309 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3312 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3318 #endif /* ! MAC_OSX */
3322 initialize_applescript ()
3327 /* if open fails, as_scripting_component is set to NULL. Its
3328 subsequent use in OSA calls will fail with badComponentInstance
3330 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3331 kAppleScriptSubtype
);
3333 null_desc
.descriptorType
= typeNull
;
3334 null_desc
.dataHandle
= 0;
3335 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3336 kOSANullScript
, &as_script_context
);
3338 as_script_context
= kOSANullScript
;
3339 /* use default context if create fails */
3343 void terminate_applescript()
3345 OSADispose (as_scripting_component
, as_script_context
);
3346 CloseComponent (as_scripting_component
);
3350 /* Compile and execute the AppleScript SCRIPT and return the error
3351 status as function value. A zero is returned if compilation and
3352 execution is successful, in which case RESULT returns a pointer to
3353 a string containing the resulting script value. Otherwise, the Mac
3354 error code is returned and RESULT returns a pointer to an error
3355 string. In both cases the caller should deallocate the storage
3356 used by the string pointed to by RESULT if it is non-NULL. For
3357 documentation on the MacOS scripting architecture, see Inside
3358 Macintosh - Interapplication Communications: Scripting Components. */
3361 do_applescript (char *script
, char **result
)
3363 AEDesc script_desc
, result_desc
, error_desc
;
3370 if (!as_scripting_component
)
3371 initialize_applescript();
3373 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3377 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3378 typeChar
, kOSAModeNull
, &result_desc
);
3380 if (osaerror
== errOSAScriptError
)
3382 /* error executing AppleScript: retrieve error message */
3383 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3386 #if TARGET_API_MAC_CARBON
3387 length
= AEGetDescDataSize (&error_desc
);
3388 *result
= (char *) xmalloc (length
+ 1);
3391 AEGetDescData (&error_desc
, *result
, length
);
3392 *(*result
+ length
) = '\0';
3394 #else /* not TARGET_API_MAC_CARBON */
3395 HLock (error_desc
.dataHandle
);
3396 length
= GetHandleSize(error_desc
.dataHandle
);
3397 *result
= (char *) xmalloc (length
+ 1);
3400 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3401 *(*result
+ length
) = '\0';
3403 HUnlock (error_desc
.dataHandle
);
3404 #endif /* not TARGET_API_MAC_CARBON */
3405 AEDisposeDesc (&error_desc
);
3408 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3410 #if TARGET_API_MAC_CARBON
3411 length
= AEGetDescDataSize (&result_desc
);
3412 *result
= (char *) xmalloc (length
+ 1);
3415 AEGetDescData (&result_desc
, *result
, length
);
3416 *(*result
+ length
) = '\0';
3418 #else /* not TARGET_API_MAC_CARBON */
3419 HLock (result_desc
.dataHandle
);
3420 length
= GetHandleSize(result_desc
.dataHandle
);
3421 *result
= (char *) xmalloc (length
+ 1);
3424 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3425 *(*result
+ length
) = '\0';
3427 HUnlock (result_desc
.dataHandle
);
3428 #endif /* not TARGET_API_MAC_CARBON */
3429 AEDisposeDesc (&result_desc
);
3432 AEDisposeDesc (&script_desc
);
3438 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3439 doc
: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
3440 If compilation and execution are successful, the resulting script
3441 value is returned as a string. Otherwise the function aborts and
3442 displays the error message returned by the AppleScript scripting
3447 char *result
, *temp
;
3448 Lisp_Object lisp_result
;
3451 CHECK_STRING (script
);
3454 status
= do_applescript (SDATA (script
), &result
);
3459 error ("AppleScript error %d", status
);
3462 /* Unfortunately only OSADoScript in do_applescript knows how
3463 how large the resulting script value or error message is
3464 going to be and therefore as caller memory must be
3465 deallocated here. It is necessary to free the error
3466 message before calling error to avoid a memory leak. */
3467 temp
= (char *) alloca (strlen (result
) + 1);
3468 strcpy (temp
, result
);
3475 lisp_result
= build_string (result
);
3482 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3483 Smac_file_name_to_posix
, 1, 1, 0,
3484 doc
: /* Convert Macintosh filename to Posix form. */)
3486 Lisp_Object mac_filename
;
3488 char posix_filename
[MAXPATHLEN
+1];
3490 CHECK_STRING (mac_filename
);
3492 if (mac_to_posix_pathname (SDATA (mac_filename
), posix_filename
,
3494 return build_string (posix_filename
);
3500 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3501 Sposix_file_name_to_mac
, 1, 1, 0,
3502 doc
: /* Convert Posix filename to Mac form. */)
3504 Lisp_Object posix_filename
;
3506 char mac_filename
[MAXPATHLEN
+1];
3508 CHECK_STRING (posix_filename
);
3510 if (posix_to_mac_pathname (SDATA (posix_filename
), mac_filename
,
3512 return build_string (mac_filename
);
3518 /* set interprogram-paste-function to mac-paste-function in mac-win.el
3519 to enable Emacs to obtain the contents of the Mac clipboard. */
3520 DEFUN ("mac-paste-function", Fmac_paste_function
, Smac_paste_function
, 0, 0, 0,
3521 doc
: /* Return the contents of the Mac clipboard as a string. */)
3524 #if TARGET_API_MAC_CARBON
3527 ScrapFlavorFlags sff
;
3533 err
= GetCurrentScrap (&scrap
);
3535 err
= GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
);
3537 err
= GetScrapFlavorSize (scrap
, kScrapFlavorTypeText
, &s
);
3538 if (err
== noErr
&& (data
= (char*) alloca (s
)))
3539 err
= GetScrapFlavorData (scrap
, kScrapFlavorTypeText
, &s
, data
);
3541 if (err
!= noErr
|| s
== 0)
3544 /* Emacs expects clipboard contents have Unix-style eol's */
3545 for (i
= 0; i
< s
; i
++)
3546 if (data
[i
] == '\r')
3549 return make_string (data
, s
);
3550 #else /* not TARGET_API_MAC_CARBON */
3553 long scrap_offset
, rc
, i
;
3555 my_handle
= NewHandle (0); /* allocate 0-length data area */
3557 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3563 /* Emacs expects clipboard contents have Unix-style eol's */
3564 for (i
= 0; i
< rc
; i
++)
3565 if ((*my_handle
)[i
] == '\r')
3566 (*my_handle
)[i
] = '\n';
3568 value
= make_string (*my_handle
, rc
);
3570 HUnlock (my_handle
);
3572 DisposeHandle (my_handle
);
3575 #endif /* not TARGET_API_MAC_CARBON */
3579 /* set interprogram-cut-function to mac-cut-function in mac-win.el
3580 to enable Emacs to write the top of the kill-ring to the Mac clipboard. */
3581 DEFUN ("mac-cut-function", Fmac_cut_function
, Smac_cut_function
, 1, 2, 0,
3582 doc
: /* Put the value of the string parameter to the Mac clipboard. */)
3584 Lisp_Object value
, push
;
3589 /* fixme: ignore the push flag for now */
3591 CHECK_STRING (value
);
3593 len
= SCHARS (value
);
3594 buf
= (char *) alloca (len
+1);
3595 bcopy (SDATA (value
), buf
, len
);
3598 /* convert to Mac-style eol's before sending to clipboard */
3599 for (i
= 0; i
< len
; i
++)
3603 #if TARGET_API_MAC_CARBON
3608 ClearCurrentScrap ();
3609 if (GetCurrentScrap (&scrap
) != noErr
)
3612 error ("cannot get current scrap");
3615 if (PutScrapFlavor (scrap
, kScrapFlavorTypeText
, kScrapFlavorMaskNone
, len
,
3619 error ("cannot put to scrap");
3623 #else /* not TARGET_API_MAC_CARBON */
3625 PutScrap (len
, 'TEXT', buf
);
3626 #endif /* not TARGET_API_MAC_CARBON */
3632 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
3634 doc
: /* Whether there is an owner for the given X Selection.
3635 The arg should be the name of the selection in question, typically one of
3636 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
3637 \(Those are literal upper-case symbol names, since that's what X expects.)
3638 For convenience, the symbol nil is the same as `PRIMARY',
3639 and t is the same as `SECONDARY'. */)
3641 Lisp_Object selection
;
3643 CHECK_SYMBOL (selection
);
3645 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
3646 if the clipboard currently has valid text format contents. */
3648 if (EQ (selection
, QCLIPBOARD
))
3650 Lisp_Object val
= Qnil
;
3652 #if TARGET_API_MAC_CARBON
3654 ScrapFlavorFlags sff
;
3657 if (GetCurrentScrap (&scrap
) == noErr
)
3658 if (GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
) == noErr
)
3661 #else /* not TARGET_API_MAC_CARBON */
3663 long rc
, scrap_offset
;
3665 my_handle
= NewHandle (0);
3667 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3671 DisposeHandle (my_handle
);
3672 #endif /* not TARGET_API_MAC_CARBON */
3679 #if TARGET_API_MAC_CARBON
3680 static Lisp_Object Qxml
;
3682 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3683 doc
: /* Return the application preference value for KEY.
3684 KEY is either a string specifying a preference key, or a list of key
3685 strings. If it is a list, the (i+1)-th element is used as a key for
3686 the CFDictionary value obtained by the i-th element. If lookup is
3687 failed at some stage, nil is returned.
3689 Optional arg APPLICATION is an application ID string. If omitted or
3690 nil, that stands for the current application.
3692 Optional arg FORMAT specifies the data format of the return value. If
3693 omitted or nil, each Core Foundation object is converted into a
3694 corresponding Lisp object as follows:
3696 Core Foundation Lisp Tag
3697 ------------------------------------------------------------
3698 CFString Multibyte string string
3699 CFNumber Integer or float number
3700 CFBoolean Symbol (t or nil) boolean
3701 CFDate List of three integers date
3702 (cf. `current-time')
3703 CFData Unibyte string data
3704 CFArray Vector array
3705 CFDictionary Alist or hash table dictionary
3706 (depending on HASH-BOUND)
3708 If it is t, a symbol that represents the type of the original Core
3709 Foundation object is prepended. If it is `xml', the value is returned
3710 as an XML representation.
3712 Optional arg HASH-BOUND specifies which kinds of the list objects,
3713 alists or hash tables, are used as the targets of the conversion from
3714 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3715 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3716 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3718 (key
, application
, format
, hash_bound
)
3719 Lisp_Object key
, application
, format
, hash_bound
;
3721 CFStringRef app_id
, key_str
;
3722 CFPropertyListRef app_plist
= NULL
, plist
;
3723 Lisp_Object result
= Qnil
, tmp
;
3726 key
= Fcons (key
, Qnil
);
3730 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3731 CHECK_STRING_CAR (tmp
);
3733 wrong_type_argument (Qlistp
, key
);
3735 if (!NILP (application
))
3736 CHECK_STRING (application
);
3737 CHECK_SYMBOL (format
);
3738 if (!NILP (hash_bound
))
3739 CHECK_NUMBER (hash_bound
);
3743 app_id
= kCFPreferencesCurrentApplication
;
3744 if (!NILP (application
))
3746 app_id
= cfstring_create_with_string (application
);
3750 key_str
= cfstring_create_with_string (XCAR (key
));
3751 if (key_str
== NULL
)
3753 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3754 CFRelease (key_str
);
3755 if (app_plist
== NULL
)
3759 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3761 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3763 key_str
= cfstring_create_with_string (XCAR (key
));
3764 if (key_str
== NULL
)
3766 plist
= CFDictionaryGetValue (plist
, key_str
);
3767 CFRelease (key_str
);
3773 if (EQ (format
, Qxml
))
3775 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3778 result
= cfdata_to_lisp (data
);
3783 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3784 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3788 CFRelease (app_plist
);
3795 #endif /* TARGET_API_MAC_CARBON */
3798 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
3799 doc
: /* Clear the font name table. */)
3803 mac_clear_font_name_table ();
3810 extern int inhibit_window_system
;
3811 extern int noninteractive
;
3813 /* Unlike in X11, window events in Carbon do not come from sockets.
3814 So we cannot simply use `select' to monitor two kinds of inputs:
3815 window events and process outputs. We emulate such functionality
3816 by regarding fd 0 as the window event channel and simultaneously
3817 monitoring both kinds of input channels. It is implemented by
3818 dividing into some cases:
3819 1. The window event channel is not involved.
3821 2. Sockets are not involved.
3822 -> Use ReceiveNextEvent.
3823 3. [If SELECT_USE_CFSOCKET is defined]
3824 Only the window event channel and socket read channels are
3825 involved, and timeout is not too short (greater than
3826 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
3827 -> Create CFSocket for each socket and add it into the current
3828 event RunLoop so that an `ready-to-read' event can be posted
3829 to the event queue that is also used for window events. Then
3830 ReceiveNextEvent can wait for both kinds of inputs.
3832 -> Periodically poll the window input channel while repeatedly
3833 executing `select' with a short timeout
3834 (SELECT_POLLING_PERIOD_USEC microseconds). */
3836 #define SELECT_POLLING_PERIOD_USEC 20000
3837 #ifdef SELECT_USE_CFSOCKET
3838 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
3839 #define EVENT_CLASS_SOCK 'Sock'
3842 socket_callback (s
, type
, address
, data
, info
)
3844 CFSocketCallBackType type
;
3851 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
3852 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
3853 ReleaseEvent (event
);
3855 #endif /* SELECT_USE_CFSOCKET */
3858 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
3863 struct timeval
*timeout
;
3868 r
= select (n
, rfds
, wfds
, efds
, timeout
);
3872 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
3873 kEventLeaveInQueue
, NULL
);
3884 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
3885 #undef SELECT_INVALIDATE_CFSOCKET
3889 sys_select (n
, rfds
, wfds
, efds
, timeout
)
3894 struct timeval
*timeout
;
3898 EMACS_TIME select_timeout
;
3900 if (inhibit_window_system
|| noninteractive
3901 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
3902 return select (n
, rfds
, wfds
, efds
, timeout
);
3906 if (wfds
== NULL
&& efds
== NULL
)
3909 SELECT_TYPE orfds
= *rfds
;
3911 EventTimeout timeout_sec
=
3913 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
3914 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
3915 : kEventDurationForever
);
3917 for (i
= 1; i
< n
; i
++)
3918 if (FD_ISSET (i
, rfds
))
3924 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
3925 kEventLeaveInQueue
, NULL
);
3936 /* Avoid initial overhead of RunLoop setup for the case that
3937 some input is already available. */
3938 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
3939 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
3940 if (r
!= 0 || timeout_sec
== 0.0)
3945 #ifdef SELECT_USE_CFSOCKET
3946 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
3947 goto poll_periodically
;
3950 CFRunLoopRef runloop
=
3951 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
3952 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
3953 #ifdef SELECT_INVALIDATE_CFSOCKET
3954 CFSocketRef
*shead
, *s
;
3956 CFRunLoopSourceRef
*shead
, *s
;
3961 #ifdef SELECT_INVALIDATE_CFSOCKET
3962 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
3964 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
3967 for (i
= 1; i
< n
; i
++)
3968 if (FD_ISSET (i
, rfds
))
3970 CFSocketRef socket
=
3971 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
3972 socket_callback
, NULL
);
3973 CFRunLoopSourceRef source
=
3974 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
3976 #ifdef SELECT_INVALIDATE_CFSOCKET
3977 CFSocketSetSocketFlags (socket
, 0);
3979 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
3980 #ifdef SELECT_INVALIDATE_CFSOCKET
3990 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
3995 #ifdef SELECT_INVALIDATE_CFSOCKET
3996 CFSocketInvalidate (*s
);
3998 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
4013 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
4014 GetEventTypeCount (specs
),
4016 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
4017 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4024 #endif /* SELECT_USE_CFSOCKET */
4029 EMACS_TIME end_time
, now
, remaining_time
;
4030 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
4038 remaining_time
= *timeout
;
4039 EMACS_GET_TIME (now
);
4040 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4045 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4046 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4047 select_timeout
= remaining_time
;
4048 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4060 EMACS_GET_TIME (now
);
4061 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4064 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4075 /* Set up environment variables so that Emacs can correctly find its
4076 support files when packaged as an application bundle. Directories
4077 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4078 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4079 by `make install' by default can instead be placed in
4080 .../Emacs.app/Contents/Resources/ and
4081 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4082 is changed only if it is not already set. Presumably if the user
4083 sets an environment variable, he will want to use files in his path
4084 instead of ones in the application bundle. */
4086 init_mac_osx_environment ()
4090 CFStringRef cf_app_bundle_pathname
;
4091 int app_bundle_pathname_len
;
4092 char *app_bundle_pathname
;
4096 /* Fetch the pathname of the application bundle as a C string into
4097 app_bundle_pathname. */
4099 bundle
= CFBundleGetMainBundle ();
4103 bundleURL
= CFBundleCopyBundleURL (bundle
);
4107 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4108 kCFURLPOSIXPathStyle
);
4109 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4110 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4112 if (!CFStringGetCString (cf_app_bundle_pathname
,
4113 app_bundle_pathname
,
4114 app_bundle_pathname_len
+ 1,
4115 kCFStringEncodingISOLatin1
))
4117 CFRelease (cf_app_bundle_pathname
);
4121 CFRelease (cf_app_bundle_pathname
);
4123 /* P should have sufficient room for the pathname of the bundle plus
4124 the subpath in it leading to the respective directories. Q
4125 should have three times that much room because EMACSLOADPATH can
4126 have the value "<path to lisp dir>:<path to leim dir>:<path to
4128 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4129 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4130 if (!getenv ("EMACSLOADPATH"))
4134 strcpy (p
, app_bundle_pathname
);
4135 strcat (p
, "/Contents/Resources/lisp");
4136 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4139 strcpy (p
, app_bundle_pathname
);
4140 strcat (p
, "/Contents/Resources/leim");
4141 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4148 strcpy (p
, app_bundle_pathname
);
4149 strcat (p
, "/Contents/Resources/site-lisp");
4150 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4158 setenv ("EMACSLOADPATH", q
, 1);
4161 if (!getenv ("EMACSPATH"))
4165 strcpy (p
, app_bundle_pathname
);
4166 strcat (p
, "/Contents/MacOS/libexec");
4167 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4170 strcpy (p
, app_bundle_pathname
);
4171 strcat (p
, "/Contents/MacOS/bin");
4172 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4180 setenv ("EMACSPATH", q
, 1);
4183 if (!getenv ("EMACSDATA"))
4185 strcpy (p
, app_bundle_pathname
);
4186 strcat (p
, "/Contents/Resources/etc");
4187 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4188 setenv ("EMACSDATA", p
, 1);
4191 if (!getenv ("EMACSDOC"))
4193 strcpy (p
, app_bundle_pathname
);
4194 strcat (p
, "/Contents/Resources/etc");
4195 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4196 setenv ("EMACSDOC", p
, 1);
4199 if (!getenv ("INFOPATH"))
4201 strcpy (p
, app_bundle_pathname
);
4202 strcat (p
, "/Contents/Resources/info");
4203 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4204 setenv ("INFOPATH", p
, 1);
4207 #endif /* MAC_OSX */
4211 mac_get_system_locale ()
4219 lang
= GetScriptVariable (smSystemScript
, smScriptLang
);
4220 region
= GetScriptManagerVariable (smRegionCode
);
4221 err
= LocaleRefFromLangOrRegionCode (lang
, region
, &locale
);
4223 err
= LocaleRefGetPartString (locale
, kLocaleAllPartsMask
,
4226 return build_string (str
);
4235 QCLIPBOARD
= intern ("CLIPBOARD");
4236 staticpro (&QCLIPBOARD
);
4238 #if TARGET_API_MAC_CARBON
4239 Qstring
= intern ("string"); staticpro (&Qstring
);
4240 Qnumber
= intern ("number"); staticpro (&Qnumber
);
4241 Qboolean
= intern ("boolean"); staticpro (&Qboolean
);
4242 Qdate
= intern ("date"); staticpro (&Qdate
);
4243 Qdata
= intern ("data"); staticpro (&Qdata
);
4244 Qarray
= intern ("array"); staticpro (&Qarray
);
4245 Qdictionary
= intern ("dictionary"); staticpro (&Qdictionary
);
4247 Qxml
= intern ("xml");
4251 defsubr (&Smac_paste_function
);
4252 defsubr (&Smac_cut_function
);
4253 defsubr (&Sx_selection_exists_p
);
4254 #if TARGET_API_MAC_CARBON
4255 defsubr (&Smac_get_preference
);
4257 defsubr (&Smac_clear_font_name_table
);
4259 defsubr (&Sdo_applescript
);
4260 defsubr (&Smac_file_name_to_posix
);
4261 defsubr (&Sposix_file_name_to_mac
);
4263 DEFVAR_INT ("mac-system-script-code", &mac_system_script_code
,
4264 doc
: /* The system script code. */);
4265 mac_system_script_code
= (ScriptCode
) GetScriptManagerVariable (smSysScript
);
4267 DEFVAR_LISP ("mac-system-locale", &Vmac_system_locale
,
4268 doc
: /* The system locale identifier string.
4269 This is not a POSIX locale ID, but an ICU locale ID. So encoding
4270 information is not included. */);
4271 Vmac_system_locale
= mac_get_system_locale ();
4274 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4275 (do not change this comment) */