X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/40f18bf37ed957b311f515cd9b699c5b192425ae..bc203f9e4311ddb2c6ea12c14ae2dc2f463591c1:/src/emacs.c diff --git a/src/emacs.c b/src/emacs.c index 3243c38a87..4777044215 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1,6 +1,6 @@ /* Fully extensible Emacs, running on Unix, intended for GNU. -Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2013 +Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include @@ -36,6 +37,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT #include #include +#include #include "w32.h" #include "w32heap.h" #endif @@ -79,6 +81,7 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "dispextern.h" #include "syntax.h" +#include "sysselect.h" #include "systime.h" #ifdef HAVE_GNUTLS @@ -104,8 +107,13 @@ extern void moncontrol (int mode); #include #endif -static const char emacs_version[] = VERSION; +Lisp_Object symbol_module; +Lisp_Object function_module; +Lisp_Object plist_module; + +static const char emacs_version[] = PACKAGE_VERSION; static const char emacs_copyright[] = COPYRIGHT; +static const char emacs_bugreport[] = PACKAGE_BUGREPORT; /* Empty lisp strings. To avoid having to build any others. */ Lisp_Object empty_unibyte_string, empty_multibyte_string; @@ -120,6 +128,9 @@ Lisp_Object Vlibrary_cache; on subsequent starts. */ bool initialized; +/* Set to true if this instance of Emacs might dump. */ +bool might_dump; + #ifdef DARWIN_OS extern void unexec_init_emacs_zone (void); #endif @@ -131,7 +142,7 @@ static void *malloc_state_ptr; /* From glibc, a routine that returns a copy of the malloc internal state. */ extern void *malloc_get_state (void); /* From glibc, a routine that overwrites the malloc internal state. */ -extern int malloc_set_state (void*); +extern int malloc_set_state (void *); /* True if the MALLOC_CHECK_ environment variable was set while dumping. Used to work around a bug in glibc's malloc. */ static bool malloc_using_checking; @@ -159,10 +170,6 @@ bool running_asynch_code; bool display_arg; #endif -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -char *stack_bottom; - #if defined (DOUG_LEA_MALLOC) || defined (GNU_LINUX) /* The address where the heap starts (from the first sbrk (0) call). */ static void *my_heap_start; @@ -209,7 +216,7 @@ int initial_argc; static void sort_args (int argc, char **argv); static void syms_of_emacs (void); -/* C89 needs each string be at most 509 characters, so the usage +/* C99 needs each string to be at most 4095 characters, and the usage strings below are split to not overflow this limit. */ static char const *const usage_message[] = { "\ @@ -320,7 +327,7 @@ abbreviation for a --option.\n\ Various environment variables and window system resources also affect\n\ the operation of Emacs. See the main documentation.\n\ \n\ -Report bugs to bug-gnu-emacs@gnu.org. First, please see the Bugs\n\ +Report bugs to " PACKAGE_BUGREPORT ". First, please see the Bugs\n\ section of the Emacs manual or the file BUGS.\n" }; @@ -387,13 +394,26 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) { register int i; Lisp_Object name, dir, handler; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object raw_name; initial_argv = argv; initial_argc = argc; +#ifdef WINDOWSNT + /* Must use argv[0] converted to UTF-8, as it begets many standard + file and directory names. */ + { + char argv0[MAX_UTF8_PATH]; + + if (filename_from_ansi (argv[0], argv0) == 0) + raw_name = build_unibyte_string (argv0); + else + raw_name = build_unibyte_string (argv[0]); + } +#else raw_name = build_unibyte_string (argv[0]); +#endif /* Add /: to the front of the name if it would otherwise be treated as magic. */ @@ -410,7 +430,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) { Lisp_Object found; int yes = openp (Vexec_path, Vinvocation_name, - Vexec_suffixes, &found, make_number (X_OK)); + Vexec_suffixes, &found, make_number (X_OK), false); if (yes == 1) { /* Add /: to the front of the name @@ -533,7 +553,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) = Fcons (build_unibyte_string (argv[i]), Vcommand_line_args); } - unbind_to (count, Qnil); + dynwind_end (); } DEFUN ("invocation-name", Finvocation_name, Sinvocation_name, 0, 0, 0, @@ -651,9 +671,7 @@ malloc_initialize_hook (void) } malloc_set_state (malloc_state_ptr); -#ifndef XMALLOC_OVERRUN_CHECK free (malloc_state_ptr); -#endif } else { @@ -682,14 +700,31 @@ close_output_streams (void) _exit (EXIT_FAILURE); } -/* ARGSUSED */ +static Lisp_Object +string_from_scheme (Lisp_Object scheme_string) +{ + size_t nbytes; + char *c_string = scm_to_utf8_stringn (scheme_string, &nbytes); + return make_string_from_bytes (c_string, + scm_c_string_length (scheme_string), + nbytes); +} + +Lisp_Object xsymbol_fn; +Lisp_Object symbol_function_fn; + +static int main2 (void *, int, char **); + int main (int argc, char **argv) { -#if GC_MARK_STACK - Lisp_Object dummy; -#endif - char stack_bottom_variable; + scm_boot_guile (argc, argv, main2, NULL); +} + +/* ARGSUSED */ +static int +main2 (void *ignore, int argc, char **argv) +{ bool do_initial_setlocale; bool dumping; int skip_args = 0; @@ -707,16 +742,16 @@ main (int argc, char **argv) /* If we use --chdir, this records the original directory. */ char *original_pwd = 0; -#if GC_MARK_STACK - stack_base = &dummy; -#endif - #ifdef G_SLICE_ALWAYS_MALLOC /* This is used by the Cygwin build. It's not needed starting with cygwin-1.7.24, but it doesn't do any harm. */ xputenv ("G_SLICE=always-malloc"); #endif +#ifndef CANNOT_DUMP + might_dump = !initialized; +#endif + #ifdef GNU_LINUX if (!initialized) { @@ -735,6 +770,12 @@ main (int argc, char **argv) early as possible. (unexw32.c calls this function as well, but the additional call here is harmless.) */ cache_system_info (); +#ifdef WINDOWSNT + /* On Windows 9X, we have to load UNICOWS.DLL as early as possible, + to have non-stub implementations of APIs we need to convert file + names between UTF-8 and the system's ANSI codepage. */ + maybe_load_unicows_dll (); +#endif #endif #ifdef RUN_TIME_REMAP @@ -795,6 +836,14 @@ main (int argc, char **argv) if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)) { +#ifdef WINDOWSNT + /* argv[] array is kept in its original ANSI codepage encoding, + we need to convert to UTF-8, for chdir to work. */ + char newdir[MAX_UTF8_PATH]; + + filename_from_ansi (ch_to_dir, newdir); + ch_to_dir = newdir; +#endif original_pwd = get_current_dir_name (); if (chdir (ch_to_dir) != 0) { @@ -866,9 +915,6 @@ main (int argc, char **argv) } #endif /* HAVE_SETRLIMIT and RLIMIT_STACK */ - /* Record (approximately) where the stack begins. */ - stack_bottom = &stack_bottom_variable; - clearerr (stdin); #ifndef SYSTEM_MALLOC @@ -972,11 +1018,14 @@ main (int argc, char **argv) { int i; printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]); - for (i = 0; i < sizeof usage_message / sizeof *usage_message; i++) + for (i = 0; i < ARRAYELTS (usage_message); i++) fputs (usage_message[i], stdout); exit (0); } + /* Make sure IS_DAEMON starts up as false. */ + daemon_pipe[1] = 0; + if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args) || argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, &skip_args)) { @@ -1077,6 +1126,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem argv[skip_args] = fdStr; + fcntl (daemon_pipe[0], F_SETFD, 0); + fcntl (daemon_pipe[1], F_SETFD, 0); execvp (argv[0], argv); emacs_perror (argv[0]); exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); @@ -1093,6 +1144,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]), dname_arg2); dname_arg = *dname_arg2 ? dname_arg2 : NULL; + fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC); } #endif /* DAEMON_MUST_EXEC */ @@ -1127,7 +1179,31 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { + /* scm_c_module_define (scm_c_resolve_module ("language elisp lexer"), */ + /* "make-lisp-string", */ + /* scm_c_make_gsubr ("make-lisp-string", 1, 0, 0, */ + /* string_from_scheme)); */ + (void *) scm_c_resolve_module ("language elisp spec"); + symbol_module = scm_c_resolve_module ("elisp-symbols"); + function_module = scm_c_resolve_module ("elisp-functions"); + plist_module = scm_c_resolve_module ("elisp-plists"); + scm_set_current_module (scm_c_resolve_module ("guile-user")); + init_alloc_once (); + + scm_c_module_define (scm_c_resolve_module ("language elisp runtime"), + "make-lisp-string", + scm_c_make_gsubr ("make-lisp-string", 1, 0, 0, + string_from_scheme)); + scm_c_module_define (scm_c_resolve_module ("language elisp runtime"), + "lisp-string?", + scm_c_make_gsubr ("stringp", 1, 0, 0, Fstringp)); + + xsymbol_fn = scm_c_public_ref ("language elisp runtime", "symbol-desc"); + symbol_function_fn = scm_c_public_ref ("language elisp runtime", "symbol-function"); + + init_guile (); + init_fns_once (); init_obarray (); init_eval_once (); init_charset_once (); @@ -1139,6 +1215,20 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_minibuf_once (); /* Create list of minibuffers. */ /* Must precede init_window_once. */ + /* Called before syms_of_fileio, because it sets up + Qerror_condition. Called before other symbol-initialization + functions because it sets up symbols used by defsubr. */ + syms_of_data (); + + scm_call_7 (scm_c_public_ref ("language elisp runtime", "emacs!"), + SYMBOL_FUNCTION (intern ("symbol-value")), + SYMBOL_FUNCTION (intern ("set")), + SYMBOL_FUNCTION (intern ("boundp")), + SYMBOL_FUNCTION (intern ("default-value")), + SYMBOL_FUNCTION (intern ("set-default")), + SYMBOL_FUNCTION (intern ("default-boundp")), + SYMBOL_FUNCTION (intern ("bind-symbol"))); + /* Call syms_of_xfaces before init_window_once because that function creates Vterminal_frame. Termcap frames now use faces, and the face implementation uses some symbols as @@ -1153,8 +1243,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem CANNOT_DUMP is defined. */ syms_of_keyboard (); - /* Called before syms_of_fileio, because it sets up Qerror_condition. */ - syms_of_data (); syms_of_fns (); /* Before syms_of_charset which uses hashtables. */ syms_of_fileio (); /* Before syms_of_coding to initialize Vgc_cons_threshold. */ @@ -1196,7 +1284,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_NS ns_pool = ns_alloc_autorelease_pool (); #ifdef NS_IMPL_GNUSTEP - /* GNUStep stupidly resets our locale settings after we made them. */ + /* GNUstep stupidly resets our locale settings after we made them. */ fixup_locale (); #endif @@ -1334,7 +1422,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem xputenv ("LANG=C"); #endif - init_buffer (); /* Init default directory of main buffer. */ + /* Init buffer storage and default directory of main buffer. */ + init_buffer (initialized); init_callproc_1 (); /* Must precede init_cmdargs and init_sys_modes. */ @@ -1373,7 +1462,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_floatfns (); syms_of_buffer (); - syms_of_bytecode (); syms_of_callint (); syms_of_casefiddle (); syms_of_casetab (); @@ -1491,8 +1579,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif /* HAVE_W32NOTIFY */ #endif /* WINDOWSNT */ - syms_of_profiler (); - keys_of_casefiddle (); keys_of_cmds (); keys_of_buffer (); @@ -1539,7 +1625,16 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem char *file; /* Handle -l loadup, args passed by Makefile. */ if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args)) - Vtop_level = list2 (intern_c_string ("load"), build_string (file)); + { +#ifdef WINDOWSNT + char file_utf8[MAX_UTF8_PATH]; + + if (filename_from_ansi (file, file_utf8) == 0) + file = file_utf8; +#endif + Vtop_level = list2 (intern_c_string ("load"), + build_unibyte_string (file)); + } /* Unless next switch is -nl, load "loadup.el" first thing. */ if (! no_loadup) Vtop_level = list2 (intern_c_string ("load"), @@ -1683,7 +1778,6 @@ static const struct standard_args standard_args[] = #ifdef HAVE_NS { "-NSAutoLaunch", 0, 5, 1 }, { "-NXAutoLaunch", 0, 5, 1 }, - { "-disable-font-backend", "--disable-font-backend", 65, 0 }, { "-_NSMachLaunch", 0, 85, 1 }, { "-MachLaunch", 0, 85, 1 }, { "-macosx", 0, 85, 0 }, @@ -1736,8 +1830,8 @@ sort_args (int argc, char **argv) 0 for an option that takes no arguments, 1 for an option that takes one argument, etc. -1 for an ordinary non-option argument. */ - int *options = xnmalloc (argc, sizeof *options); - int *priority = xnmalloc (argc, sizeof *priority); + int *options = xnmalloc_atomic (argc, sizeof *options); + int *priority = xnmalloc_atomic (argc, sizeof *priority); int to = 1; int incoming_used = 1; int from; @@ -1767,7 +1861,7 @@ sort_args (int argc, char **argv) } /* Look for a match with a known old-fashioned option. */ - for (i = 0; i < sizeof (standard_args) / sizeof (standard_args[0]); i++) + for (i = 0; i < ARRAYELTS (standard_args); i++) if (!strcmp (argv[from], standard_args[i].name)) { options[from] = standard_args[i].nargs; @@ -1789,8 +1883,7 @@ sort_args (int argc, char **argv) match = -1; - for (i = 0; - i < sizeof (standard_args) / sizeof (standard_args[0]); i++) + for (i = 0; i < ARRAYELTS (standard_args); i++) if (standard_args[i].longname && !strncmp (argv[from], standard_args[i].longname, thislen)) @@ -1983,13 +2076,10 @@ shut_down_emacs (int sig, Lisp_Object stuff) kill_buffer_processes (Qnil); Fdo_auto_save (Qt, Qnil); -#ifdef CLASH_DETECTION unlock_all_files (); -#endif /* There is a tendency for a SIGIO signal to arrive within exit, and cause a SIGHUP because the input descriptor is already closed. */ - unrequest_sigio (); ignore_sigio (); /* Do this only if terminating normally, we want glyph matrices @@ -2033,13 +2123,16 @@ You must run Emacs in batch mode in order to dump it. */) { Lisp_Object tem; Lisp_Object symbol; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); check_pure_size (); if (! noninteractive) error ("Dumping Emacs works only in batch mode"); + if (!might_dump) + error ("Emacs can be dumped only once"); + #ifdef GNU_LINUX /* Warn if the gap between BSS end and heap start is larger than this. */ @@ -2105,13 +2198,8 @@ You must run Emacs in batch mode in order to dump it. */) malloc_state_ptr = malloc_get_state (); #endif -#ifdef USE_MMAP_FOR_BUFFERS - mmap_set_vars (0); -#endif unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0); -#ifdef USE_MMAP_FOR_BUFFERS - mmap_set_vars (1); -#endif + #ifdef DOUG_LEA_MALLOC free (malloc_state_ptr); #endif @@ -2125,7 +2213,8 @@ You must run Emacs in batch mode in order to dump it. */) Vpurify_flag = tem; - return unbind_to (count, Qnil); + dynwind_end (); + return Qnil; } #endif /* not CANNOT_DUMP */ @@ -2185,9 +2274,16 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) Lisp_Object empty_element = empty ? Qnil : build_string ("."); #ifdef WINDOWSNT bool defaulted = 0; - const char *emacs_dir = egetenv ("emacs_dir"); static const char *emacs_dir_env = "%emacs_dir%/"; const size_t emacs_dir_len = strlen (emacs_dir_env); + const char *edir = egetenv ("emacs_dir"); + char emacs_dir[MAX_UTF8_PATH]; + + /* egetenv looks in process-environment, which holds the variables + in their original system-locale encoding. We need emacs_dir to + be in UTF-8. */ + if (edir) + filename_from_ansi (edir, emacs_dir); #endif /* It's okay to use getenv here, because this function is only used @@ -2208,9 +2304,44 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) /* Ensure values from the environment use the proper directory separator. */ if (path) { - char *path_copy = alloca (strlen (path) + 1); + char *path_copy; + +#ifdef WINDOWSNT + char *path_utf8, *q, *d; + int cnv_result; + + /* Convert each element of PATH to UTF-8. */ + p = path_copy = alloca (strlen (path) + 1); + strcpy (path_copy, path); + d = path_utf8 = alloca (4 * strlen (path) + 1); + *d = '\0'; + do { + q = _mbschr (p, SEPCHAR); + if (q) + *q = '\0'; + cnv_result = filename_from_ansi (p, d); + if (q) + { + *q++ = SEPCHAR; + p = q; + /* If conversion of this PATH elements fails, make sure + destination pointer will stay put, thus effectively + ignoring the offending element. */ + if (cnv_result == 0) + { + d += strlen (d); + *d++ = SEPCHAR; + } + } + else if (cnv_result != 0 && d > path_utf8) + d[-1] = '\0'; /* remove last semi-colon and null-terminate PATH */ + } while (q); + path_copy = path_utf8; +#else /* MSDOS */ + path_copy = alloca (strlen (path) + 1); strcpy (path_copy, path); - dostounix_filename (path_copy, 0); +#endif + dostounix_filename (path_copy); path = path_copy; } #endif @@ -2227,7 +2358,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) #ifdef WINDOWSNT /* Relative file names in the default path are interpreted as being relative to $emacs_dir. */ - if (emacs_dir && defaulted + if (edir && defaulted && strncmp (path, emacs_dir_env, emacs_dir_len) == 0) element = Fexpand_file_name (Fsubstring (element, @@ -2323,22 +2454,13 @@ from the parent process and its tty file descriptors. */) void syms_of_emacs (void) { +#include "emacs.x" + DEFSYM (Qfile_name_handler_alist, "file-name-handler-alist"); DEFSYM (Qrisky_local_variable, "risky-local-variable"); DEFSYM (Qkill_emacs, "kill-emacs"); DEFSYM (Qkill_emacs_hook, "kill-emacs-hook"); -#ifndef CANNOT_DUMP - defsubr (&Sdump_emacs); -#endif - - defsubr (&Skill_emacs); - - defsubr (&Sinvocation_name); - defsubr (&Sinvocation_directory); - defsubr (&Sdaemonp); - defsubr (&Sdaemon_initialized); - DEFVAR_LISP ("command-line-args", Vcommand_line_args, doc: /* Args passed by shell to Emacs, as a list of strings. Many arguments are deleted from the list as they are processed. */); @@ -2368,6 +2490,12 @@ Emacs is running. */); doc: /* String containing the configuration options Emacs was built with. */); Vsystem_configuration_options = build_string (EMACS_CONFIG_OPTIONS); + DEFVAR_LISP ("system-configuration-features", Vsystem_configuration_features, + doc: /* String listing some of the main features this Emacs was compiled with. +An element of the form \"FOO\" generally means that HAVE_FOO was +defined during the build. */); + Vsystem_configuration_features = build_string (EMACS_CONFIG_FEATURES); + DEFVAR_BOOL ("noninteractive", noninteractive1, doc: /* Non-nil means Emacs is running without interactive terminal. */); @@ -2445,6 +2573,10 @@ This is nil during initialization. */); doc: /* Version numbers of this version of Emacs. */); Vemacs_version = build_string (emacs_version); + DEFVAR_LISP ("report-emacs-bug-address", Vreport_emacs_bug_address, + doc: /* Address of mailing list for GNU Emacs bugs. */); + Vreport_emacs_bug_address = build_string (emacs_bugreport); + DEFVAR_LISP ("dynamic-library-alist", Vdynamic_library_alist, doc: /* Alist of dynamic libraries vs external files implementing them. Each element is a list (LIBRARY FILE...), where the car is a symbol @@ -2467,7 +2599,4 @@ libraries; only those already known by Emacs will be loaded. */); Vlibrary_cache = Qnil; staticpro (&Vlibrary_cache); #endif - - /* Make sure IS_DAEMON starts up as false. */ - daemon_pipe[1] = 0; }