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. Each node has a node id, which is a unique
816 nonnegative integer, and the root node id is 0. A database is
817 implemented as a hash table that maps a pair (SRC-NODE-ID .
818 EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used
819 in the table as a value for HASHKEY_MAX_NID. A value associated to
820 a node is recorded as a value for the node id. */
822 #define HASHKEY_MAX_NID (make_number (0))
825 xrm_create_database ()
827 XrmDatabase database
;
829 database
= make_hash_table (Qequal
, make_number (DEFAULT_HASH_SIZE
),
830 make_float (DEFAULT_REHASH_SIZE
),
831 make_float (DEFAULT_REHASH_THRESHOLD
),
833 Fputhash (HASHKEY_MAX_NID
, make_number (0), database
);
839 xrm_q_put_resource (database
, quarks
, value
)
840 XrmDatabase database
;
841 Lisp_Object quarks
, value
;
843 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
846 Lisp_Object node_id
, key
;
848 max_nid
= XINT (Fgethash (HASHKEY_MAX_NID
, database
, Qnil
));
850 XSETINT (node_id
, 0);
851 for (; CONSP (quarks
); quarks
= XCDR (quarks
))
853 key
= Fcons (node_id
, XCAR (quarks
));
854 i
= hash_lookup (h
, key
, &hash_code
);
858 XSETINT (node_id
, max_nid
);
859 hash_put (h
, key
, node_id
, hash_code
);
862 node_id
= HASH_VALUE (h
, i
);
864 Fputhash (node_id
, value
, database
);
866 Fputhash (HASHKEY_MAX_NID
, make_number (max_nid
), database
);
869 /* Merge multiple resource entries specified by DATA into a resource
870 database DATABASE. DATA points to the head of a null-terminated
871 string consisting of multiple resource lines. It's like a
872 combination of XrmGetStringDatabase and XrmMergeDatabases. */
875 xrm_merge_string_database (database
, data
)
876 XrmDatabase database
;
879 Lisp_Object quarks_value
;
883 quarks_value
= parse_resource_line (&data
);
884 if (!NILP (quarks_value
))
885 xrm_q_put_resource (database
,
886 XCAR (quarks_value
), XCDR (quarks_value
));
891 xrm_q_get_resource_1 (database
, node_id
, quark_name
, quark_class
)
892 XrmDatabase database
;
893 Lisp_Object node_id
, quark_name
, quark_class
;
895 struct Lisp_Hash_Table
*h
= XHASH_TABLE (database
);
896 Lisp_Object key
, labels
[3], value
;
899 if (!CONSP (quark_name
))
900 return Fgethash (node_id
, database
, Qnil
);
902 /* First, try tight bindings */
903 labels
[0] = XCAR (quark_name
);
904 labels
[1] = XCAR (quark_class
);
905 labels
[2] = SINGLE_COMPONENT
;
907 key
= Fcons (node_id
, Qnil
);
908 for (k
= 0; k
< sizeof (labels
) / sizeof (*labels
); k
++)
910 XSETCDR (key
, labels
[k
]);
911 i
= hash_lookup (h
, key
, NULL
);
914 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
915 XCDR (quark_name
), XCDR (quark_class
));
921 /* Then, try loose bindings */
922 XSETCDR (key
, LOOSE_BINDING
);
923 i
= hash_lookup (h
, key
, NULL
);
926 value
= xrm_q_get_resource_1 (database
, HASH_VALUE (h
, i
),
927 quark_name
, quark_class
);
931 return xrm_q_get_resource_1 (database
, node_id
,
932 XCDR (quark_name
), XCDR (quark_class
));
939 xrm_q_get_resource (database
, quark_name
, quark_class
)
940 XrmDatabase database
;
941 Lisp_Object quark_name
, quark_class
;
943 return xrm_q_get_resource_1 (database
, make_number (0),
944 quark_name
, quark_class
);
947 /* Retrieve a resource value for the specified NAME and CLASS from the
948 resource database DATABASE. It corresponds to XrmGetResource. */
951 xrm_get_resource (database
, name
, class)
952 XrmDatabase database
;
955 Lisp_Object quark_name
, quark_class
, tmp
;
958 quark_name
= parse_resource_name (&name
);
961 for (tmp
= quark_name
, nn
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nn
++)
962 if (!STRINGP (XCAR (tmp
)))
965 quark_class
= parse_resource_name (&class);
968 for (tmp
= quark_class
, nc
= 0; CONSP (tmp
); tmp
= XCDR (tmp
), nc
++)
969 if (!STRINGP (XCAR (tmp
)))
975 return xrm_q_get_resource (database
, quark_name
, quark_class
);
978 #if TARGET_API_MAC_CARBON
980 xrm_cfproperty_list_to_value (plist
)
981 CFPropertyListRef plist
;
983 CFTypeID type_id
= CFGetTypeID (plist
);
985 if (type_id
== CFStringGetTypeID ())
986 return cfstring_to_lisp (plist
);
987 else if (type_id
== CFNumberGetTypeID ())
990 Lisp_Object result
= Qnil
;
992 string
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@"), plist
);
995 result
= cfstring_to_lisp (string
);
1000 else if (type_id
== CFBooleanGetTypeID ())
1001 return build_string (CFBooleanGetValue (plist
) ? "true" : "false");
1002 else if (type_id
== CFDataGetTypeID ())
1003 return cfdata_to_lisp (plist
);
1009 /* Create a new resource database from the preferences for the
1010 application APPLICATION. APPLICATION is either a string that
1011 specifies an application ID, or NULL that represents the current
1015 xrm_get_preference_database (application
)
1018 #if TARGET_API_MAC_CARBON
1019 CFStringRef app_id
, *keys
, user_doms
[2], host_doms
[2];
1020 CFMutableSetRef key_set
= NULL
;
1021 CFArrayRef key_array
;
1022 CFIndex index
, count
;
1024 XrmDatabase database
;
1025 Lisp_Object quarks
= Qnil
, value
= Qnil
;
1026 CFPropertyListRef plist
;
1028 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1030 user_doms
[0] = kCFPreferencesCurrentUser
;
1031 user_doms
[1] = kCFPreferencesAnyUser
;
1032 host_doms
[0] = kCFPreferencesCurrentHost
;
1033 host_doms
[1] = kCFPreferencesAnyHost
;
1035 database
= xrm_create_database ();
1037 GCPRO3 (database
, quarks
, value
);
1041 app_id
= kCFPreferencesCurrentApplication
;
1044 app_id
= cfstring_create_with_utf8_cstring (application
);
1049 key_set
= CFSetCreateMutable (NULL
, 0, &kCFCopyStringSetCallBacks
);
1050 if (key_set
== NULL
)
1052 for (iu
= 0; iu
< sizeof (user_doms
) / sizeof (*user_doms
) ; iu
++)
1053 for (ih
= 0; ih
< sizeof (host_doms
) / sizeof (*host_doms
); ih
++)
1055 key_array
= CFPreferencesCopyKeyList (app_id
, user_doms
[iu
],
1059 count
= CFArrayGetCount (key_array
);
1060 for (index
= 0; index
< count
; index
++)
1061 CFSetAddValue (key_set
,
1062 CFArrayGetValueAtIndex (key_array
, index
));
1063 CFRelease (key_array
);
1067 count
= CFSetGetCount (key_set
);
1068 keys
= xmalloc (sizeof (CFStringRef
) * count
);
1071 CFSetGetValues (key_set
, (const void **)keys
);
1072 for (index
= 0; index
< count
; index
++)
1074 res_name
= SDATA (cfstring_to_lisp (keys
[index
]));
1075 quarks
= parse_resource_name (&res_name
);
1076 if (!(NILP (quarks
) || *res_name
))
1078 plist
= CFPreferencesCopyAppValue (keys
[index
], app_id
);
1079 value
= xrm_cfproperty_list_to_value (plist
);
1082 xrm_q_put_resource (database
, quarks
, value
);
1089 CFRelease (key_set
);
1098 return xrm_create_database ();
1105 /* The following functions with "sys_" prefix are stubs to Unix
1106 functions that have already been implemented by CW or MPW. The
1107 calls to them in Emacs source course are #define'd to call the sys_
1108 versions by the header files s-mac.h. In these stubs pathnames are
1109 converted between their Unix and Mac forms. */
1112 /* Unix epoch is Jan 1, 1970 while Mac epoch is Jan 1, 1904: 66 years
1113 + 17 leap days. These are for adjusting time values returned by
1114 MacOS Toolbox functions. */
1116 #define MAC_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1119 #if __MSL__ < 0x6000
1120 /* CW Pro 5 epoch is Jan 1, 1900 (aaarghhhhh!); remember, 1900 is not
1121 a leap year! This is for adjusting time_t values returned by MSL
1123 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 70 + 17) * 24 * 60 * 60)
1124 #else /* __MSL__ >= 0x6000 */
1125 /* CW changes Pro 6 to follow Unix! */
1126 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1127 #endif /* __MSL__ >= 0x6000 */
1129 /* MPW library functions follow Unix (confused?). */
1130 #define CW_OR_MPW_UNIX_EPOCH_DIFF ((365L * 66 + 17) * 24 * 60 * 60)
1131 #else /* not __MRC__ */
1133 #endif /* not __MRC__ */
1136 /* Define our own stat function for both MrC and CW. The reason for
1137 doing this: "stat" is both the name of a struct and function name:
1138 can't use the same trick like that for sys_open, sys_close, etc. to
1139 redirect Emacs's calls to our own version that converts Unix style
1140 filenames to Mac style filename because all sorts of compilation
1141 errors will be generated if stat is #define'd to be sys_stat. */
1144 stat_noalias (const char *path
, struct stat
*buf
)
1146 char mac_pathname
[MAXPATHLEN
+1];
1149 if (posix_to_mac_pathname (path
, mac_pathname
, MAXPATHLEN
+1) == 0)
1152 c2pstr (mac_pathname
);
1153 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1154 cipb
.hFileInfo
.ioVRefNum
= 0;
1155 cipb
.hFileInfo
.ioDirID
= 0;
1156 cipb
.hFileInfo
.ioFDirIndex
= 0;
1157 /* set to 0 to get information about specific dir or file */
1159 errno
= PBGetCatInfo (&cipb
, false);
1160 if (errno
== -43) /* -43: fnfErr defined in Errors.h */
1165 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1167 buf
->st_mode
= S_IFDIR
| S_IREAD
| S_IEXEC
;
1169 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1170 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1171 buf
->st_ino
= cipb
.dirInfo
.ioDrDirID
;
1172 buf
->st_dev
= cipb
.dirInfo
.ioVRefNum
;
1173 buf
->st_size
= cipb
.dirInfo
.ioDrNmFls
;
1174 /* size of dir = number of files and dirs */
1177 = cipb
.dirInfo
.ioDrMdDat
- MAC_UNIX_EPOCH_DIFF
;
1178 buf
->st_ctime
= cipb
.dirInfo
.ioDrCrDat
- MAC_UNIX_EPOCH_DIFF
;
1182 buf
->st_mode
= S_IFREG
| S_IREAD
;
1183 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x1))
1184 buf
->st_mode
|= S_IWRITE
; /* bit 1 = 1 for locked files/directories */
1185 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1186 buf
->st_mode
|= S_IEXEC
;
1187 buf
->st_ino
= cipb
.hFileInfo
.ioDirID
;
1188 buf
->st_dev
= cipb
.hFileInfo
.ioVRefNum
;
1189 buf
->st_size
= cipb
.hFileInfo
.ioFlLgLen
;
1192 = cipb
.hFileInfo
.ioFlMdDat
- MAC_UNIX_EPOCH_DIFF
;
1193 buf
->st_ctime
= cipb
.hFileInfo
.ioFlCrDat
- MAC_UNIX_EPOCH_DIFF
;
1196 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& 0x8000)
1198 /* identify alias files as symlinks */
1199 buf
->st_mode
&= ~S_IFREG
;
1200 buf
->st_mode
|= S_IFLNK
;
1204 buf
->st_uid
= getuid ();
1205 buf
->st_gid
= getgid ();
1213 lstat (const char *path
, struct stat
*buf
)
1216 char true_pathname
[MAXPATHLEN
+1];
1218 /* Try looking for the file without resolving aliases first. */
1219 if ((result
= stat_noalias (path
, buf
)) >= 0)
1222 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1225 return stat_noalias (true_pathname
, buf
);
1230 stat (const char *path
, struct stat
*sb
)
1233 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1236 if ((result
= stat_noalias (path
, sb
)) >= 0 &&
1237 ! (sb
->st_mode
& S_IFLNK
))
1240 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1243 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1246 fully_resolved_name
[len
] = '\0';
1247 /* in fact our readlink terminates strings */
1248 return lstat (fully_resolved_name
, sb
);
1251 return lstat (true_pathname
, sb
);
1256 /* CW defines fstat in stat.mac.c while MPW does not provide this
1257 function. Without the information of how to get from a file
1258 descriptor in MPW StdCLib to a Mac OS file spec, it should be hard
1259 to implement this function. Fortunately, there is only one place
1260 where this function is called in our configuration: in fileio.c,
1261 where only the st_dev and st_ino fields are used to determine
1262 whether two fildes point to different i-nodes to prevent copying
1263 a file onto itself equal. What we have here probably needs
1267 fstat (int fildes
, struct stat
*buf
)
1270 buf
->st_ino
= fildes
;
1271 buf
->st_mode
= S_IFREG
; /* added by T.I. for the copy-file */
1272 return 0; /* success */
1274 #endif /* __MRC__ */
1278 mkdir (const char *dirname
, int mode
)
1280 #pragma unused(mode)
1283 char true_pathname
[MAXPATHLEN
+1], mac_pathname
[MAXPATHLEN
+1];
1285 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
1288 if (posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1291 c2pstr (mac_pathname
);
1292 hfpb
.ioNamePtr
= mac_pathname
;
1293 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1294 hfpb
.ioDirID
= 0; /* parent is the root */
1296 errno
= PBDirCreate ((HParmBlkPtr
) &hfpb
, false);
1297 /* just return the Mac OSErr code for now */
1298 return errno
== noErr
? 0 : -1;
1303 sys_rmdir (const char *dirname
)
1306 char mac_pathname
[MAXPATHLEN
+1];
1308 if (posix_to_mac_pathname (dirname
, mac_pathname
, MAXPATHLEN
+1) == 0)
1311 c2pstr (mac_pathname
);
1312 hfpb
.ioNamePtr
= mac_pathname
;
1313 hfpb
.ioVRefNum
= 0; /* ignored unless name is invalid */
1314 hfpb
.ioDirID
= 0; /* parent is the root */
1316 errno
= PBHDelete ((HParmBlkPtr
) &hfpb
, false);
1317 return errno
== noErr
? 0 : -1;
1322 /* No implementation yet. */
1324 execvp (const char *path
, ...)
1328 #endif /* __MRC__ */
1332 utime (const char *path
, const struct utimbuf
*times
)
1334 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1336 char mac_pathname
[MAXPATHLEN
+1];
1339 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1342 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1344 fully_resolved_name
[len
] = '\0';
1346 strcpy (fully_resolved_name
, true_pathname
);
1348 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1351 c2pstr (mac_pathname
);
1352 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1353 cipb
.hFileInfo
.ioVRefNum
= 0;
1354 cipb
.hFileInfo
.ioDirID
= 0;
1355 cipb
.hFileInfo
.ioFDirIndex
= 0;
1356 /* set to 0 to get information about specific dir or file */
1358 errno
= PBGetCatInfo (&cipb
, false);
1362 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* bit 4 = 1 for directories */
1365 cipb
.dirInfo
.ioDrMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1367 GetDateTime (&cipb
.dirInfo
.ioDrMdDat
);
1372 cipb
.hFileInfo
.ioFlMdDat
= times
->modtime
+ MAC_UNIX_EPOCH_DIFF
;
1374 GetDateTime (&cipb
.hFileInfo
.ioFlMdDat
);
1377 errno
= PBSetCatInfo (&cipb
, false);
1378 return errno
== noErr
? 0 : -1;
1392 /* Like stat, but test for access mode in hfpb.ioFlAttrib */
1394 access (const char *path
, int mode
)
1396 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1398 char mac_pathname
[MAXPATHLEN
+1];
1401 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1404 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1406 fully_resolved_name
[len
] = '\0';
1408 strcpy (fully_resolved_name
, true_pathname
);
1410 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1413 c2pstr (mac_pathname
);
1414 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
1415 cipb
.hFileInfo
.ioVRefNum
= 0;
1416 cipb
.hFileInfo
.ioDirID
= 0;
1417 cipb
.hFileInfo
.ioFDirIndex
= 0;
1418 /* set to 0 to get information about specific dir or file */
1420 errno
= PBGetCatInfo (&cipb
, false);
1424 if (mode
== F_OK
) /* got this far, file exists */
1428 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* path refers to a directory */
1432 if (cipb
.hFileInfo
.ioFlFndrInfo
.fdType
== 'APPL')
1439 return (cipb
.hFileInfo
.ioFlAttrib
& 0x1) ? -1 : 0;
1440 /* don't allow if lock bit is on */
1446 #define DEV_NULL_FD 0x10000
1450 sys_open (const char *path
, int oflag
)
1452 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1454 char mac_pathname
[MAXPATHLEN
+1];
1456 if (strcmp (path
, "/dev/null") == 0)
1457 return DEV_NULL_FD
; /* some bogus fd to be ignored in write */
1459 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1462 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1464 fully_resolved_name
[len
] = '\0';
1466 strcpy (fully_resolved_name
, true_pathname
);
1468 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1473 int res
= open (mac_pathname
, oflag
);
1474 /* if (oflag == O_WRONLY || oflag == O_RDWR) */
1475 if (oflag
& O_CREAT
)
1476 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1478 #else /* not __MRC__ */
1479 return open (mac_pathname
, oflag
);
1480 #endif /* not __MRC__ */
1487 sys_creat (const char *path
, mode_t mode
)
1489 char true_pathname
[MAXPATHLEN
+1];
1491 char mac_pathname
[MAXPATHLEN
+1];
1493 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1496 if (!posix_to_mac_pathname (true_pathname
, mac_pathname
, MAXPATHLEN
+1))
1501 int result
= creat (mac_pathname
);
1502 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1504 #else /* not __MRC__ */
1505 return creat (mac_pathname
, mode
);
1506 #endif /* not __MRC__ */
1513 sys_unlink (const char *path
)
1515 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1517 char mac_pathname
[MAXPATHLEN
+1];
1519 if (find_true_pathname (path
, true_pathname
, MAXPATHLEN
+1) == -1)
1522 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1524 fully_resolved_name
[len
] = '\0';
1526 strcpy (fully_resolved_name
, true_pathname
);
1528 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1531 return unlink (mac_pathname
);
1537 sys_read (int fildes
, char *buf
, int count
)
1539 if (fildes
== 0) /* this should not be used for console input */
1542 #if __MSL__ >= 0x6000
1543 return _read (fildes
, buf
, count
);
1545 return read (fildes
, buf
, count
);
1552 sys_write (int fildes
, const char *buf
, int count
)
1554 if (fildes
== DEV_NULL_FD
)
1557 #if __MSL__ >= 0x6000
1558 return _write (fildes
, buf
, count
);
1560 return write (fildes
, buf
, count
);
1567 sys_rename (const char * old_name
, const char * new_name
)
1569 char true_old_pathname
[MAXPATHLEN
+1], true_new_pathname
[MAXPATHLEN
+1];
1570 char fully_resolved_old_name
[MAXPATHLEN
+1];
1572 char mac_old_name
[MAXPATHLEN
+1], mac_new_name
[MAXPATHLEN
+1];
1574 if (find_true_pathname (old_name
, true_old_pathname
, MAXPATHLEN
+1) == -1)
1577 len
= readlink (true_old_pathname
, fully_resolved_old_name
, MAXPATHLEN
);
1579 fully_resolved_old_name
[len
] = '\0';
1581 strcpy (fully_resolved_old_name
, true_old_pathname
);
1583 if (find_true_pathname (new_name
, true_new_pathname
, MAXPATHLEN
+1) == -1)
1586 if (strcmp (fully_resolved_old_name
, true_new_pathname
) == 0)
1589 if (!posix_to_mac_pathname (fully_resolved_old_name
,
1594 if (!posix_to_mac_pathname(true_new_pathname
, mac_new_name
, MAXPATHLEN
+1))
1597 /* If a file with new_name already exists, rename deletes the old
1598 file in Unix. CW version fails in these situation. So we add a
1599 call to unlink here. */
1600 (void) unlink (mac_new_name
);
1602 return rename (mac_old_name
, mac_new_name
);
1607 extern FILE *fopen (const char *name
, const char *mode
);
1609 sys_fopen (const char *name
, const char *mode
)
1611 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
1613 char mac_pathname
[MAXPATHLEN
+1];
1615 if (find_true_pathname (name
, true_pathname
, MAXPATHLEN
+1) == -1)
1618 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
1620 fully_resolved_name
[len
] = '\0';
1622 strcpy (fully_resolved_name
, true_pathname
);
1624 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
1629 if (mode
[0] == 'w' || mode
[0] == 'a')
1630 fsetfileinfo (mac_pathname
, 'EMAx', 'TEXT');
1631 #endif /* not __MRC__ */
1632 return fopen (mac_pathname
, mode
);
1637 long target_ticks
= 0;
1640 __sigfun alarm_signal_func
= (__sigfun
) 0;
1642 __signal_func_ptr alarm_signal_func
= (__signal_func_ptr
) 0;
1643 #else /* not __MRC__ and not __MWERKS__ */
1645 #endif /* not __MRC__ and not __MWERKS__ */
1648 /* These functions simulate SIG_ALRM. The stub for function signal
1649 stores the signal handler function in alarm_signal_func if a
1650 SIG_ALRM is encountered. check_alarm is called in XTread_socket,
1651 which emacs calls periodically. A pending alarm is represented by
1652 a non-zero target_ticks value. check_alarm calls the handler
1653 function pointed to by alarm_signal_func if one has been set up and
1654 an alarm is pending. */
1659 if (target_ticks
&& TickCount () > target_ticks
)
1662 if (alarm_signal_func
)
1663 (*alarm_signal_func
)(SIGALRM
);
1668 extern Boolean
mac_wait_next_event (EventRecord
*, UInt32
, Boolean
);
1671 select (n
, rfds
, wfds
, efds
, timeout
)
1676 struct timeval
*timeout
;
1678 #if TARGET_API_MAC_CARBON
1680 EventTimeout timeout_sec
=
1682 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
1683 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
1684 : kEventDurationForever
);
1686 if (FD_ISSET (0, rfds
))
1689 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
1697 #else /* not TARGET_API_MAC_CARBON */
1699 UInt32 sleep_time
= EMACS_SECS (*timeout
) * 60 +
1700 ((EMACS_USECS (*timeout
) * 60) / 1000000);
1702 /* Can only handle wait for keyboard input. */
1703 if (n
> 1 || wfds
|| efds
)
1706 /* Also return true if an event other than a keyDown has occurred.
1707 This causes kbd_buffer_get_event in keyboard.c to call
1708 read_avail_input which in turn calls XTread_socket to poll for
1709 these events. Otherwise these never get processed except but a
1710 very slow poll timer. */
1711 if (FD_ISSET (0, rfds
) && mac_wait_next_event (&e
, sleep_time
, false))
1715 #endif /* not TARGET_API_MAC_CARBON */
1719 /* Called in sys_select to wait for an alarm signal to arrive. */
1727 if (!target_ticks
) /* no alarm pending */
1730 if ((tick
= TickCount ()) < target_ticks
)
1731 WaitNextEvent (0, &e
, target_ticks
- tick
, NULL
); /* Accept no event;
1732 just wait. by T.I. */
1735 if (alarm_signal_func
)
1736 (*alarm_signal_func
)(SIGALRM
);
1745 long remaining
= target_ticks
? (TickCount () - target_ticks
) / 60 : 0;
1747 target_ticks
= seconds
? TickCount () + 60 * seconds
: 0;
1749 return (remaining
< 0) ? 0 : (unsigned int) remaining
;
1755 extern __sigfun
signal (int signal
, __sigfun signal_func
);
1757 sys_signal (int signal_num
, __sigfun signal_func
)
1759 extern __signal_func_ptr
signal (int signal
, __signal_func_ptr signal_func
);
1761 sys_signal (int signal_num
, __signal_func_ptr signal_func
)
1762 #else /* not __MRC__ and not __MWERKS__ */
1764 #endif /* not __MRC__ and not __MWERKS__ */
1766 if (signal_num
!= SIGALRM
)
1767 return signal (signal_num
, signal_func
);
1771 __sigfun old_signal_func
;
1773 __signal_func_ptr old_signal_func
;
1777 old_signal_func
= alarm_signal_func
;
1778 alarm_signal_func
= signal_func
;
1779 return old_signal_func
;
1784 /* gettimeofday should return the amount of time (in a timeval
1785 structure) since midnight today. The toolbox function Microseconds
1786 returns the number of microseconds (in a UnsignedWide value) since
1787 the machine was booted. Also making this complicated is WideAdd,
1788 WideSubtract, etc. take wide values. */
1795 static wide wall_clock_at_epoch
, clicks_at_epoch
;
1796 UnsignedWide uw_microseconds
;
1797 wide w_microseconds
;
1798 time_t sys_time (time_t *);
1800 /* If this function is called for the first time, record the number
1801 of seconds since midnight and the number of microseconds since
1802 boot at the time of this first call. */
1807 systime
= sys_time (NULL
);
1808 /* Store microseconds since midnight in wall_clock_at_epoch. */
1809 WideMultiply (systime
, 1000000L, &wall_clock_at_epoch
);
1810 Microseconds (&uw_microseconds
);
1811 /* Store microseconds since boot in clicks_at_epoch. */
1812 clicks_at_epoch
.hi
= uw_microseconds
.hi
;
1813 clicks_at_epoch
.lo
= uw_microseconds
.lo
;
1816 /* Get time since boot */
1817 Microseconds (&uw_microseconds
);
1819 /* Convert to time since midnight*/
1820 w_microseconds
.hi
= uw_microseconds
.hi
;
1821 w_microseconds
.lo
= uw_microseconds
.lo
;
1822 WideSubtract (&w_microseconds
, &clicks_at_epoch
);
1823 WideAdd (&w_microseconds
, &wall_clock_at_epoch
);
1824 tp
->tv_sec
= WideDivide (&w_microseconds
, 1000000L, &tp
->tv_usec
);
1832 sleep (unsigned int seconds
)
1834 unsigned long time_up
;
1837 time_up
= TickCount () + seconds
* 60;
1838 while (TickCount () < time_up
)
1840 /* Accept no event; just wait. by T.I. */
1841 WaitNextEvent (0, &e
, 30, NULL
);
1846 #endif /* __MRC__ */
1849 /* The time functions adjust time values according to the difference
1850 between the Unix and CW epoches. */
1853 extern struct tm
*gmtime (const time_t *);
1855 sys_gmtime (const time_t *timer
)
1857 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1859 return gmtime (&unix_time
);
1864 extern struct tm
*localtime (const time_t *);
1866 sys_localtime (const time_t *timer
)
1868 #if __MSL__ >= 0x6000
1869 time_t unix_time
= *timer
;
1871 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1874 return localtime (&unix_time
);
1879 extern char *ctime (const time_t *);
1881 sys_ctime (const time_t *timer
)
1883 #if __MSL__ >= 0x6000
1884 time_t unix_time
= *timer
;
1886 time_t unix_time
= *timer
+ CW_OR_MPW_UNIX_EPOCH_DIFF
;
1889 return ctime (&unix_time
);
1894 extern time_t time (time_t *);
1896 sys_time (time_t *timer
)
1898 #if __MSL__ >= 0x6000
1899 time_t mac_time
= time (NULL
);
1901 time_t mac_time
= time (NULL
) - CW_OR_MPW_UNIX_EPOCH_DIFF
;
1911 /* MPW strftime broken for "%p" format */
1916 sys_strftime (char * s
, size_t maxsize
, const char * format
,
1917 const struct tm
* timeptr
)
1919 if (strcmp (format
, "%p") == 0)
1923 if (timeptr
->tm_hour
< 12)
1935 return strftime (s
, maxsize
, format
, timeptr
);
1937 #endif /* __MRC__ */
1940 /* no subprocesses, empty wait */
1950 croak (char *badfunc
)
1952 printf ("%s not yet implemented\r\n", badfunc
);
1958 index (const char * str
, int chr
)
1960 return strchr (str
, chr
);
1965 mktemp (char *template)
1970 len
= strlen (template);
1972 while (k
>= 0 && template[k
] == 'X')
1975 k
++; /* make k index of first 'X' */
1979 /* Zero filled, number of digits equal to the number of X's. */
1980 sprintf (&template[k
], "%0*d", len
-k
, seqnum
++);
1989 /* Emulate getpwuid, getpwnam and others. */
1991 #define PASSWD_FIELD_SIZE 256
1993 static char my_passwd_name
[PASSWD_FIELD_SIZE
];
1994 static char my_passwd_dir
[MAXPATHLEN
+1];
1996 static struct passwd my_passwd
=
2002 static struct group my_group
=
2004 /* There are no groups on the mac, so we just return "root" as the
2010 /* Initialized by main () in macterm.c to pathname of emacs directory. */
2012 char emacs_passwd_dir
[MAXPATHLEN
+1];
2018 init_emacs_passwd_dir ()
2022 if (getwd (emacs_passwd_dir
) && getwd (my_passwd_dir
))
2024 /* Need pathname of first ancestor that begins with "emacs"
2025 since Mac emacs application is somewhere in the emacs-*
2027 int len
= strlen (emacs_passwd_dir
);
2029 /* j points to the "/" following the directory name being
2032 while (i
>= 0 && !found
)
2034 while (i
>= 0 && emacs_passwd_dir
[i
] != '/')
2036 if (emacs_passwd_dir
[i
] == '/' && i
+5 < len
)
2037 found
= (strncmp (&(emacs_passwd_dir
[i
+1]), "emacs", 5) == 0);
2039 emacs_passwd_dir
[j
+1] = '\0';
2050 /* Setting to "/" probably won't work but set it to something
2052 strcpy (emacs_passwd_dir
, "/");
2053 strcpy (my_passwd_dir
, "/");
2058 static struct passwd emacs_passwd
=
2064 static int my_passwd_inited
= 0;
2072 /* Note: my_passwd_dir initialized in int_emacs_passwd_dir to
2073 directory where Emacs was started. */
2075 owner_name
= (char **) GetResource ('STR ',-16096);
2079 BlockMove ((unsigned char *) *owner_name
,
2080 (unsigned char *) my_passwd_name
,
2082 HUnlock (owner_name
);
2083 p2cstr ((unsigned char *) my_passwd_name
);
2086 my_passwd_name
[0] = 0;
2091 getpwuid (uid_t uid
)
2093 if (!my_passwd_inited
)
2096 my_passwd_inited
= 1;
2104 getgrgid (gid_t gid
)
2111 getpwnam (const char *name
)
2113 if (strcmp (name
, "emacs") == 0)
2114 return &emacs_passwd
;
2116 if (!my_passwd_inited
)
2119 my_passwd_inited
= 1;
2126 /* The functions fork, kill, sigsetmask, sigblock, request_sigio,
2127 setpgrp, setpriority, and unrequest_sigio are defined to be empty
2148 error ("Can't spawn subshell");
2167 request_sigio (void)
2173 unrequest_sigio (void)
2188 pipe (int _fildes
[2])
2195 /* Hard and symbolic links. */
2198 symlink (const char *name1
, const char *name2
)
2206 link (const char *name1
, const char *name2
)
2212 #endif /* ! MAC_OSX */
2214 /* Determine the path name of the file specified by VREFNUM, DIRID,
2215 and NAME and place that in the buffer PATH of length
2218 path_from_vol_dir_name (char *path
, int man_path_len
, short vol_ref_num
,
2219 long dir_id
, ConstStr255Param name
)
2225 if (strlen (name
) > man_path_len
)
2228 memcpy (dir_name
, name
, name
[0]+1);
2229 memcpy (path
, name
, name
[0]+1);
2232 cipb
.dirInfo
.ioDrParID
= dir_id
;
2233 cipb
.dirInfo
.ioNamePtr
= dir_name
;
2237 cipb
.dirInfo
.ioVRefNum
= vol_ref_num
;
2238 cipb
.dirInfo
.ioFDirIndex
= -1;
2239 cipb
.dirInfo
.ioDrDirID
= cipb
.dirInfo
.ioDrParID
;
2240 /* go up to parent each time */
2242 err
= PBGetCatInfo (&cipb
, false);
2247 if (strlen (dir_name
) + strlen (path
) + 1 >= man_path_len
)
2250 strcat (dir_name
, ":");
2251 strcat (dir_name
, path
);
2252 /* attach to front since we're going up directory tree */
2253 strcpy (path
, dir_name
);
2255 while (cipb
.dirInfo
.ioDrDirID
!= fsRtDirID
);
2256 /* stop when we see the volume's root directory */
2258 return 1; /* success */
2263 posix_pathname_to_fsspec (ufn
, fs
)
2267 Str255 mac_pathname
;
2269 if (posix_to_mac_pathname (ufn
, mac_pathname
, sizeof (mac_pathname
)) == 0)
2273 c2pstr (mac_pathname
);
2274 return FSMakeFSSpec (0, 0, mac_pathname
, fs
);
2279 fsspec_to_posix_pathname (fs
, ufn
, ufnbuflen
)
2284 char mac_pathname
[MAXPATHLEN
];
2286 if (path_from_vol_dir_name (mac_pathname
, sizeof (mac_pathname
) - 1,
2287 fs
->vRefNum
, fs
->parID
, fs
->name
)
2288 && mac_to_posix_pathname (mac_pathname
, ufn
, ufnbuflen
))
2297 readlink (const char *path
, char *buf
, int bufsiz
)
2299 char mac_sym_link_name
[MAXPATHLEN
+1];
2302 Boolean target_is_folder
, was_aliased
;
2303 Str255 directory_name
, mac_pathname
;
2306 if (posix_to_mac_pathname (path
, mac_sym_link_name
, MAXPATHLEN
+1) == 0)
2309 c2pstr (mac_sym_link_name
);
2310 err
= FSMakeFSSpec (0, 0, mac_sym_link_name
, &fsspec
);
2317 err
= ResolveAliasFile (&fsspec
, true, &target_is_folder
, &was_aliased
);
2318 if (err
!= noErr
|| !was_aliased
)
2324 if (path_from_vol_dir_name (mac_pathname
, 255, fsspec
.vRefNum
, fsspec
.parID
,
2331 if (mac_to_posix_pathname (mac_pathname
, buf
, bufsiz
) == 0)
2337 return strlen (buf
);
2341 /* Convert a path to one with aliases fully expanded. */
2344 find_true_pathname (const char *path
, char *buf
, int bufsiz
)
2346 char *q
, temp
[MAXPATHLEN
+1];
2350 if (bufsiz
<= 0 || path
== 0 || path
[0] == '\0')
2357 q
= strchr (p
+ 1, '/');
2359 q
= strchr (p
, '/');
2360 len
= 0; /* loop may not be entered, e.g., for "/" */
2365 strncat (temp
, p
, q
- p
);
2366 len
= readlink (temp
, buf
, bufsiz
);
2369 if (strlen (temp
) + 1 > bufsiz
)
2379 if (len
+ strlen (p
) + 1 >= bufsiz
)
2383 return len
+ strlen (p
);
2388 umask (mode_t numask
)
2390 static mode_t mask
= 022;
2391 mode_t oldmask
= mask
;
2398 chmod (const char *path
, mode_t mode
)
2400 /* say it always succeed for now */
2409 return fcntl (oldd
, F_DUPFD
, 0);
2411 /* current implementation of fcntl in fcntl.mac.c simply returns old
2413 return fcntl (oldd
, F_DUPFD
);
2420 /* This is from the original sysdep.c. Emulate BSD dup2. First close
2421 newd if it already exists. Then, attempt to dup oldd. If not
2422 successful, call dup2 recursively until we are, then close the
2423 unsuccessful ones. */
2426 dup2 (int oldd
, int newd
)
2437 ret
= dup2 (oldd
, newd
);
2443 /* let it fail for now */
2460 ioctl (int d
, int request
, void *argp
)
2470 if (fildes
>=0 && fildes
<= 2)
2503 #endif /* __MRC__ */
2507 #if __MSL__ < 0x6000
2515 #endif /* __MWERKS__ */
2517 #endif /* ! MAC_OSX */
2520 /* Return the path to the directory in which Emacs can create
2521 temporary files. The MacOS "temporary items" directory cannot be
2522 used because it removes the file written by a process when it
2523 exits. In that sense it's more like "/dev/null" than "/tmp" (but
2524 again not exactly). And of course Emacs needs to read back the
2525 files written by its subprocesses. So here we write the files to a
2526 directory "Emacs" in the Preferences Folder. This directory is
2527 created if it does not exist. */
2530 get_temp_dir_name ()
2532 static char *temp_dir_name
= NULL
;
2536 Str255 dir_name
, full_path
;
2538 char unix_dir_name
[MAXPATHLEN
+1];
2541 /* Cache directory name with pointer temp_dir_name.
2542 Look for it only the first time. */
2545 err
= FindFolder (kOnSystemDisk
, kPreferencesFolderType
, kCreateFolder
,
2546 &vol_ref_num
, &dir_id
);
2550 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2553 if (strlen (full_path
) + 6 <= MAXPATHLEN
)
2554 strcat (full_path
, "Emacs:");
2558 if (!mac_to_posix_pathname (full_path
, unix_dir_name
, MAXPATHLEN
+1))
2561 dir
= opendir (unix_dir_name
); /* check whether temp directory exists */
2564 else if (mkdir (unix_dir_name
, 0700) != 0) /* create it if not */
2567 temp_dir_name
= (char *) malloc (strlen (unix_dir_name
) + 1);
2568 strcpy (temp_dir_name
, unix_dir_name
);
2571 return temp_dir_name
;
2576 /* Allocate and construct an array of pointers to strings from a list
2577 of strings stored in a 'STR#' resource. The returned pointer array
2578 is stored in the style of argv and environ: if the 'STR#' resource
2579 contains numString strings, a pointer array with numString+1
2580 elements is returned in which the last entry contains a null
2581 pointer. The pointer to the pointer array is passed by pointer in
2582 parameter t. The resource ID of the 'STR#' resource is passed in
2583 parameter StringListID.
2587 get_string_list (char ***t
, short string_list_id
)
2593 h
= GetResource ('STR#', string_list_id
);
2598 num_strings
= * (short *) p
;
2600 *t
= (char **) malloc (sizeof (char *) * (num_strings
+ 1));
2601 for (i
= 0; i
< num_strings
; i
++)
2603 short length
= *p
++;
2604 (*t
)[i
] = (char *) malloc (length
+ 1);
2605 strncpy ((*t
)[i
], p
, length
);
2606 (*t
)[i
][length
] = '\0';
2609 (*t
)[num_strings
] = 0;
2614 /* Return no string in case GetResource fails. Bug fixed by
2615 Ikegami Tsutomu. Caused MPW build to crash without sym -on
2616 option (no sym -on implies -opt local). */
2617 *t
= (char **) malloc (sizeof (char *));
2624 get_path_to_system_folder ()
2629 Str255 dir_name
, full_path
;
2631 static char system_folder_unix_name
[MAXPATHLEN
+1];
2634 err
= FindFolder (kOnSystemDisk
, kSystemFolderType
, kDontCreateFolder
,
2635 &vol_ref_num
, &dir_id
);
2639 if (!path_from_vol_dir_name (full_path
, 255, vol_ref_num
, dir_id
, "\p"))
2642 if (!mac_to_posix_pathname (full_path
, system_folder_unix_name
,
2646 return system_folder_unix_name
;
2652 #define ENVIRON_STRING_LIST_ID 128
2654 /* Get environment variable definitions from STR# resource. */
2661 get_string_list (&environ
, ENVIRON_STRING_LIST_ID
);
2667 /* Make HOME directory the one Emacs starts up in if not specified
2669 if (getenv ("HOME") == NULL
)
2671 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2674 environ
[i
] = (char *) malloc (strlen (my_passwd_dir
) + 6);
2677 strcpy (environ
[i
], "HOME=");
2678 strcat (environ
[i
], my_passwd_dir
);
2685 /* Make HOME directory the one Emacs starts up in if not specified
2687 if (getenv ("MAIL") == NULL
)
2689 environ
= (char **) realloc (environ
, sizeof (char *) * (i
+ 2));
2692 char * path_to_system_folder
= get_path_to_system_folder ();
2693 environ
[i
] = (char *) malloc (strlen (path_to_system_folder
) + 22);
2696 strcpy (environ
[i
], "MAIL=");
2697 strcat (environ
[i
], path_to_system_folder
);
2698 strcat (environ
[i
], "Eudora Folder/In");
2706 /* Return the value of the environment variable NAME. */
2709 getenv (const char *name
)
2711 int length
= strlen(name
);
2714 for (e
= environ
; *e
!= 0; e
++)
2715 if (strncmp(*e
, name
, length
) == 0 && (*e
)[length
] == '=')
2716 return &(*e
)[length
+ 1];
2718 if (strcmp (name
, "TMPDIR") == 0)
2719 return get_temp_dir_name ();
2726 /* see Interfaces&Libraries:Interfaces:CIncludes:signal.h */
2727 char *sys_siglist
[] =
2729 "Zero is not a signal!!!",
2731 "Interactive user interrupt", /* 2 */ "?",
2732 "Floating point exception", /* 4 */ "?", "?", "?",
2733 "Illegal instruction", /* 8 */ "?", "?", "?", "?", "?", "?", "?",
2734 "Segment violation", /* 16 */ "?", "?", "?", "?", "?", "?", "?",
2735 "?", "?", "?", "?", "?", "?", "?", "?",
2739 char *sys_siglist
[] =
2741 "Zero is not a signal!!!",
2743 "Floating point exception",
2744 "Illegal instruction",
2745 "Interactive user interrupt",
2746 "Segment violation",
2749 #else /* not __MRC__ and not __MWERKS__ */
2751 #endif /* not __MRC__ and not __MWERKS__ */
2754 #include <utsname.h>
2757 uname (struct utsname
*name
)
2760 system_name
= GetString (-16413); /* IM - Resource Manager Reference */
2763 BlockMove (*system_name
, name
->nodename
, (*system_name
)[0]+1);
2764 p2cstr (name
->nodename
);
2772 /* Event class of HLE sent to subprocess. */
2773 const OSType kEmacsSubprocessSend
= 'ESND';
2775 /* Event class of HLE sent back from subprocess. */
2776 const OSType kEmacsSubprocessReply
= 'ERPY';
2780 mystrchr (char *s
, char c
)
2782 while (*s
&& *s
!= c
)
2810 mystrcpy (char *to
, char *from
)
2822 /* Start a Mac subprocess. Arguments for it is passed in argv (null
2823 terminated). The process should run with the default directory
2824 "workdir", read input from "infn", and write output and error to
2825 "outfn" and "errfn", resp. The Process Manager call
2826 LaunchApplication is used to start the subprocess. We use high
2827 level events as the mechanism to pass arguments to the subprocess
2828 and to make Emacs wait for the subprocess to terminate and pass
2829 back a result code. The bulk of the code here packs the arguments
2830 into one message to be passed together with the high level event.
2831 Emacs also sometimes starts a subprocess using a shell to perform
2832 wildcard filename expansion. Since we don't really have a shell on
2833 the Mac, this case is detected and the starting of the shell is
2834 by-passed. We really need to add code here to do filename
2835 expansion to support such functionality. */
2838 run_mac_command (argv
, workdir
, infn
, outfn
, errfn
)
2839 unsigned char **argv
;
2840 const char *workdir
;
2841 const char *infn
, *outfn
, *errfn
;
2843 #if TARGET_API_MAC_CARBON
2845 #else /* not TARGET_API_MAC_CARBON */
2846 char macappname
[MAXPATHLEN
+1], macworkdir
[MAXPATHLEN
+1];
2847 char macinfn
[MAXPATHLEN
+1], macoutfn
[MAXPATHLEN
+1], macerrfn
[MAXPATHLEN
+1];
2848 int paramlen
, argc
, newargc
, j
, retries
;
2849 char **newargv
, *param
, *p
;
2852 LaunchParamBlockRec lpbr
;
2853 EventRecord send_event
, reply_event
;
2854 RgnHandle cursor_region_handle
;
2856 unsigned long ref_con
, len
;
2858 if (posix_to_mac_pathname (workdir
, macworkdir
, MAXPATHLEN
+1) == 0)
2860 if (posix_to_mac_pathname (infn
, macinfn
, MAXPATHLEN
+1) == 0)
2862 if (posix_to_mac_pathname (outfn
, macoutfn
, MAXPATHLEN
+1) == 0)
2864 if (posix_to_mac_pathname (errfn
, macerrfn
, MAXPATHLEN
+1) == 0)
2867 paramlen
= strlen (macworkdir
) + strlen (macinfn
) + strlen (macoutfn
)
2868 + strlen (macerrfn
) + 4; /* count nulls at end of strings */
2877 /* If a subprocess is invoked with a shell, we receive 3 arguments
2878 of the form: "<path to emacs bins>/sh" "-c" "<path to emacs
2879 bins>/<command> <command args>" */
2880 j
= strlen (argv
[0]);
2881 if (j
>= 3 && strcmp (argv
[0]+j
-3, "/sh") == 0
2882 && argc
== 3 && strcmp (argv
[1], "-c") == 0)
2884 char *command
, *t
, tempmacpathname
[MAXPATHLEN
+1];
2886 /* The arguments for the command in argv[2] are separated by
2887 spaces. Count them and put the count in newargc. */
2888 command
= (char *) alloca (strlen (argv
[2])+2);
2889 strcpy (command
, argv
[2]);
2890 if (command
[strlen (command
) - 1] != ' ')
2891 strcat (command
, " ");
2895 t
= mystrchr (t
, ' ');
2899 t
= mystrchr (t
+1, ' ');
2902 newargv
= (char **) alloca (sizeof (char *) * newargc
);
2905 for (j
= 0; j
< newargc
; j
++)
2907 newargv
[j
] = (char *) alloca (strlen (t
) + 1);
2908 mystrcpy (newargv
[j
], t
);
2911 paramlen
+= strlen (newargv
[j
]) + 1;
2914 if (strncmp (newargv
[0], "~emacs/", 7) == 0)
2916 if (posix_to_mac_pathname (newargv
[0], tempmacpathname
, MAXPATHLEN
+1)
2921 { /* sometimes Emacs call "sh" without a path for the command */
2923 char *t
= (char *) alloca (strlen (newargv
[0]) + 7 + 1);
2924 strcpy (t
, "~emacs/");
2925 strcat (t
, newargv
[0]);
2928 openp (Vexec_path
, build_string (newargv
[0]), Vexec_suffixes
, &path
,
2929 make_number (X_OK
));
2933 if (posix_to_mac_pathname (SDATA (path
), tempmacpathname
,
2937 strcpy (macappname
, tempmacpathname
);
2941 if (posix_to_mac_pathname (argv
[0], macappname
, MAXPATHLEN
+1) == 0)
2944 newargv
= (char **) alloca (sizeof (char *) * argc
);
2946 for (j
= 1; j
< argc
; j
++)
2948 if (strncmp (argv
[j
], "~emacs/", 7) == 0)
2950 char *t
= strchr (argv
[j
], ' ');
2953 char tempcmdname
[MAXPATHLEN
+1], tempmaccmdname
[MAXPATHLEN
+1];
2954 strncpy (tempcmdname
, argv
[j
], t
-argv
[j
]);
2955 tempcmdname
[t
-argv
[j
]] = '\0';
2956 if (posix_to_mac_pathname (tempcmdname
, tempmaccmdname
,
2959 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)
2961 strcpy (newargv
[j
], tempmaccmdname
);
2962 strcat (newargv
[j
], t
);
2966 char tempmaccmdname
[MAXPATHLEN
+1];
2967 if (posix_to_mac_pathname (argv
[j
], tempmaccmdname
,
2970 newargv
[j
] = (char *) alloca (strlen (tempmaccmdname
)+1);
2971 strcpy (newargv
[j
], tempmaccmdname
);
2975 newargv
[j
] = argv
[j
];
2976 paramlen
+= strlen (newargv
[j
]) + 1;
2980 /* After expanding all the arguments, we now know the length of the
2981 parameter block to be sent to the subprocess as a message
2982 attached to the HLE. */
2983 param
= (char *) malloc (paramlen
+ 1);
2989 /* first byte of message contains number of arguments for command */
2990 strcpy (p
, macworkdir
);
2991 p
+= strlen (macworkdir
);
2993 /* null terminate strings sent so it's possible to use strcpy over there */
2994 strcpy (p
, macinfn
);
2995 p
+= strlen (macinfn
);
2997 strcpy (p
, macoutfn
);
2998 p
+= strlen (macoutfn
);
3000 strcpy (p
, macerrfn
);
3001 p
+= strlen (macerrfn
);
3003 for (j
= 1; j
< newargc
; j
++)
3005 strcpy (p
, newargv
[j
]);
3006 p
+= strlen (newargv
[j
]);
3010 c2pstr (macappname
);
3012 iErr
= FSMakeFSSpec (0, 0, macappname
, &spec
);
3020 lpbr
.launchBlockID
= extendedBlock
;
3021 lpbr
.launchEPBLength
= extendedBlockLen
;
3022 lpbr
.launchControlFlags
= launchContinue
+ launchNoFileFlags
;
3023 lpbr
.launchAppSpec
= &spec
;
3024 lpbr
.launchAppParameters
= NULL
;
3026 iErr
= LaunchApplication (&lpbr
); /* call the subprocess */
3033 send_event
.what
= kHighLevelEvent
;
3034 send_event
.message
= kEmacsSubprocessSend
;
3035 /* Event ID stored in "where" unused */
3038 /* OS may think current subprocess has terminated if previous one
3039 terminated recently. */
3042 iErr
= PostHighLevelEvent (&send_event
, &lpbr
.launchProcessSN
, 0, param
,
3043 paramlen
+ 1, receiverIDisPSN
);
3045 while (iErr
== sessClosedErr
&& retries
-- > 0);
3053 cursor_region_handle
= NewRgn ();
3055 /* Wait for the subprocess to finish, when it will send us a ERPY
3056 high level event. */
3058 if (WaitNextEvent (highLevelEventMask
, &reply_event
, 180,
3059 cursor_region_handle
)
3060 && reply_event
.message
== kEmacsSubprocessReply
)
3063 /* The return code is sent through the refCon */
3064 iErr
= AcceptHighLevelEvent (&targ
, &ref_con
, NULL
, &len
);
3067 DisposeHandle ((Handle
) cursor_region_handle
);
3072 DisposeHandle ((Handle
) cursor_region_handle
);
3076 #endif /* not TARGET_API_MAC_CARBON */
3081 opendir (const char *dirname
)
3083 char true_pathname
[MAXPATHLEN
+1], fully_resolved_name
[MAXPATHLEN
+1];
3084 char mac_pathname
[MAXPATHLEN
+1], vol_name
[MAXPATHLEN
+1];
3088 int len
, vol_name_len
;
3090 if (find_true_pathname (dirname
, true_pathname
, MAXPATHLEN
+1) == -1)
3093 len
= readlink (true_pathname
, fully_resolved_name
, MAXPATHLEN
);
3095 fully_resolved_name
[len
] = '\0';
3097 strcpy (fully_resolved_name
, true_pathname
);
3099 dirp
= (DIR *) malloc (sizeof(DIR));
3103 /* Handle special case when dirname is "/": sets up for readir to
3104 get all mount volumes. */
3105 if (strcmp (fully_resolved_name
, "/") == 0)
3107 dirp
->getting_volumes
= 1; /* special all mounted volumes DIR struct */
3108 dirp
->current_index
= 1; /* index for first volume */
3112 /* Handle typical cases: not accessing all mounted volumes. */
3113 if (!posix_to_mac_pathname (fully_resolved_name
, mac_pathname
, MAXPATHLEN
+1))
3116 /* Emacs calls opendir without the trailing '/', Mac needs trailing ':' */
3117 len
= strlen (mac_pathname
);
3118 if (mac_pathname
[len
- 1] != ':' && len
< MAXPATHLEN
)
3119 strcat (mac_pathname
, ":");
3121 /* Extract volume name */
3122 vol_name_len
= strchr (mac_pathname
, ':') - mac_pathname
;
3123 strncpy (vol_name
, mac_pathname
, vol_name_len
);
3124 vol_name
[vol_name_len
] = '\0';
3125 strcat (vol_name
, ":");
3127 c2pstr (mac_pathname
);
3128 cipb
.hFileInfo
.ioNamePtr
= mac_pathname
;
3129 /* using full pathname so vRefNum and DirID ignored */
3130 cipb
.hFileInfo
.ioVRefNum
= 0;
3131 cipb
.hFileInfo
.ioDirID
= 0;
3132 cipb
.hFileInfo
.ioFDirIndex
= 0;
3133 /* set to 0 to get information about specific dir or file */
3135 errno
= PBGetCatInfo (&cipb
, false);
3142 if (!(cipb
.hFileInfo
.ioFlAttrib
& 0x10)) /* bit 4 = 1 for directories */
3143 return 0; /* not a directory */
3145 dirp
->dir_id
= cipb
.dirInfo
.ioDrDirID
; /* used later in readdir */
3146 dirp
->getting_volumes
= 0;
3147 dirp
->current_index
= 1; /* index for first file/directory */
3150 vpb
.ioNamePtr
= vol_name
;
3151 /* using full pathname so vRefNum and DirID ignored */
3153 vpb
.ioVolIndex
= -1;
3154 errno
= PBHGetVInfo ((union HParamBlockRec
*) &vpb
, false);
3161 dirp
->vol_ref_num
= vpb
.ioVRefNum
;
3178 HParamBlockRec hpblock
;
3180 static struct dirent s_dirent
;
3181 static Str255 s_name
;
3185 /* Handle the root directory containing the mounted volumes. Call
3186 PBHGetVInfo specifying an index to obtain the info for a volume.
3187 PBHGetVInfo returns an error when it receives an index beyond the
3188 last volume, at which time we should return a nil dirent struct
3190 if (dp
->getting_volumes
)
3192 hpblock
.volumeParam
.ioNamePtr
= s_name
;
3193 hpblock
.volumeParam
.ioVRefNum
= 0;
3194 hpblock
.volumeParam
.ioVolIndex
= dp
->current_index
;
3196 errno
= PBHGetVInfo (&hpblock
, false);
3204 strcat (s_name
, "/"); /* need "/" for stat to work correctly */
3206 dp
->current_index
++;
3208 s_dirent
.d_ino
= hpblock
.volumeParam
.ioVRefNum
;
3209 s_dirent
.d_name
= s_name
;
3215 cipb
.hFileInfo
.ioVRefNum
= dp
->vol_ref_num
;
3216 cipb
.hFileInfo
.ioNamePtr
= s_name
;
3217 /* location to receive filename returned */
3219 /* return only visible files */
3223 cipb
.hFileInfo
.ioDirID
= dp
->dir_id
;
3224 /* directory ID found by opendir */
3225 cipb
.hFileInfo
.ioFDirIndex
= dp
->current_index
;
3227 errno
= PBGetCatInfo (&cipb
, false);
3234 /* insist on a visible entry */
3235 if (cipb
.hFileInfo
.ioFlAttrib
& 0x10) /* directory? */
3236 done
= !(cipb
.dirInfo
.ioDrUsrWds
.frFlags
& fInvisible
);
3238 done
= !(cipb
.hFileInfo
.ioFlFndrInfo
.fdFlags
& fInvisible
);
3240 dp
->current_index
++;
3253 s_dirent
.d_ino
= cipb
.dirInfo
.ioDrDirID
;
3254 /* value unimportant: non-zero for valid file */
3255 s_dirent
.d_name
= s_name
;
3265 char mac_pathname
[MAXPATHLEN
+1];
3266 Str255 directory_name
;
3270 if (path_from_vol_dir_name (mac_pathname
, 255, 0, 0, "\p") == 0)
3273 if (mac_to_posix_pathname (mac_pathname
, path
, MAXPATHLEN
+1) == 0)
3279 #endif /* ! MAC_OSX */
3283 initialize_applescript ()
3288 /* if open fails, as_scripting_component is set to NULL. Its
3289 subsequent use in OSA calls will fail with badComponentInstance
3291 as_scripting_component
= OpenDefaultComponent (kOSAComponentType
,
3292 kAppleScriptSubtype
);
3294 null_desc
.descriptorType
= typeNull
;
3295 null_desc
.dataHandle
= 0;
3296 osaerror
= OSAMakeContext (as_scripting_component
, &null_desc
,
3297 kOSANullScript
, &as_script_context
);
3299 as_script_context
= kOSANullScript
;
3300 /* use default context if create fails */
3304 void terminate_applescript()
3306 OSADispose (as_scripting_component
, as_script_context
);
3307 CloseComponent (as_scripting_component
);
3311 /* Compile and execute the AppleScript SCRIPT and return the error
3312 status as function value. A zero is returned if compilation and
3313 execution is successful, in which case RESULT returns a pointer to
3314 a string containing the resulting script value. Otherwise, the Mac
3315 error code is returned and RESULT returns a pointer to an error
3316 string. In both cases the caller should deallocate the storage
3317 used by the string pointed to by RESULT if it is non-NULL. For
3318 documentation on the MacOS scripting architecture, see Inside
3319 Macintosh - Interapplication Communications: Scripting Components. */
3322 do_applescript (char *script
, char **result
)
3324 AEDesc script_desc
, result_desc
, error_desc
;
3331 if (!as_scripting_component
)
3332 initialize_applescript();
3334 error
= AECreateDesc (typeChar
, script
, strlen(script
), &script_desc
);
3338 osaerror
= OSADoScript (as_scripting_component
, &script_desc
, kOSANullScript
,
3339 typeChar
, kOSAModeNull
, &result_desc
);
3341 if (osaerror
== errOSAScriptError
)
3343 /* error executing AppleScript: retrieve error message */
3344 if (!OSAScriptError (as_scripting_component
, kOSAErrorMessage
, typeChar
,
3347 #if TARGET_API_MAC_CARBON
3348 length
= AEGetDescDataSize (&error_desc
);
3349 *result
= (char *) xmalloc (length
+ 1);
3352 AEGetDescData (&error_desc
, *result
, length
);
3353 *(*result
+ length
) = '\0';
3355 #else /* not TARGET_API_MAC_CARBON */
3356 HLock (error_desc
.dataHandle
);
3357 length
= GetHandleSize(error_desc
.dataHandle
);
3358 *result
= (char *) xmalloc (length
+ 1);
3361 memcpy (*result
, *(error_desc
.dataHandle
), length
);
3362 *(*result
+ length
) = '\0';
3364 HUnlock (error_desc
.dataHandle
);
3365 #endif /* not TARGET_API_MAC_CARBON */
3366 AEDisposeDesc (&error_desc
);
3369 else if (osaerror
== noErr
) /* success: retrieve resulting script value */
3371 #if TARGET_API_MAC_CARBON
3372 length
= AEGetDescDataSize (&result_desc
);
3373 *result
= (char *) xmalloc (length
+ 1);
3376 AEGetDescData (&result_desc
, *result
, length
);
3377 *(*result
+ length
) = '\0';
3379 #else /* not TARGET_API_MAC_CARBON */
3380 HLock (result_desc
.dataHandle
);
3381 length
= GetHandleSize(result_desc
.dataHandle
);
3382 *result
= (char *) xmalloc (length
+ 1);
3385 memcpy (*result
, *(result_desc
.dataHandle
), length
);
3386 *(*result
+ length
) = '\0';
3388 HUnlock (result_desc
.dataHandle
);
3389 #endif /* not TARGET_API_MAC_CARBON */
3390 AEDisposeDesc (&result_desc
);
3393 AEDisposeDesc (&script_desc
);
3399 DEFUN ("do-applescript", Fdo_applescript
, Sdo_applescript
, 1, 1, 0,
3400 doc
: /* Compile and execute AppleScript SCRIPT and retrieve and return the result.
3401 If compilation and execution are successful, the resulting script
3402 value is returned as a string. Otherwise the function aborts and
3403 displays the error message returned by the AppleScript scripting
3408 char *result
, *temp
;
3409 Lisp_Object lisp_result
;
3412 CHECK_STRING (script
);
3415 status
= do_applescript (SDATA (script
), &result
);
3420 error ("AppleScript error %d", status
);
3423 /* Unfortunately only OSADoScript in do_applescript knows how
3424 how large the resulting script value or error message is
3425 going to be and therefore as caller memory must be
3426 deallocated here. It is necessary to free the error
3427 message before calling error to avoid a memory leak. */
3428 temp
= (char *) alloca (strlen (result
) + 1);
3429 strcpy (temp
, result
);
3436 lisp_result
= build_string (result
);
3443 DEFUN ("mac-file-name-to-posix", Fmac_file_name_to_posix
,
3444 Smac_file_name_to_posix
, 1, 1, 0,
3445 doc
: /* Convert Macintosh filename to Posix form. */)
3447 Lisp_Object mac_filename
;
3449 char posix_filename
[MAXPATHLEN
+1];
3451 CHECK_STRING (mac_filename
);
3453 if (mac_to_posix_pathname (SDATA (mac_filename
), posix_filename
,
3455 return build_string (posix_filename
);
3461 DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac
,
3462 Sposix_file_name_to_mac
, 1, 1, 0,
3463 doc
: /* Convert Posix filename to Mac form. */)
3465 Lisp_Object posix_filename
;
3467 char mac_filename
[MAXPATHLEN
+1];
3469 CHECK_STRING (posix_filename
);
3471 if (posix_to_mac_pathname (SDATA (posix_filename
), mac_filename
,
3473 return build_string (mac_filename
);
3479 /* set interprogram-paste-function to mac-paste-function in mac-win.el
3480 to enable Emacs to obtain the contents of the Mac clipboard. */
3481 DEFUN ("mac-paste-function", Fmac_paste_function
, Smac_paste_function
, 0, 0, 0,
3482 doc
: /* Return the contents of the Mac clipboard as a string. */)
3485 #if TARGET_API_MAC_CARBON
3488 ScrapFlavorFlags sff
;
3494 err
= GetCurrentScrap (&scrap
);
3496 err
= GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
);
3498 err
= GetScrapFlavorSize (scrap
, kScrapFlavorTypeText
, &s
);
3499 if (err
== noErr
&& (data
= (char*) alloca (s
)))
3500 err
= GetScrapFlavorData (scrap
, kScrapFlavorTypeText
, &s
, data
);
3502 if (err
!= noErr
|| s
== 0)
3505 /* Emacs expects clipboard contents have Unix-style eol's */
3506 for (i
= 0; i
< s
; i
++)
3507 if (data
[i
] == '\r')
3510 return make_string (data
, s
);
3511 #else /* not TARGET_API_MAC_CARBON */
3514 long scrap_offset
, rc
, i
;
3516 my_handle
= NewHandle (0); /* allocate 0-length data area */
3518 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3524 /* Emacs expects clipboard contents have Unix-style eol's */
3525 for (i
= 0; i
< rc
; i
++)
3526 if ((*my_handle
)[i
] == '\r')
3527 (*my_handle
)[i
] = '\n';
3529 value
= make_string (*my_handle
, rc
);
3531 HUnlock (my_handle
);
3533 DisposeHandle (my_handle
);
3536 #endif /* not TARGET_API_MAC_CARBON */
3540 /* set interprogram-cut-function to mac-cut-function in mac-win.el
3541 to enable Emacs to write the top of the kill-ring to the Mac clipboard. */
3542 DEFUN ("mac-cut-function", Fmac_cut_function
, Smac_cut_function
, 1, 2, 0,
3543 doc
: /* Put the value of the string parameter to the Mac clipboard. */)
3545 Lisp_Object value
, push
;
3550 /* fixme: ignore the push flag for now */
3552 CHECK_STRING (value
);
3554 len
= SCHARS (value
);
3555 buf
= (char *) alloca (len
+1);
3556 bcopy (SDATA (value
), buf
, len
);
3559 /* convert to Mac-style eol's before sending to clipboard */
3560 for (i
= 0; i
< len
; i
++)
3564 #if TARGET_API_MAC_CARBON
3569 ClearCurrentScrap ();
3570 if (GetCurrentScrap (&scrap
) != noErr
)
3573 error ("cannot get current scrap");
3576 if (PutScrapFlavor (scrap
, kScrapFlavorTypeText
, kScrapFlavorMaskNone
, len
,
3580 error ("cannot put to scrap");
3584 #else /* not TARGET_API_MAC_CARBON */
3586 PutScrap (len
, 'TEXT', buf
);
3587 #endif /* not TARGET_API_MAC_CARBON */
3593 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
3595 doc
: /* Whether there is an owner for the given X Selection.
3596 The arg should be the name of the selection in question, typically one of
3597 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
3598 \(Those are literal upper-case symbol names, since that's what X expects.)
3599 For convenience, the symbol nil is the same as `PRIMARY',
3600 and t is the same as `SECONDARY'. */)
3602 Lisp_Object selection
;
3604 CHECK_SYMBOL (selection
);
3606 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
3607 if the clipboard currently has valid text format contents. */
3609 if (EQ (selection
, QCLIPBOARD
))
3611 Lisp_Object val
= Qnil
;
3613 #if TARGET_API_MAC_CARBON
3615 ScrapFlavorFlags sff
;
3618 if (GetCurrentScrap (&scrap
) == noErr
)
3619 if (GetScrapFlavorFlags (scrap
, kScrapFlavorTypeText
, &sff
) == noErr
)
3622 #else /* not TARGET_API_MAC_CARBON */
3624 long rc
, scrap_offset
;
3626 my_handle
= NewHandle (0);
3628 rc
= GetScrap (my_handle
, 'TEXT', &scrap_offset
);
3632 DisposeHandle (my_handle
);
3633 #endif /* not TARGET_API_MAC_CARBON */
3640 #if TARGET_API_MAC_CARBON
3641 static Lisp_Object Qxml
;
3643 DEFUN ("mac-get-preference", Fmac_get_preference
, Smac_get_preference
, 1, 4, 0,
3644 doc
: /* Return the application preference value for KEY.
3645 KEY is either a string specifying a preference key, or a list of key
3646 strings. If it is a list, the (i+1)-th element is used as a key for
3647 the CFDictionary value obtained by the i-th element. If lookup is
3648 failed at some stage, nil is returned.
3650 Optional arg APPLICATION is an application ID string. If omitted or
3651 nil, that stands for the current application.
3653 Optional arg FORMAT specifies the data format of the return value. If
3654 omitted or nil, each Core Foundation object is converted into a
3655 corresponding Lisp object as follows:
3657 Core Foundation Lisp Tag
3658 ------------------------------------------------------------
3659 CFString Multibyte string string
3660 CFNumber Integer or float number
3661 CFBoolean Symbol (t or nil) boolean
3662 CFDate List of three integers date
3663 (cf. `current-time')
3664 CFData Unibyte string data
3666 CFDictionary Alist or hash table dictionary
3667 (depending on HASH-BOUND)
3669 If it is t, a symbol that represents the type of the original Core
3670 Foundation object is prepended. If it is `xml', the value is returned
3671 as an XML representation.
3673 Optional arg HASH-BOUND specifies which kinds of the list objects,
3674 alists or hash tables, are used as the targets of the conversion from
3675 CFDictionary. If HASH-BOUND is a negative integer or nil, always
3676 generate alists. If HASH-BOUND >= 0, generate an alist if the number
3677 of keys in the dictionary is smaller than HASH-BOUND, and a hash table
3679 (key
, application
, format
, hash_bound
)
3680 Lisp_Object key
, application
, format
, hash_bound
;
3682 CFStringRef app_id
, key_str
;
3683 CFPropertyListRef app_plist
= NULL
, plist
;
3684 Lisp_Object result
= Qnil
, tmp
;
3687 key
= Fcons (key
, Qnil
);
3691 for (tmp
= key
; CONSP (tmp
); tmp
= XCDR (tmp
))
3692 CHECK_STRING_CAR (tmp
);
3694 wrong_type_argument (Qlistp
, key
);
3696 if (!NILP (application
))
3697 CHECK_STRING (application
);
3698 CHECK_SYMBOL (format
);
3699 if (!NILP (hash_bound
))
3700 CHECK_NUMBER (hash_bound
);
3704 app_id
= kCFPreferencesCurrentApplication
;
3705 if (!NILP (application
))
3707 app_id
= cfstring_create_with_utf8_cstring (SDATA (application
));
3711 key_str
= cfstring_create_with_utf8_cstring (SDATA (XCAR (key
)));
3712 if (key_str
== NULL
)
3714 app_plist
= CFPreferencesCopyAppValue (key_str
, app_id
);
3715 CFRelease (key_str
);
3716 if (app_plist
== NULL
)
3720 for (key
= XCDR (key
); CONSP (key
); key
= XCDR (key
))
3722 if (CFGetTypeID (plist
) != CFDictionaryGetTypeID ())
3724 key_str
= cfstring_create_with_utf8_cstring (SDATA (XCAR (key
)));
3725 if (key_str
== NULL
)
3727 plist
= CFDictionaryGetValue (plist
, key_str
);
3728 CFRelease (key_str
);
3734 if (EQ (format
, Qxml
))
3736 CFDataRef data
= CFPropertyListCreateXMLData (NULL
, plist
);
3739 result
= cfdata_to_lisp (data
);
3744 cfproperty_list_to_lisp (plist
, EQ (format
, Qt
),
3745 NILP (hash_bound
) ? -1 : XINT (hash_bound
));
3749 CFRelease (app_plist
);
3756 #endif /* TARGET_API_MAC_CARBON */
3759 DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table
, Smac_clear_font_name_table
, 0, 0, 0,
3760 doc
: /* Clear the font name table. */)
3764 mac_clear_font_name_table ();
3771 extern int inhibit_window_system
;
3772 extern int noninteractive
;
3774 /* Unlike in X11, window events in Carbon do not come from sockets.
3775 So we cannot simply use `select' to monitor two kinds of inputs:
3776 window events and process outputs. We emulate such functionality
3777 by regarding fd 0 as the window event channel and simultaneously
3778 monitoring both kinds of input channels. It is implemented by
3779 dividing into some cases:
3780 1. The window event channel is not involved.
3782 2. Sockets are not involved.
3783 -> Use ReceiveNextEvent.
3784 3. [If SELECT_USE_CFSOCKET is defined]
3785 Only the window event channel and socket read channels are
3786 involved, and timeout is not too short (greater than
3787 SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds).
3788 -> Create CFSocket for each socket and add it into the current
3789 event RunLoop so that an `ready-to-read' event can be posted
3790 to the event queue that is also used for window events. Then
3791 ReceiveNextEvent can wait for both kinds of inputs.
3793 -> Periodically poll the window input channel while repeatedly
3794 executing `select' with a short timeout
3795 (SELECT_POLLING_PERIOD_USEC microseconds). */
3797 #define SELECT_POLLING_PERIOD_USEC 20000
3798 #ifdef SELECT_USE_CFSOCKET
3799 #define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2
3800 #define EVENT_CLASS_SOCK 'Sock'
3803 socket_callback (s
, type
, address
, data
, info
)
3805 CFSocketCallBackType type
;
3812 CreateEvent (NULL
, EVENT_CLASS_SOCK
, 0, 0, kEventAttributeNone
, &event
);
3813 PostEventToQueue (GetCurrentEventQueue (), event
, kEventPriorityStandard
);
3814 ReleaseEvent (event
);
3816 #endif /* SELECT_USE_CFSOCKET */
3819 select_and_poll_event (n
, rfds
, wfds
, efds
, timeout
)
3824 struct timeval
*timeout
;
3829 r
= select (n
, rfds
, wfds
, efds
, timeout
);
3833 err
= ReceiveNextEvent (0, NULL
, kEventDurationNoWait
,
3834 kEventLeaveInQueue
, NULL
);
3845 #if MAC_OS_X_VERSION_MAX_ALLOWED < 1020
3846 #undef SELECT_INVALIDATE_CFSOCKET
3850 sys_select (n
, rfds
, wfds
, efds
, timeout
)
3855 struct timeval
*timeout
;
3859 EMACS_TIME select_timeout
;
3861 if (inhibit_window_system
|| noninteractive
3862 || rfds
== NULL
|| !FD_ISSET (0, rfds
))
3863 return select (n
, rfds
, wfds
, efds
, timeout
);
3867 if (wfds
== NULL
&& efds
== NULL
)
3870 SELECT_TYPE orfds
= *rfds
;
3872 EventTimeout timeout_sec
=
3874 ? (EMACS_SECS (*timeout
) * kEventDurationSecond
3875 + EMACS_USECS (*timeout
) * kEventDurationMicrosecond
)
3876 : kEventDurationForever
);
3878 for (i
= 1; i
< n
; i
++)
3879 if (FD_ISSET (i
, rfds
))
3885 err
= ReceiveNextEvent (0, NULL
, timeout_sec
,
3886 kEventLeaveInQueue
, NULL
);
3897 /* Avoid initial overhead of RunLoop setup for the case that
3898 some input is already available. */
3899 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
3900 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
3901 if (r
!= 0 || timeout_sec
== 0.0)
3906 #ifdef SELECT_USE_CFSOCKET
3907 if (timeout_sec
> 0 && timeout_sec
<= SELECT_TIMEOUT_THRESHOLD_RUNLOOP
)
3908 goto poll_periodically
;
3911 CFRunLoopRef runloop
=
3912 (CFRunLoopRef
) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ());
3913 EventTypeSpec specs
[] = {{EVENT_CLASS_SOCK
, 0}};
3914 #ifdef SELECT_INVALIDATE_CFSOCKET
3915 CFSocketRef
*shead
, *s
;
3917 CFRunLoopSourceRef
*shead
, *s
;
3922 #ifdef SELECT_INVALIDATE_CFSOCKET
3923 shead
= xmalloc (sizeof (CFSocketRef
) * nsocks
);
3925 shead
= xmalloc (sizeof (CFRunLoopSourceRef
) * nsocks
);
3928 for (i
= 1; i
< n
; i
++)
3929 if (FD_ISSET (i
, rfds
))
3931 CFSocketRef socket
=
3932 CFSocketCreateWithNative (NULL
, i
, kCFSocketReadCallBack
,
3933 socket_callback
, NULL
);
3934 CFRunLoopSourceRef source
=
3935 CFSocketCreateRunLoopSource (NULL
, socket
, 0);
3937 #ifdef SELECT_INVALIDATE_CFSOCKET
3938 CFSocketSetSocketFlags (socket
, 0);
3940 CFRunLoopAddSource (runloop
, source
, kCFRunLoopDefaultMode
);
3941 #ifdef SELECT_INVALIDATE_CFSOCKET
3951 err
= ReceiveNextEvent (0, NULL
, timeout_sec
, kEventLeaveInQueue
, NULL
);
3956 #ifdef SELECT_INVALIDATE_CFSOCKET
3957 CFSocketInvalidate (*s
);
3959 CFRunLoopRemoveSource (runloop
, *s
, kCFRunLoopDefaultMode
);
3974 FlushEventsMatchingListFromQueue (GetCurrentEventQueue (),
3975 GetEventTypeCount (specs
),
3977 EMACS_SET_SECS_USECS (select_timeout
, 0, 0);
3978 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
3985 #endif /* SELECT_USE_CFSOCKET */
3990 EMACS_TIME end_time
, now
, remaining_time
;
3991 SELECT_TYPE orfds
= *rfds
, owfds
, oefds
;
3999 remaining_time
= *timeout
;
4000 EMACS_GET_TIME (now
);
4001 EMACS_ADD_TIME (end_time
, now
, remaining_time
);
4006 EMACS_SET_SECS_USECS (select_timeout
, 0, SELECT_POLLING_PERIOD_USEC
);
4007 if (timeout
&& EMACS_TIME_LT (remaining_time
, select_timeout
))
4008 select_timeout
= remaining_time
;
4009 r
= select_and_poll_event (n
, rfds
, wfds
, efds
, &select_timeout
);
4021 EMACS_GET_TIME (now
);
4022 EMACS_SUB_TIME (remaining_time
, end_time
, now
);
4025 while (!timeout
|| EMACS_TIME_LT (now
, end_time
));
4036 /* Set up environment variables so that Emacs can correctly find its
4037 support files when packaged as an application bundle. Directories
4038 placed in /usr/local/share/emacs/<emacs-version>/, /usr/local/bin,
4039 and /usr/local/libexec/emacs/<emacs-version>/<system-configuration>
4040 by `make install' by default can instead be placed in
4041 .../Emacs.app/Contents/Resources/ and
4042 .../Emacs.app/Contents/MacOS/. Each of these environment variables
4043 is changed only if it is not already set. Presumably if the user
4044 sets an environment variable, he will want to use files in his path
4045 instead of ones in the application bundle. */
4047 init_mac_osx_environment ()
4051 CFStringRef cf_app_bundle_pathname
;
4052 int app_bundle_pathname_len
;
4053 char *app_bundle_pathname
;
4057 /* Fetch the pathname of the application bundle as a C string into
4058 app_bundle_pathname. */
4060 bundle
= CFBundleGetMainBundle ();
4064 bundleURL
= CFBundleCopyBundleURL (bundle
);
4068 cf_app_bundle_pathname
= CFURLCopyFileSystemPath (bundleURL
,
4069 kCFURLPOSIXPathStyle
);
4070 app_bundle_pathname_len
= CFStringGetLength (cf_app_bundle_pathname
);
4071 app_bundle_pathname
= (char *) alloca (app_bundle_pathname_len
+ 1);
4073 if (!CFStringGetCString (cf_app_bundle_pathname
,
4074 app_bundle_pathname
,
4075 app_bundle_pathname_len
+ 1,
4076 kCFStringEncodingISOLatin1
))
4078 CFRelease (cf_app_bundle_pathname
);
4082 CFRelease (cf_app_bundle_pathname
);
4084 /* P should have sufficient room for the pathname of the bundle plus
4085 the subpath in it leading to the respective directories. Q
4086 should have three times that much room because EMACSLOADPATH can
4087 have the value "<path to lisp dir>:<path to leim dir>:<path to
4089 p
= (char *) alloca (app_bundle_pathname_len
+ 50);
4090 q
= (char *) alloca (3 * app_bundle_pathname_len
+ 150);
4091 if (!getenv ("EMACSLOADPATH"))
4095 strcpy (p
, app_bundle_pathname
);
4096 strcat (p
, "/Contents/Resources/lisp");
4097 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4100 strcpy (p
, app_bundle_pathname
);
4101 strcat (p
, "/Contents/Resources/leim");
4102 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4109 strcpy (p
, app_bundle_pathname
);
4110 strcat (p
, "/Contents/Resources/site-lisp");
4111 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4119 setenv ("EMACSLOADPATH", q
, 1);
4122 if (!getenv ("EMACSPATH"))
4126 strcpy (p
, app_bundle_pathname
);
4127 strcat (p
, "/Contents/MacOS/libexec");
4128 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4131 strcpy (p
, app_bundle_pathname
);
4132 strcat (p
, "/Contents/MacOS/bin");
4133 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4141 setenv ("EMACSPATH", q
, 1);
4144 if (!getenv ("EMACSDATA"))
4146 strcpy (p
, app_bundle_pathname
);
4147 strcat (p
, "/Contents/Resources/etc");
4148 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4149 setenv ("EMACSDATA", p
, 1);
4152 if (!getenv ("EMACSDOC"))
4154 strcpy (p
, app_bundle_pathname
);
4155 strcat (p
, "/Contents/Resources/etc");
4156 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4157 setenv ("EMACSDOC", p
, 1);
4160 if (!getenv ("INFOPATH"))
4162 strcpy (p
, app_bundle_pathname
);
4163 strcat (p
, "/Contents/Resources/info");
4164 if (stat (p
, &st
) == 0 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
4165 setenv ("INFOPATH", p
, 1);
4168 #endif /* MAC_OSX */
4173 QCLIPBOARD
= intern ("CLIPBOARD");
4174 staticpro (&QCLIPBOARD
);
4176 #if TARGET_API_MAC_CARBON
4177 Qstring
= intern ("string");
4178 staticpro (&Qstring
);
4180 Qnumber
= intern ("number");
4181 staticpro (&Qnumber
);
4183 Qboolean
= intern ("boolean");
4184 staticpro (&Qboolean
);
4186 Qdate
= intern ("date");
4189 Qdata
= intern ("data");
4192 Qarray
= intern ("array");
4193 staticpro (&Qarray
);
4195 Qdictionary
= intern ("dictionary");
4196 staticpro (&Qdictionary
);
4198 Qxml
= intern ("xml");
4202 defsubr (&Smac_paste_function
);
4203 defsubr (&Smac_cut_function
);
4204 defsubr (&Sx_selection_exists_p
);
4205 #if TARGET_API_MAC_CARBON
4206 defsubr (&Smac_get_preference
);
4208 defsubr (&Smac_clear_font_name_table
);
4210 defsubr (&Sdo_applescript
);
4211 defsubr (&Smac_file_name_to_posix
);
4212 defsubr (&Sposix_file_name_to_mac
);
4215 /* arch-tag: 29d30c1f-0c6b-4f88-8a6d-0558d7f9dbff
4216 (do not change this comment) */