X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/94ae1542354539a0660b21cf3b7a5143139b8375..41120e0f595b16387eebfbf731fff70481de1b4b:/src/emacs.c?ds=sidebyside diff --git a/src/emacs.c b/src/emacs.c index 9f41bc251e..1f910efe56 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 @@ -80,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 @@ -105,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; @@ -121,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 @@ -132,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; @@ -160,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; @@ -210,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[] = { "\ @@ -321,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" }; @@ -388,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. */ @@ -411,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 @@ -534,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, @@ -652,9 +671,7 @@ malloc_initialize_hook (void) } malloc_set_state (malloc_state_ptr); -#ifndef XMALLOC_OVERRUN_CHECK free (malloc_state_ptr); -#endif } else { @@ -683,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; @@ -708,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) { @@ -736,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 @@ -796,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) { @@ -867,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 @@ -973,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)) { @@ -1078,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); @@ -1094,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 */ @@ -1128,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 (); @@ -1140,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 @@ -1154,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,6 +1283,11 @@ 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. */ + fixup_locale (); +#endif + if (!noninteractive) { #ifdef NS_IMPL_COCOA @@ -1330,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. */ @@ -1369,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 (); @@ -1487,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 (); @@ -1518,6 +1608,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_keyboard (); /* This too must precede init_sys_modes. */ if (!noninteractive) init_display (); /* Determine terminal type. Calls init_sys_modes. */ +#if HAVE_W32NOTIFY + else + init_crit (); /* w32notify.c needs this in batch mode. */ +#endif /* HAVE_W32NOTIFY */ init_xdisp (); #ifdef HAVE_WINDOW_SYSTEM init_fringe (); @@ -1531,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"), @@ -1675,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 }, @@ -1728,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; @@ -1759,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; @@ -1781,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)) @@ -1975,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 @@ -2025,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. */ @@ -2097,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 @@ -2117,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 */ @@ -2168,10 +2265,13 @@ synchronize_system_messages_locale (void) Lisp_Object -decode_env_path (const char *evarname, const char *defalt) +decode_env_path (const char *evarname, const char *defalt, bool empty) { const char *path, *p; Lisp_Object lpath, element, tem; + /* Default is to use "." for empty path elements. + But if argument EMPTY is true, use nil instead. */ + Lisp_Object empty_element = empty ? Qnil : build_string ("."); #ifdef WINDOWSNT bool defaulted = 0; static const char *emacs_dir_env = "%emacs_dir%/"; @@ -2182,7 +2282,8 @@ decode_env_path (const char *evarname, const char *defalt) /* egetenv looks in process-environment, which holds the variables in their original system-locale encoding. We need emacs_dir to be in UTF-8. */ - filename_from_ansi (edir, emacs_dir); + if (edir) + filename_from_ansi (edir, emacs_dir); #endif /* It's okay to use getenv here, because this function is only used @@ -2251,34 +2352,38 @@ decode_env_path (const char *evarname, const char *defalt) if (!p) p = path + strlen (path); element = (p - path ? make_unibyte_string (path, p - path) - : build_string (".")); + : empty_element); + if (! NILP (element)) + { #ifdef WINDOWSNT - /* Relative file names in the default path are interpreted as - being relative to $emacs_dir. */ - if (emacs_dir && defaulted - && strncmp (path, emacs_dir_env, emacs_dir_len) == 0) - element = Fexpand_file_name (Fsubstring (element, - make_number (emacs_dir_len), - Qnil), - build_unibyte_string (emacs_dir)); -#endif - - /* Add /: to the front of the name - if it would otherwise be treated as magic. */ - tem = Ffind_file_name_handler (element, Qt); - - /* However, if the handler says "I'm safe", - don't bother adding /:. */ - if (SYMBOLP (tem)) - { - Lisp_Object prop; - prop = Fget (tem, intern ("safe-magic")); - if (! NILP (prop)) - tem = Qnil; - } + /* Relative file names in the default path are interpreted as + being relative to $emacs_dir. */ + if (edir && defaulted + && strncmp (path, emacs_dir_env, emacs_dir_len) == 0) + element = Fexpand_file_name (Fsubstring + (element, + make_number (emacs_dir_len), + Qnil), + build_unibyte_string (emacs_dir)); +#endif + + /* Add /: to the front of the name + if it would otherwise be treated as magic. */ + tem = Ffind_file_name_handler (element, Qt); + + /* However, if the handler says "I'm safe", + don't bother adding /:. */ + if (SYMBOLP (tem)) + { + Lisp_Object prop; + prop = Fget (tem, intern ("safe-magic")); + if (! NILP (prop)) + tem = Qnil; + } - if (! NILP (tem)) - element = concat2 (build_string ("/:"), element); + if (! NILP (tem)) + element = concat2 (build_string ("/:"), element); + } /* !NILP (element) */ lpath = Fcons (element, lpath); if (*p) @@ -2349,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. */); @@ -2394,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. */); @@ -2431,7 +2533,8 @@ both `lib-src' (on MS-DOS, `info') and `etc' directories are found within the variable `invocation-directory' or its parent. For example, this is the case when running an uninstalled Emacs executable from its build directory. */); - Vinstallation_directory = Qnil; + if (!Vinstallation_directory) + Vinstallation_directory = Qnil; DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale, doc: /* System locale for messages. */); @@ -2471,6 +2574,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 @@ -2493,7 +2600,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; }