Now on revision 108436. ------------------------------------------------------------ revno: 108436 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-30 23:51:43 -0700 message: Pacify gcc -Wdouble-precision when using Xaw. * xterm.c (xaw_jump_callback, x_set_toolkit_scroll_bar_thumb) [HAVE_X_WINDOWS && USE_TOOLKIT_SCROLL_BARS && !USE_MOTIF && !USE_GTK]: Use 'float' consistently, rather than 'float' in most places and 'double' in a couple of places. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-31 06:06:42 +0000 +++ src/ChangeLog 2012-05-31 06:51:43 +0000 @@ -1,3 +1,11 @@ +2012-05-31 Paul Eggert + + Pacify gcc -Wdouble-precision when using Xaw. + * xterm.c (xaw_jump_callback, x_set_toolkit_scroll_bar_thumb) + [HAVE_X_WINDOWS && USE_TOOLKIT_SCROLL_BARS && !USE_MOTIF && !USE_GTK]: + Use 'float' consistently, rather than 'float' in most places + and 'double' in a couple of places. + 2012-05-31 Eli Zaretskii * xdisp.c (handle_stop): Detect whether we have overlay strings === modified file 'src/xterm.c' --- src/xterm.c 2012-05-31 05:08:37 +0000 +++ src/xterm.c 2012-05-31 06:51:43 +0000 @@ -4529,7 +4529,7 @@ whole = 10000000; portion = shown < 1 ? top * whole : 0; - if (shown < 1 && (eabs (top + shown - 1) < 1.0/height)) + if (shown < 1 && (eabs (top + shown - 1) < 1.0f / height)) /* Some derivatives of Xaw refuse to shrink the thumb when you reach the bottom, so we force the scrolling whenever we see that we're too close to the bottom (in x_set_toolkit_scroll_bar_thumb @@ -4894,7 +4894,7 @@ else top = old_top; /* Keep two pixels available for moving the thumb down. */ - shown = max (0, min (1 - top - (2.0 / height), shown)); + shown = max (0, min (1 - top - (2.0f / height), shown)); /* If the call to XawScrollbarSetThumb below doesn't seem to work, check that your system's configuration file contains a define ------------------------------------------------------------ revno: 108435 [merge] committer: Chong Yidong branch nick: trunk timestamp: Thu 2012-05-31 14:08:06 +0800 message: Merge from emacs-24; up to r108025 diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-05-30 03:59:42 +0000 +++ lib-src/ChangeLog 2012-05-31 06:08:06 +0000 @@ -1,3 +1,9 @@ +2012-05-31 Eli Zaretskii + + * makefile.w32-in ($(BLD)/emacsclientw.exe): Use $(MWINDOWS) + instead of a literal -mwindows, which is not supported by MSVC. + (Bug#11405) + 2012-05-30 Stefan Monnier * make-docfile.c: Improve comment style. === modified file 'lib-src/makefile.w32-in' --- lib-src/makefile.w32-in 2012-05-22 16:20:27 +0000 +++ lib-src/makefile.w32-in 2012-05-31 06:06:42 +0000 @@ -65,7 +65,7 @@ $(BLD)/emacsclientw.exe: $(ECLIENTOBJS) $(CLIENTRES) # put wsock32.lib before $(LIBS) to ensure we don't link to ws2_32.lib - $(LINK) $(LINK_OUT)$@ $(CLIENTRES) -mwindows $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(USER32) $(COMCTL32) $(LIBS) + $(LINK) $(LINK_OUT)$@ $(CLIENTRES) $(MWINDOWS) $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(USER32) $(COMCTL32) $(LIBS) $(BLD)/emacsclient.$(O): emacsclient.c $(CC) $(CFLAGS) $(ECLIENT_CFLAGS) $(CC_OUT)$@ emacsclient.c === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-31 01:41:17 +0000 +++ lisp/ChangeLog 2012-05-31 06:06:42 +0000 @@ -1,5 +1,21 @@ 2012-05-31 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-fix-header): Handle + arbitrary file name lengths (Bug#11585). + +2012-05-31 Martin Rudalics + + * desktop.el (desktop-read): Clear previous and next buffers for + all windows and bury *Messages* buffer (bug#11556). + +2012-05-31 Eli Zaretskii + + * mail/sendmail.el (mail-yank-region): Recognize + rmail-yank-current-message in addition to insert-buffer. Fixes + mail-mode's "C-c C-r" that otherwise does nothing when invoked in + +2012-05-31 Stefan Monnier + Add `declare' for `defun'. Align `defmacro's with it. * emacs-lisp/easy-mmode.el (define-minor-mode) (define-globalized-minor-mode): Don't autoload the var definitions. === modified file 'lisp/desktop.el' --- lisp/desktop.el 2012-05-13 03:05:06 +0000 +++ lisp/desktop.el 2012-05-31 06:06:42 +0000 @@ -1020,6 +1020,18 @@ (format ", %d to restore lazily" (length desktop-buffer-args-list)) "")) + ;; Bury the *Messages* buffer to not reshow it when burying + ;; the buffer we switched to above. + (when (buffer-live-p (get-buffer "*Messages*")) + (bury-buffer "*Messages*")) + ;; Clear all windows' previous and next buffers, these have + ;; been corrupted by the `switch-to-buffer' calls in + ;; `desktop-restore-file-buffer' (bug#11556). This is a + ;; brute force fix and should be replaced by a more subtle + ;; strategy eventually. + (walk-window-tree (lambda (window) + (set-window-prev-buffers window nil) + (set-window-next-buffers window nil))) t)) ;; No desktop file found. (desktop-clear) === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-05-30 03:59:42 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-05-31 06:06:42 +0000 @@ -1937,7 +1937,7 @@ (byte-compile-fix-header byte-compile-current-file)))) byte-compile--outbuffer))) -(defun byte-compile-fix-header (filename) +(defun byte-compile-fix-header (_filename) "If the current buffer has any multibyte characters, insert a version test." (when (< (point-max) (position-bytes (point-max))) (goto-char (point-min)) @@ -1962,12 +1962,10 @@ ;; don't try to check the version number. " (< (aref emacs-version (1- (length emacs-version))) ?A)\n" (format " (string-lessp emacs-version \"%s\")\n" minimum-version) - " (error \"`" - ;; prin1-to-string is used to quote backslashes. - (substring (prin1-to-string (file-name-nondirectory filename)) - 1 -1) - (format "' was compiled for Emacs %s or later\"))\n\n" - minimum-version)) + ;; Because the header must fit in a fixed width, we cannot + ;; insert arbitrary-length file names (Bug#11585). + " (error \"`%s' was compiled for " + (format "Emacs %s or later\" load-file-name))\n\n" minimum-version)) ;; Now compensate for any change in size, to make sure all ;; positions in the file remain valid. (setq delta (- (point-max) old-header-end)) === modified file 'nt/ChangeLog' --- nt/ChangeLog 2012-05-28 17:00:18 +0000 +++ nt/ChangeLog 2012-05-31 06:06:42 +0000 @@ -1,3 +1,20 @@ +2012-05-31 Eli Zaretskii + + * configure.bat (genmakefiles): Move the redirection away from the + end of the command, to avoid excess whitespace at the end of Make + variables created at configure time, and also avoid things like + "FOO1>>config.settings", where "1" gets interpreted as the file + descriptor and eaten up. This fixes breakage introduced by the + last change, without reintroducing the bug fixed by that change. + +2012-05-31 Eli Zaretskii + + * nmake.defs (MWINDOWS): Define as + "-subsystem:windows -entry:mainCRTStartup". Suggested by Fabrice + Popineau . (Bug#11405) + + * gmake.defs (MWINDOWS): Define as "-mwindows". + 2012-05-28 Eli Zaretskii * config.nt (HAVE_SYSINFO): Remove; unused. === modified file 'nt/configure.bat' --- nt/configure.bat 2012-05-27 01:06:44 +0000 +++ nt/configure.bat 2012-05-31 06:06:42 +0000 @@ -753,29 +753,36 @@ if %COMPILER% == cl set MAKECMD=nmake rem Pass on chosen settings to makefiles. -rem NB. Be very careful to not have a space before redirection symbols -rem except when there is a preceding digit, when a space is required. rem +rem The weird place we put the redirection is to make sure no extra +rem whitespace winds up at the end of the Make variables, since some +rem variables, e.g. INSTALL_DIR, cannot stand that. Yes, echo will +rem write the blanks between the end of command arguments and the +rem redirection symbol to the file. OTOH, we cannot put the +rem redirection immediately after the last character of the command, +rem because environment variable expansion can yield a digit there, +rem which will then be misinterpreted as the file descriptor to +rem redirect... echo # Start of settings from configure.bat >config.settings -echo COMPILER=%COMPILER% >>config.settings -if not "(%mf%)" == "()" echo MCPU_FLAG=%mf% >>config.settings -if not "(%dbginfo%)" == "()" echo DEBUG_INFO=%dbginfo% >>config.settings -if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings -if (%noopt%) == (Y) echo NOOPT=1 >>config.settings -if (%enablechecking%) == (Y) echo ENABLECHECKS=1 >>config.settings -if (%profile%) == (Y) echo PROFILE=1 >>config.settings -if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings -if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix% >>config.settings -if not "(%distfiles%)" == "()" echo DIST_FILES=%distfiles% >>config.settings +>>config.settings echo COMPILER=%COMPILER% +if not "(%mf%)" == "()" >>config.settings echo MCPU_FLAG=%mf% +if not "(%dbginfo%)" == "()" >>config.settings echo DEBUG_INFO=%dbginfo% +if (%nodebug%) == (Y) >>config.settings echo NODEBUG=1 +if (%noopt%) == (Y) >>config.settings echo NOOPT=1 +if (%enablechecking%) == (Y) >>config.settings echo ENABLECHECKS=1 +if (%profile%) == (Y) >>config.settings echo PROFILE=1 +if (%nocygwin%) == (Y) >>config.settings echo NOCYGWIN=1 +if not "(%prefix%)" == "()" >>config.settings echo INSTALL_DIR=%prefix% +if not "(%distfiles%)" == "()" >>config.settings echo DIST_FILES=%distfiles% rem We go thru docflags because usercflags could be "-DFOO=bar" -something rem and the if command cannot cope with this for %%v in (%usercflags%) do if not (%%v)==() set docflags=Y -if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags% >>config.settings -if (%docflags%)==(Y) echo ESC_USER_CFLAGS=%escusercflags% >>config.settings +if (%docflags%)==(Y) >>config.settings echo USER_CFLAGS=%usercflags% +if (%docflags%)==(Y) >>config.settings echo ESC_USER_CFLAGS=%escusercflags% for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y -if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags% >>config.settings +if (%doldflags%)==(Y) >>config.settings echo USER_LDFLAGS=%userldflags% for %%v in (%extrauserlibs%) do if not (%%v)==() set doextralibs=Y -if (%doextralibs%)==(Y) echo USER_LIBS=%extrauserlibs% >>config.settings +if (%doextralibs%)==(Y) >>config.settings echo USER_LIBS=%extrauserlibs% echo # End of settings from configure.bat>>config.settings echo. >>config.settings === modified file 'nt/gmake.defs' --- nt/gmake.defs 2012-03-25 18:17:46 +0000 +++ nt/gmake.defs 2012-05-29 16:15:12 +0000 @@ -210,6 +210,8 @@ CHECKING_CFLAGS = endif +MWINDOWS = -mwindows + CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS) ESC_CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS) EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1 === modified file 'nt/nmake.defs' --- nt/nmake.defs 2012-03-25 18:17:46 +0000 +++ nt/nmake.defs 2012-05-29 16:15:12 +0000 @@ -151,6 +151,8 @@ CHECKING_CFLAGS = !endif +MWINDOWS = -subsystem:windows -entry:mainCRTStartup + CFLAGS = -I. $(ARCH_CFLAGS) \ $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS) ESC_CFLAGS = -I. $(ARCH_CFLAGS) \ === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-31 05:08:37 +0000 +++ src/ChangeLog 2012-05-31 06:06:42 +0000 @@ -1,3 +1,34 @@ +2012-05-31 Eli Zaretskii + + * xdisp.c (handle_stop): Detect whether we have overlay strings + loaded by testing it->current.overlay_string_index to be + non-negative, instead of checking whether n_overlay_strings is + positive. (Bug#11587) + +2012-05-31 Chong Yidong + + * keymap.c (describe_map_tree): Revert 2011-07-07 change (Bug#1169). + + * doc.c (Fsubstitute_command_keys): Doc fix. + +2012-05-31 Eli Zaretskii + + * search.c (search_buffer): Remove calls to + r_alloc_inhibit_buffer_relocation, as it is now called by + maybe_unify_char, which was the cause of relocation of buffer text + in bug#11519. + +2012-05-31 Eli Zaretskii + + * charset.c (maybe_unify_char): Inhibit relocation of buffer text + for the duration of call to load_charset, to avoid problems with + callers of maybe_unify_char that access buffer text through C + pointers. + + * ralloc.c (r_alloc_inhibit_buffer_relocation): Increment and + decrement the inhibition flag, instead of just setting or + resetting it. + 2012-05-31 Paul Eggert Remove obsolete '#define static' cruft. === modified file 'src/charset.c' --- src/charset.c 2012-04-09 22:54:59 +0000 +++ src/charset.c 2012-05-31 06:06:42 +0000 @@ -1633,6 +1633,12 @@ return c; CHECK_CHARSET_GET_CHARSET (val, charset); +#ifdef REL_ALLOC + /* The call to load_charset below can allocate memory, which screws + callers of this function through STRING_CHAR_* macros that hold C + pointers to buffer text, if REL_ALLOC is used. */ + r_alloc_inhibit_buffer_relocation (1); +#endif load_charset (charset, 1); if (! inhibit_load_charset_map) { @@ -1648,6 +1654,9 @@ if (unified > 0) c = unified; } +#ifdef REL_ALLOC + r_alloc_inhibit_buffer_relocation (0); +#endif return c; } === modified file 'src/doc.c' --- src/doc.c 2012-04-09 22:54:59 +0000 +++ src/doc.c 2012-05-31 06:06:42 +0000 @@ -705,18 +705,23 @@ DEFUN ("substitute-command-keys", Fsubstitute_command_keys, Ssubstitute_command_keys, 1, 1, 0, doc: /* Substitute key descriptions for command names in STRING. -Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke -sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not -on any keys. -Substrings of the form \\=\\{MAPVAR} are replaced by summaries -\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap. -Substrings of the form \\=\\ specify to use the value of MAPVAR +Each substring of the form \\=\\[COMMAND] is replaced by either a +keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND +is not on any keys. + +Each substring of the form \\=\\{MAPVAR} is replaced by a summary of +the value of MAPVAR as a keymap. This summary is similar to the one +produced by `describe-bindings'. The summary ends in two newlines +\(used by the helper function `help-make-xrefs' to find the end of the +summary). + +Each substring of the form \\=\\ specifies the use of MAPVAR as the keymap for future \\=\\[COMMAND] substrings. \\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. -Returns original STRING if no substitutions were made. Otherwise, -a new string, without any text properties, is returned. */) +Return the original STRING if no substitutions are made. +Otherwise, return a new string, without any text properties. */) (Lisp_Object string) { char *buf; === modified file 'src/keymap.c' --- src/keymap.c 2012-05-25 18:19:24 +0000 +++ src/keymap.c 2012-05-31 06:06:42 +0000 @@ -2996,9 +2996,9 @@ If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW, don't omit it; instead, mention it but say it is shadowed. - Return whether something was inserted or not. */ + Any inserted text ends in two newlines (used by `help-make-xrefs'). */ -int +void describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow, Lisp_Object prefix, const char *title, int nomenu, int transl, int always_title, int mention_shadow) @@ -3108,8 +3108,10 @@ skip: ; } + if (something) + insert_string ("\n"); + UNGCPRO; - return something; } static int previous_description_column; === modified file 'src/keymap.h' --- src/keymap.h 2012-01-19 07:21:25 +0000 +++ src/keymap.h 2012-05-30 14:08:58 +0000 @@ -47,7 +47,7 @@ extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, int, int, int); extern Lisp_Object get_keymap (Lisp_Object, int, int); EXFUN (Fset_keymap_parent, 2); -extern int describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object, +extern void describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object, const char *, int, int, int, int); extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); extern void initial_define_key (Lisp_Object, int, const char *); === modified file 'src/ralloc.c' --- src/ralloc.c 2012-05-27 01:06:44 +0000 +++ src/ralloc.c 2012-05-31 06:06:42 +0000 @@ -1142,7 +1142,12 @@ void r_alloc_inhibit_buffer_relocation (int inhibit) { - use_relocatable_buffers = !inhibit; + if (use_relocatable_buffers < 0) + use_relocatable_buffers = 0; + if (inhibit) + use_relocatable_buffers++; + else if (use_relocatable_buffers > 0) + use_relocatable_buffers--; } === modified file 'src/search.c' --- src/search.c 2012-05-27 01:06:44 +0000 +++ src/search.c 2012-05-31 06:06:42 +0000 @@ -1160,24 +1160,12 @@ { ptrdiff_t val; -#ifdef REL_ALLOC - /* re_search_2 below is passed C pointers to buffer text. - If some code called by it causes memory (re)allocation, - buffer text could be relocated on platforms that use - REL_ALLOC, which invalidates those C pointers. So we - inhibit relocation of buffer text for as long as - re_search_2 runs. */ - r_alloc_inhibit_buffer_relocation (1); -#endif val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), /* Don't allow match past current point */ pos_byte - BEGV_BYTE); -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif if (val == -2) { matcher_overflow (); @@ -1217,19 +1205,11 @@ { ptrdiff_t val; -#ifdef REL_ALLOC - /* See commentary above for the reasons for inhibiting - buffer text relocation here. */ - r_alloc_inhibit_buffer_relocation (1); -#endif val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), lim_byte - BEGV_BYTE); -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif if (val == -2) { matcher_overflow (); === modified file 'src/xdisp.c' --- src/xdisp.c 2012-05-27 01:06:44 +0000 +++ src/xdisp.c 2012-05-31 06:06:42 +0000 @@ -3170,7 +3170,7 @@ onto the stack one more time, which is not expected by the rest of the code that processes overlay strings. */ - || (it->n_overlay_strings <= 0 + || (it->current.overlay_string_index < 0 ? !get_overlay_strings_1 (it, 0, 0) : 0)) { ------------------------------------------------------------ revno: 108434 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-30 22:08:37 -0700 message: Remove obsolete '#define static' cruft. * etc/PROBLEMS: Remove obsolete '#define static' cruft. * lwlib/xlwmenu.c [emacs]: Include "bitmaps/gray.xbm". (gray_bitmap_width, gray_bitmap_height, gray_bitmap_bits) [!emacs]: Remove; all uses replaced with definiens. * src/s/hpux10-20.h (_FILE_OFFSET_BITS): Don't #undef. This #undef was "temporary" in 2000; it is no longer needed now that '#define static' has gone away. * src/xfns.c, src/xterm.h (gray_bitmap_width, gray_bitmap_height) (gray_bitmap_bits): Remove; no longer needed. All uses replaced with definiens. * src/xterm.c: Include "bitmaps/gray.xbm". diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2012-05-07 22:53:17 +0000 +++ etc/ChangeLog 2012-05-31 05:08:37 +0000 @@ -1,3 +1,7 @@ +2012-05-31 Paul Eggert + + * PROBLEMS: Remove obsolete '#define static' cruft. + 2012-05-07 Glenn Morris * forms/forms-d2.el, forms/forms-pass.el: Move here from ../lisp. === modified file 'etc/PROBLEMS' --- etc/PROBLEMS 2012-04-04 07:30:02 +0000 +++ etc/PROBLEMS 2012-05-31 05:08:37 +0000 @@ -2778,19 +2778,11 @@ *** The dumped Emacs crashes when run, trying to write pure data. -Two causes have been seen for such problems. - -1) On a system where getpagesize is not a system call, it is defined +On a system where getpagesize is not a system call, it is defined as a macro. If the definition (in both unex*.c and malloc.c) is wrong, it can cause problems like this. You might be able to find the correct value in the man page for a.out (5). -2) Some systems allocate variables declared static among the -initialized variables. Emacs makes all initialized variables in most -of its files pure after dumping, but the variables declared static and -not initialized are not supposed to be pure. On these systems you -may need to add "#define static" to config.h. - * Runtime problems on legacy systems This section covers bugs reported on very old hardware or software. === modified file 'lwlib/ChangeLog' --- lwlib/ChangeLog 2012-04-18 16:45:13 +0000 +++ lwlib/ChangeLog 2012-05-31 05:08:37 +0000 @@ -1,3 +1,10 @@ +2012-05-31 Paul Eggert + + Remove obsolete '#define static' cruft. + * xlwmenu.c [emacs]: Include "bitmaps/gray.xbm". + (gray_bitmap_width, gray_bitmap_height, gray_bitmap_bits) [!emacs]: + Remove; all uses replaced with definiens. + 2012-04-18 Paul Eggert configure: new option --enable-gcc-warnings (Bug#11207) === modified file 'lwlib/xlwmenu.c' --- lwlib/xlwmenu.c 2012-01-19 07:21:25 +0000 +++ lwlib/xlwmenu.c 2012-05-31 05:08:37 +0000 @@ -49,22 +49,12 @@ #ifdef emacs -/* Defined in xfns.c. When config.h defines `static' as empty, we get - redefinition errors when gray_bitmap is included more than once, so - we're referring to the one include in xfns.c here. */ - -extern int gray_bitmap_width; -extern int gray_bitmap_height; -extern char *gray_bitmap_bits; - #include +#include "bitmaps/gray.xbm" #else /* not emacs */ #include -#define gray_bitmap_width gray_width -#define gray_bitmap_height gray_height -#define gray_bitmap_bits gray_bits #endif /* not emacs */ @@ -1918,8 +1908,8 @@ mw->menu.cursor = mw->menu.cursor_shape; mw->menu.gray_pixmap - = XCreatePixmapFromBitmapData (display, window, gray_bitmap_bits, - gray_bitmap_width, gray_bitmap_height, + = XCreatePixmapFromBitmapData (display, window, gray_bits, + gray_width, gray_height, (unsigned long)1, (unsigned long)0, 1); #ifdef HAVE_XFT === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-30 19:23:37 +0000 +++ src/ChangeLog 2012-05-31 05:08:37 +0000 @@ -1,3 +1,14 @@ +2012-05-31 Paul Eggert + + Remove obsolete '#define static' cruft. + * s/hpux10-20.h (_FILE_OFFSET_BITS): Don't #undef. + This #undef was "temporary" in 2000; it is no longer needed + now that '#define static' has gone away. + * xfns.c, xterm.h (gray_bitmap_width, gray_bitmap_height) + (gray_bitmap_bits): Remove; no longer needed. + All uses replaced with definiens. + * xterm.c: Include "bitmaps/gray.xbm". + 2012-05-30 Paul Eggert Clean up __executable_start, monstartup when --enable-profiling. === modified file 'src/s/hpux10-20.h' --- src/s/hpux10-20.h 2012-04-14 06:18:49 +0000 +++ src/s/hpux10-20.h 2012-05-31 05:08:37 +0000 @@ -95,12 +95,6 @@ #define HAVE_XRMSETDATABASE #endif -/* 2000-11-21: Temporarily disable Unix 98 large file support found by - configure. It fails on HPUX 11, at least, because it enables - header sections which lose when `static' is defined away, as it is - on HP-UX. (You get duplicate symbol errors on linking). */ -#undef _FILE_OFFSET_BITS - /* Conservative garbage collection has not been tested, so for now play it safe and stick with the old-fashioned way of marking. */ #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE === modified file 'src/xfns.c' --- src/xfns.c 2012-05-25 18:19:24 +0000 +++ src/xfns.c 2012-05-31 05:08:37 +0000 @@ -126,14 +126,6 @@ #define MAXREQUEST(dpy) (XMaxRequestSize (dpy)) -/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses - it, and including `bitmaps/gray' more than once is a problem when - config.h defines `static' as an empty replacement string. */ - -int gray_bitmap_width = gray_width; -int gray_bitmap_height = gray_height; -char *gray_bitmap_bits = gray_bits; - /* Nonzero if using X. */ int x_in_use; === modified file 'src/xterm.c' --- src/xterm.c 2012-05-25 18:19:24 +0000 +++ src/xterm.c 2012-05-31 05:08:37 +0000 @@ -139,6 +139,8 @@ #endif #endif +#include "bitmaps/gray.xbm" + /* Default to using XIM if available. */ #ifdef USE_XIM int use_xim = 1; @@ -10383,8 +10385,7 @@ { dpyinfo->gray = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window, - gray_bitmap_bits, - gray_bitmap_width, gray_bitmap_height, + gray_bits, gray_width, gray_height, 1, 0, 1); } === modified file 'src/xterm.h' --- src/xterm.h 2012-05-25 18:19:24 +0000 +++ src/xterm.h 2012-05-31 05:08:37 +0000 @@ -939,8 +939,6 @@ struct frame *check_x_frame (Lisp_Object); EXFUN (Fx_display_grayscale_p, 1); extern void x_free_gcs (struct frame *); -extern int gray_bitmap_width, gray_bitmap_height; -extern char *gray_bitmap_bits; /* From xrdb.c. */ ------------------------------------------------------------ revno: 108433 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2012-05-30 21:41:17 -0400 message: Add `declare' for `defun'. Align `defmacro's with it. * lisp/emacs-lisp/easy-mmode.el (define-minor-mode) (define-globalized-minor-mode): Don't autoload the var definitions. * lisp/emacs-lisp/byte-run.el: Use lexical-binding. (defun-declarations-alist, macro-declarations-alist): New vars. (defmacro, defun): Use them. (make-obsolete, define-obsolete-function-alias) (make-obsolete-variable, define-obsolete-variable-alias): Use `declare'. (macro-declaration-function): Mark obsolete. * lisp/emacs-lisp/autoload.el: Use lexical-binding. (make-autoload): Add `expansion' arg. Rely more on macro expansion. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-05-31 01:09:41 +0000 +++ etc/NEWS 2012-05-31 01:41:17 +0000 @@ -299,6 +299,11 @@ * Lisp changes in Emacs 24.2 +** `defun' also accepts a (declare DECLS) form, like `defmacro'. +The interpretation of the DECLS is determined by `defun-declarations-alist'. + +** `macro-declaration-function' is obsolete, use `macro-declarations-alist'. + ** New function `set-temporary-overlay-map'. ** New macros `setq-local' and `defvar-local'. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-30 16:14:37 +0000 +++ lisp/ChangeLog 2012-05-31 01:41:17 +0000 @@ -1,9 +1,24 @@ +2012-05-31 Stefan Monnier + + Add `declare' for `defun'. Align `defmacro's with it. + * emacs-lisp/easy-mmode.el (define-minor-mode) + (define-globalized-minor-mode): Don't autoload the var definitions. + * emacs-lisp/byte-run.el: Use lexical-binding. + (defun-declarations-alist, macro-declarations-alist): New vars. + (defmacro, defun): Use them. + (make-obsolete, define-obsolete-function-alias) + (make-obsolete-variable, define-obsolete-variable-alias): + Use `declare'. + (macro-declaration-function): Mark obsolete. + * emacs-lisp/autoload.el: Use lexical-binding. + (make-autoload): Add `expansion' arg. Rely more on macro expansion. + 2012-05-30 Agustín Martín Domingo * textmodes/ispell.el (ispell-with-no-warnings): Define as a macro. - (ispell-kill-ispell, ispell-change-dictionary): Use - `called-interactively-p' for Emacs instead of obsolete + (ispell-kill-ispell, ispell-change-dictionary): + Use `called-interactively-p' for Emacs instead of obsolete `interactive-p'. 2012-05-30 Stefan Monnier === modified file 'lisp/emacs-lisp/autoload.el' --- lisp/emacs-lisp/autoload.el 2012-04-10 20:15:08 +0000 +++ lisp/emacs-lisp/autoload.el 2012-05-31 01:41:17 +0000 @@ -1,4 +1,4 @@ -;; autoload.el --- maintain autoloads in loaddefs.el +;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- ;; Copyright (C) 1991-1997, 2001-2012 Free Software Foundation, Inc. @@ -86,28 +86,67 @@ (defvar autoload-modified-buffers) ;Dynamically scoped var. -(defun make-autoload (form file) +(defun make-autoload (form file &optional expansion) "Turn FORM into an autoload or defvar for source file FILE. Returns nil if FORM is not a special autoload form (i.e. a function definition -or macro definition or a defcustom)." +or macro definition or a defcustom). +If EXPANSION is non-nil, we're processing the macro expansion of an +expression, in which case we want to handle forms differently." (let ((car (car-safe form)) expand) (cond + ((and expansion (eq car 'defalias)) + (pcase-let* + ((`(,_ ,_ ,arg . ,rest) form) + ;; `type' is non-nil if it defines a macro. + ;; `fun' is the function part of `arg' (defaults to `arg'). + ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t)) + (and (let fun arg) (let type nil))) + arg) + ;; `lam' is the lambda expression in `fun' (or nil if not + ;; recognized). + (lam (if (memq (car-safe fun) '(quote function)) (cadr fun))) + ;; `args' is the list of arguments (or t if not recognized). + ;; `body' is the body of `lam' (or t if not recognized). + ((or `(lambda ,args . ,body) + (and (let args t) (let body t))) + lam) + ;; Get the `doc' from `body' or `rest'. + (doc (cond ((stringp (car-safe body)) (car body)) + ((stringp (car-safe rest)) (car rest)))) + ;; Look for an interactive spec. + (interactive (pcase body + ((or `((interactive . ,_) . ,_) + `(,_ (interactive . ,_) . ,_)) t)))) + ;; Add the usage form at the end where describe-function-1 + ;; can recover it. + (when (listp args) (setq doc (help-add-fundoc-usage doc args))) + ;; (message "autoload of %S" (nth 1 form)) + `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))) + + ((and expansion (memq car '(progn prog1))) + (let ((end (memq :autoload-end form))) + (when end ;Cut-off anything after the :autoload-end marker. + (setq form (copy-sequence form)) + (setcdr (memq :autoload-end form) nil)) + (let ((exps (delq nil (mapcar (lambda (form) + (make-autoload form file expansion)) + (cdr form))))) + (when exps (cons 'progn exps))))) + ;; For complex cases, try again on the macro-expansion. ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode - define-globalized-minor-mode + define-globalized-minor-mode defun defmacro + ;; FIXME: we'd want `defmacro*' here as well, so as + ;; to handle its `declare', but when autoload is run + ;; CL is not loaded so macroexpand doesn't know how + ;; to expand it! easy-mmode-define-minor-mode define-minor-mode)) (setq expand (let ((load-file-name file)) (macroexpand form))) - (eq (car expand) 'progn) - (memq :autoload-end expand)) - (let ((end (memq :autoload-end expand))) - ;; Cut-off anything after the :autoload-end marker. - (setcdr end nil) - (cons 'progn - (mapcar (lambda (form) (make-autoload form file)) - (cdr expand))))) + (memq (car expand) '(progn prog1 defalias))) + (make-autoload expand file 'expansion)) ;Recurse on the expansion. ;; For special function-like operators, use the `autoload' function. - ((memq car '(defun define-skeleton defmacro define-derived-mode + ((memq car '(define-skeleton define-derived-mode define-compilation-mode define-generic-mode easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode @@ -124,40 +163,21 @@ (t))) (body (nthcdr (get car 'doc-string-elt) form)) (doc (if (stringp (car body)) (pop body)))) - (when (listp args) - ;; Add the usage form at the end where describe-function-1 - ;; can recover it. - (setq doc (help-add-fundoc-usage doc args))) - (let ((exp - ;; `define-generic-mode' quotes the name, so take care of that - (list 'autoload (if (listp name) name (list 'quote name)) - file doc - (or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) t) - (eq (car-safe (car body)) 'interactive)) - (if macrop (list 'quote 'macro) nil)))) - (when macrop - ;; Special case to autoload some of the macro's declarations. - (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form)) - (exps '())) - (when (eq (car-safe decls) 'declare) - ;; FIXME: We'd like to reuse macro-declaration-function, - ;; but we can't since it doesn't return anything. - (dolist (decl decls) - (case (car-safe decl) - (indent - (push `(put ',name 'lisp-indent-function ',(cadr decl)) - exps)) - (doc-string - (push `(put ',name 'doc-string-elt ',(cadr decl)) exps)))) - (when exps - (setq exp `(progn ,exp ,@exps)))))) - exp))) + ;; Add the usage form at the end where describe-function-1 + ;; can recover it. + (when (listp args) (setq doc (help-add-fundoc-usage doc args))) + ;; `define-generic-mode' quotes the name, so take care of that + (list 'autoload (if (listp name) name (list 'quote name)) + file doc + (or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) t) + (eq (car-safe (car body)) 'interactive)) + (if macrop (list 'quote 'macro) nil)))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) @@ -190,6 +210,11 @@ (if (member ',file loads) nil (put ',groupname 'custom-loads (cons ',file loads)))))) + ;; When processing a macro expansion, any expression + ;; before a :autoload-end should be included. These are typically (put + ;; 'fun 'prop val) and things like that. + ((and expansion (consp form)) form) + ;; nil here indicates that this is not a special autoload form. (t nil)))) @@ -481,7 +506,7 @@ (search-forward generate-autoload-cookie) (skip-chars-forward " \t") (if (eolp) - (condition-case err + (condition-case-unless-debug err ;; Read the next form and make an autoload. (let* ((form (prog1 (read (current-buffer)) (or (bolp) (forward-line 1)))) @@ -671,9 +696,9 @@ write its autoloads into the specified file instead." (interactive "DUpdate autoloads from directory: ") (let* ((files-re (let ((tmp nil)) - (dolist (suf (get-load-suffixes) - (concat "^[^=.].*" (regexp-opt tmp t) "\\'")) - (unless (string-match "\\.elc" suf) (push suf tmp))))) + (dolist (suf (get-load-suffixes)) + (unless (string-match "\\.elc" suf) (push suf tmp))) + (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))) (files (apply 'nconc (mapcar (lambda (dir) (directory-files (expand-file-name dir) === modified file 'lisp/emacs-lisp/byte-run.el' --- lisp/emacs-lisp/byte-run.el 2012-05-30 03:59:42 +0000 +++ lisp/emacs-lisp/byte-run.el 2012-05-31 01:41:17 +0000 @@ -1,4 +1,4 @@ -;;; byte-run.el --- byte-compiler support for inlining +;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. @@ -30,9 +30,8 @@ ;;; Code: -;; We define macro-declaration-function here because it is needed to -;; handle declarations in macro definitions and this is the first file -;; loaded by loadup.el that uses declarations in macros. +;; `macro-declaration-function' are both obsolete (as marked at the end of this +;; file) but used in many .elc files. (defvar macro-declaration-function #'macro-declaration-function "Function to process declarations in a macro definition. @@ -66,6 +65,45 @@ (message "Unknown declaration %s" d))) (message "Invalid declaration %s" d)))))) +;; We define macro-declaration-alist here because it is needed to +;; handle declarations in macro definitions and this is the first file +;; loaded by loadup.el that uses declarations in macros. + +(defvar defun-declarations-alist + ;; FIXME: Should we also add an `obsolete' property? + (list + ;; Too bad we can't use backquote yet at this stage of the bootstrap. + (list 'advertised-calling-convention + #'(lambda (f arglist when) + (list 'set-advertised-calling-convention + (list 'quote f) (list 'quote arglist) (list 'quote when)))) + (list 'doc-string + #'(lambda (f pos) + (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) + (list 'indent + #'(lambda (f val) + (list 'put (list 'quote f) + ''lisp-indent-function (list 'quote val))))) + "List associating function properties to their macro expansion. +Each element of the list takes the form (PROP FUN) where FUN is +a function. For each (PROP . VALUES) in a function's declaration, +the FUN corresponding to PROP is called with the function name +and the VALUES and should return the code to use to set this property.") + +(defvar macro-declarations-alist + (cons + (list 'debug + #'(lambda (name spec) + (list 'progn :autoload-end + (list 'put (list 'quote name) + ''edebug-form-spec (list 'quote spec))))) + defun-declarations-alist) + "List associating properties of macros to their macro expansion. +Each element of the list takes the form (PROP FUN) where FUN is +a function. For each (PROP . VALUES) in a macro's declaration, +the FUN corresponding to PROP is called with the function name +and the VALUES and should return the code to use to set this property.") + (put 'defmacro 'doc-string-elt 3) (defalias 'defmacro (cons @@ -76,21 +114,9 @@ the function (lambda ARGLIST BODY...) is applied to the list ARGS... as it appears in the expression, and the result should be a form to be evaluated instead of the original. - -DECL is a declaration, optional, which can specify how to indent -calls to this macro, how Edebug should handle it, and which argument -should be treated as documentation. It looks like this: - (declare SPECS...) -The elements can look like this: - (indent INDENT) - Set NAME's `lisp-indent-function' property to INDENT. - - (debug DEBUG) - Set NAME's `edebug-form-spec' property to DEBUG. (This is - equivalent to writing a `def-edebug-spec' for the macro.) - - (doc-string ELT) - Set NAME's `doc-string-elt' property to ELT." +DECL is a declaration, optional, of the form (declare DECLS...) where +DECLS is a list of elements of the form (PROP . VALUES). These are +interpreted according to `macro-declarations-alist'." (if (stringp docstring) nil (if decl (setq body (cons decl body))) (setq decl docstring) @@ -104,28 +130,67 @@ (let* ((fun (list 'function (cons 'lambda (cons arglist body)))) (def (list 'defalias (list 'quote name) - (list 'cons ''macro fun)))) - (if decl - (list 'progn - (list 'funcall 'macro-declaration-function - (list 'quote name) - (list 'quote decl)) - def) + (list 'cons ''macro fun))) + (declarations + (mapcar + #'(lambda (x) + (let ((f (cdr (assq (car x) macro-declarations-alist)))) + (if f (apply (car f) name (cdr x)) + (message "Warning: Unknown macro property %S in %S" + (car x) name)))) + (cdr decl)))) + (if declarations + (cons 'prog1 (cons def declarations)) def))))) ;; Now that we defined defmacro we can use it! (defmacro defun (name arglist &optional docstring &rest body) "Define NAME as a function. The definition is (lambda ARGLIST [DOCSTRING] BODY...). -See also the function `interactive'." +See also the function `interactive'. +DECL is a declaration, optional, of the form (declare DECLS...) where +DECLS is a list of elements of the form (PROP . VALUES). These are +interpreted according to `defun-declarations-alist'. + +\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" + ;; We can't just have `decl' as an &optional argument, because we need + ;; to distinguish + ;; (defun foo (arg) (toto) nil) + ;; from + ;; (defun foo (arg) (toto)). (declare (doc-string 3)) - (if docstring (setq body (cons docstring body)) - (if (null body) (setq body '(nil)))) - (list 'defalias - (list 'quote name) - (list 'function - (cons 'lambda - (cons arglist body))))) + (let ((decls (cond + ((eq (car-safe docstring) 'declare) + (prog1 (cdr docstring) (setq docstring nil))) + ((eq (car-safe (car body)) 'declare) + (prog1 (cdr (car body)) (setq body (cdr body))))))) + (if docstring (setq body (cons docstring body)) + (if (null body) (setq body '(nil)))) + (let ((declarations + (mapcar + #'(lambda (x) + (let ((f (cdr (assq (car x) defun-declarations-alist)))) + (cond + (f (apply (car f) name (cdr x))) + ;; Yuck!! + ((and (featurep 'cl) + (memq (car x) ;C.f. cl-do-proclaim. + '(special inline notinline optimize warn))) + (if (null (stringp docstring)) + (push (list 'declare x) body) + (setcdr body (cons (list 'declare x) (cdr body)))) + nil) + (t (message "Warning: Unknown defun property %S in %S" + (car x) name))))) + decls)) + (def (list 'defalias + (list 'quote name) + (list 'function + (cons 'lambda + (cons arglist body)))))) + (if declarations + (cons 'prog1 (cons def declarations)) + def)))) ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. @@ -158,7 +223,6 @@ ;; (list 'put x ''byte-optimizer nil))) ;; fns))) -;; This has a special byte-hunk-handler in bytecomp.el. (defmacro defsubst (name arglist &rest body) "Define an inline function. The syntax is just like that of `defun'." (declare (debug defun) (doc-string 3)) @@ -172,7 +236,7 @@ (defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key)) -(defun set-advertised-calling-convention (function signature when) +(defun set-advertised-calling-convention (function signature _when) "Set the advertised SIGNATURE of FUNCTION. This will allow the byte-compiler to warn the programmer when she uses an obsolete calling convention. WHEN specifies since when the calling @@ -187,15 +251,15 @@ \(it should end with a period, and not start with a capital). WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number." + (declare (advertised-calling-convention + ;; New code should always provide the `when' argument. + (obsolete-name current-name when) "23.1")) (interactive "aMake function obsolete: \nxObsoletion replacement: ") (put obsolete-name 'byte-obsolete-info ;; The second entry used to hold the `byte-compile' handler, but ;; is not used any more nowadays. (purecopy (list current-name nil when))) obsolete-name) -(set-advertised-calling-convention - ;; New code should always provide the `when' argument. - 'make-obsolete '(obsolete-name current-name when) "23.1") (defmacro define-obsolete-function-alias (obsolete-name current-name &optional when docstring) @@ -209,14 +273,13 @@ \(make-obsolete 'old-fun 'new-fun \"22.1\") See the docstrings of `defalias' and `make-obsolete' for more details." - (declare (doc-string 4)) + (declare (doc-string 4) + (advertised-calling-convention + ;; New code should always provide the `when' argument. + (obsolete-name current-name when &optional docstring) "23.1")) `(progn (defalias ,obsolete-name ,current-name ,docstring) (make-obsolete ,obsolete-name ,current-name ,when))) -(set-advertised-calling-convention - ;; New code should always provide the `when' argument. - 'define-obsolete-function-alias - '(obsolete-name current-name when &optional docstring) "23.1") (defun make-obsolete-variable (obsolete-name current-name &optional when access-type) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. @@ -226,13 +289,13 @@ was first made obsolete, for example a date or a release number. ACCESS-TYPE if non-nil should specify the kind of access that will trigger obsolescence warnings; it can be either `get' or `set'." + (declare (advertised-calling-convention + ;; New code should always provide the `when' argument. + (obsolete-name current-name when &optional access-type) "23.1")) (put obsolete-name 'byte-obsolete-variable (purecopy (list current-name access-type when))) obsolete-name) -(set-advertised-calling-convention - ;; New code should always provide the `when' argument. - 'make-obsolete-variable - '(obsolete-name current-name when &optional access-type) "23.1") + (defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) @@ -255,7 +318,10 @@ any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: 'saved-value, 'saved-variable-comment." - (declare (doc-string 4)) + (declare (doc-string 4) + (advertised-calling-convention + ;; New code should always provide the `when' argument. + (obsolete-name current-name when &optional docstring) "23.1")) `(progn (defvaralias ,obsolete-name ,current-name ,docstring) ;; See Bug#4706. @@ -264,10 +330,6 @@ (null (get ,current-name prop)) (put ,current-name prop (get ,obsolete-name prop)))) (make-obsolete-variable ,obsolete-name ,current-name ,when))) -(set-advertised-calling-convention - ;; New code should always provide the `when' argument. - 'define-obsolete-variable-alias - '(obsolete-name current-name when &optional docstring) "23.1") ;; FIXME This is only defined in this file because the variable- and ;; function- versions are too. Unlike those two, this one is not used @@ -348,4 +410,9 @@ ;; (file-format emacs19))" ;; nil) +(make-obsolete-variable 'macro-declaration-function + 'macro-declarations-alist "24.2") +(make-obsolete 'macro-declaration-function + 'macro-declarations-alist "24.2") + ;;; byte-run.el ends here === modified file 'lisp/emacs-lisp/easy-mmode.el' --- lisp/emacs-lisp/easy-mmode.el 2012-05-18 01:46:20 +0000 +++ lisp/emacs-lisp/easy-mmode.el 2012-05-31 01:41:17 +0000 @@ -229,6 +229,7 @@ (variable nil) ((not globalp) `(progn + :autoload-end (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. Use the command `%s' to change this variable." pretty-name mode)) (make-variable-buffer-local ',mode))) @@ -366,8 +367,10 @@ "-mode\\'" "" (symbol-name mode)))))) `(progn - (defvar ,MODE-major-mode nil) - (make-variable-buffer-local ',MODE-major-mode) + (progn + :autoload-end + (defvar ,MODE-major-mode nil) + (make-variable-buffer-local ',MODE-major-mode)) ;; The actual global minor-mode (define-minor-mode ,global-mode ;; Very short lines to avoid too long lines in the generated ------------------------------------------------------------ revno: 108432 fixes bug(s): http://debbugs.gnu.org/11574 committer: Juri Linkov branch nick: trunk timestamp: Thu 2012-05-31 04:09:41 +0300 message: * etc/NEWS: Doc fix. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-05-29 20:14:18 +0000 +++ etc/NEWS 2012-05-31 01:09:41 +0000 @@ -118,6 +118,9 @@ the face `diff-changed', or `diff-removed' and `diff-added' to highlight changes in context diffs. +** Ediff now uses the same color scheme as Diff mode +on high color displays. + ** `sh-script' *** Pairing of parens/quotes uses electric-pair-mode instead of skeleton-pair. *** `sh-electric-here-document-mode' now controls auto-insertion of here-docs. ------------------------------------------------------------ revno: 108431 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-30 12:23:37 -0700 message: Clean up __executable_start, monstartup when --enable-profiling. The following changes affect the code only when profiling. * dispnew.c (__executable_start): Rename from safe_bcopy. Define only on platforms that need it. * emacs.c: Include when profiling. (_mcleanup): Remove decl, since does it now. (__executable_start): Remove decl, since lisp.h does it now. (safe_bcopy): Remove decl; no longer has that name. (main): Coalesce #if into single bit of code, for simplicity. Cast pointers to uintptr_t, since standard libraries want integers and not pointers. * lisp.h (__executable_start): New decl. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-30 14:20:45 +0000 +++ src/ChangeLog 2012-05-30 19:23:37 +0000 @@ -1,3 +1,18 @@ +2012-05-30 Paul Eggert + + Clean up __executable_start, monstartup when --enable-profiling. + The following changes affect the code only when profiling. + * dispnew.c (__executable_start): Rename from safe_bcopy. + Define only on platforms that need it. + * emacs.c: Include when profiling. + (_mcleanup): Remove decl, since does it now. + (__executable_start): Remove decl, since lisp.h does it now. + (safe_bcopy): Remove decl; no longer has that name. + (main): Coalesce #if into single bit of code, for simplicity. + Cast pointers to uintptr_t, since standard libraries want integers + and not pointers. + * lisp.h (__executable_start): New decl. + 2012-05-30 Jim Meyering * callproc.c (Fcall_process_region): Include directory component === modified file 'src/dispnew.c' --- src/dispnew.c 2012-05-25 18:19:24 +0000 +++ src/dispnew.c 2012-05-30 19:23:37 +0000 @@ -332,11 +332,13 @@ #endif /* GLYPH_DEBUG == 0 */ -#if defined PROFILING && !HAVE___EXECUTABLE_START -/* FIXME: only used to find text start for profiling. */ - +#if (defined PROFILING \ + && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) \ + && !HAVE___EXECUTABLE_START) +/* This function comes first in the Emacs executable and is used only + to estimate the text start for profiling. */ void -safe_bcopy (const char *from, char *to, int size) +__executable_start (void) { abort (); } === modified file 'src/emacs.c' --- src/emacs.c 2012-04-09 22:54:59 +0000 +++ src/emacs.c 2012-05-30 19:23:37 +0000 @@ -65,6 +65,12 @@ #include "nsterm.h" #endif +#if (defined PROFILING \ + && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__)) +# include +extern void moncontrol (int mode); +#endif + #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif @@ -320,9 +326,9 @@ #ifdef HAVE_NS /* NS autrelease pool, for memory management. */ static void *ns_pool; -#endif - - +#endif + + /* Handle bus errors, invalid instruction, etc. */ #ifndef FLOAT_CATCH_SIGILL @@ -1664,32 +1670,14 @@ #ifdef PROFILING if (initialized) { - extern void _mcleanup (); #ifdef __MINGW32__ extern unsigned char etext asm ("etext"); #else extern char etext; #endif -#ifdef HAVE___EXECUTABLE_START - /* This symbol is defined by GNU ld to the start of the text - segment. */ - extern char __executable_start[]; -#else - extern void safe_bcopy (); -#endif atexit (_mcleanup); -#ifdef HAVE___EXECUTABLE_START - monstartup (__executable_start, &etext); -#else - /* This uses safe_bcopy because that function comes first in the - Emacs executable. It might be better to use something that - gives the start of the text segment, but start_of_text is not - defined on all systems now. */ - /* FIXME: Does not work on architectures with function - descriptors. */ - monstartup (safe_bcopy, &etext); -#endif + monstartup ((uintptr_t) __executable_start, (uintptr_t) &etext); } else moncontrol (0); === modified file 'src/lisp.h' --- src/lisp.h 2012-05-30 07:59:44 +0000 +++ src/lisp.h 2012-05-30 19:23:37 +0000 @@ -2758,6 +2758,10 @@ extern void syms_of_insdel (void); /* Defined in dispnew.c */ +#if (defined PROFILING \ + && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__)) +void __executable_start (void) NO_RETURN; +#endif extern Lisp_Object selected_frame; extern Lisp_Object Vwindow_system; EXFUN (Fding, 1); ------------------------------------------------------------ revno: 108430 committer: Agustin Martin branch nick: trunk timestamp: Wed 2012-05-30 18:14:37 +0200 message: ispell.el: Define `ispell-with-no-warnings' as a macro. Deal with obsolete `interactive-p' * Current `ispell-with-no-warnings' definition does not avoid warnings. Use a macro definition taken from orgmode. * Deal with a couple of occurrences of obsolete `interactive-p'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-30 03:59:42 +0000 +++ lisp/ChangeLog 2012-05-30 16:14:37 +0000 @@ -1,3 +1,11 @@ +2012-05-30 Agustín Martín Domingo + + * textmodes/ispell.el (ispell-with-no-warnings): + Define as a macro. + (ispell-kill-ispell, ispell-change-dictionary): Use + `called-interactively-p' for Emacs instead of obsolete + `interactive-p'. + 2012-05-30 Stefan Monnier * emacs-lisp/byte-run.el (defmacro, defun): Move from C. === modified file 'lisp/textmodes/ispell.el' --- lisp/textmodes/ispell.el 2012-05-28 16:11:15 +0000 +++ lisp/textmodes/ispell.el 2012-05-30 16:14:37 +0000 @@ -203,7 +203,6 @@ (declare-function ispell-check-minver "ispell" (v1 v2)) (declare-function ispell-looking-back "ispell" (regexp &optional limit &rest ignored)) -(declare-function ispell-with-no-warnings (&rest body)) (if (fboundp 'version<=) (defalias 'ispell-check-minver 'version<=) @@ -255,15 +254,9 @@ (save-excursion (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))) -;;; XEmacs21 does not have `with-no-warnings' - -(if (fboundp 'with-no-warnings) - (defalias 'ispell-with-no-warnings 'with-no-warnings) - (defun ispell-with-no-warnings (&rest body) - "Like `progn', but prevents compiler warnings in the body." - ;; Taken from Emacs' byte-run.el - ;; The implementation for the interpreter is basically trivial. - (car (last body)))) +;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode. +(defmacro ispell-with-no-warnings (&rest body) + (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) ;;; Code: @@ -2804,7 +2797,10 @@ ;; This hook is typically used by flyspell to flush some variables used ;; to optimize the common cases. (run-hooks 'ispell-kill-ispell-hook) - (if (or clear (interactive-p)) + (if (or clear + (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive))) (setq ispell-buffer-session-localwords nil)) (if (not (and ispell-process (eq (ispell-process-status) 'run))) @@ -2853,7 +2849,9 @@ ;; Specified dictionary is the default already. Could reload ;; the dictionaries if needed. (ispell-internal-change-dictionary) - (and (interactive-p) + (and (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "No change, using %s dictionary" dict))) (t ; reset dictionary! (if (or (assoc dict ispell-local-dictionary-alist) @@ -3725,8 +3723,8 @@ (cond ((functionp 'sc-cite-regexp) ; sc 3.0 (ispell-with-no-warnings - (concat "\\(" (sc-cite-regexp) "\\)" "\\|" - (ispell-non-empty-string sc-reference-tag-string)))) + (concat "\\(" (sc-cite-regexp) "\\)" "\\|" + (ispell-non-empty-string sc-reference-tag-string)))) ((boundp 'sc-cite-regexp) ; sc 2.3 (concat "\\(" sc-cite-regexp "\\)" "\\|" (ispell-with-no-warnings ------------------------------------------------------------ revno: 108429 fixes bug(s): http://debbugs.gnu.org/11586 author: Jim Meyering committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-05-30 22:20:45 +0800 message: Improve call-process-region error message. * src/callproc.c (Fcall_process_region): Include directory component in mkstemp error message. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-30 07:59:44 +0000 +++ src/ChangeLog 2012-05-30 14:20:45 +0000 @@ -1,3 +1,8 @@ +2012-05-30 Jim Meyering + + * callproc.c (Fcall_process_region): Include directory component + in mkstemp error message (Bug#11586). + 2012-05-30 Paul Eggert * alloc.c, lisp.h (make_pure_vector): Now static. === modified file 'src/callproc.c' --- src/callproc.c 2012-05-27 01:06:44 +0000 +++ src/callproc.c 2012-05-30 14:20:45 +0000 @@ -1015,7 +1015,7 @@ UNBLOCK_INPUT; if (fd == -1) report_file_error ("Failed to open temporary file", - Fcons (Vtemp_file_name_pattern, Qnil)); + Fcons (build_string (tempfile), Qnil)); else close (fd); } ------------------------------------------------------------ revno: 108428 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-30 00:59:44 -0700 message: * alloc.c, lisp.h (make_pure_vector): Now static. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-30 03:59:42 +0000 +++ src/ChangeLog 2012-05-30 07:59:44 +0000 @@ -1,3 +1,7 @@ +2012-05-30 Paul Eggert + + * alloc.c, lisp.h (make_pure_vector): Now static. + 2012-05-30 Stefan Monnier * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): === modified file 'src/alloc.c' --- src/alloc.c 2012-05-25 18:19:24 +0000 +++ src/alloc.c 2012-05-30 07:59:44 +0000 @@ -273,6 +273,7 @@ static void mark_buffer (Lisp_Object); static void mark_terminals (void); static void gc_sweep (void); +static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_glyph_matrix (struct glyph_matrix *); static void mark_face_cache (struct face_cache *); @@ -4937,7 +4938,7 @@ /* Return a vector with room for LEN Lisp_Objects allocated from pure space. */ -Lisp_Object +static Lisp_Object make_pure_vector (ptrdiff_t len) { Lisp_Object new; === modified file 'src/lisp.h' --- src/lisp.h 2012-05-30 03:59:42 +0000 +++ src/lisp.h 2012-05-30 07:59:44 +0000 @@ -2871,7 +2871,6 @@ extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int); extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); -extern Lisp_Object make_pure_vector (ptrdiff_t); EXFUN (Fgarbage_collect, 0); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_bool_vector, 2); ------------------------------------------------------------ revno: 108427 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2012-05-29 23:59:42 -0400 message: * lisp/emacs-lisp/byte-run.el (defmacro, defun): Move from C. (macro-declaration-function): Move var from C code. (macro-declaration-function): Define function with defalias. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle defun/defmacro any more. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Provide fallback for unknown arglist. (byte-compile-arglist-warn): Change calling convention. (byte-compile-output-file-form): Move print-vars binding. (byte-compile-output-docform): Simplify accordingly. (byte-compile-file-form-defun, byte-compile-file-form-defmacro) (byte-compile-defmacro-declaration): Remove. (byte-compile-file-form-defmumble): Generalize to defalias. (byte-compile-output-as-comment): Return byte-positions. Simplify callers accordingly. (byte-compile-lambda): Use `assert'. (byte-compile-defun, byte-compile-defmacro): Remove. (byte-compile-file-form-defalias): Use byte-compile-file-form-defmumble. (byte-compile-defalias-warn): Remove. * src/eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): Move to byte-run.el. (Fautoload): Do the hash-doc more carefully. * src/data.c (Fdefalias): Purify definition, except for keymaps. (Qdefun): Move from eval.c. * src/lisp.h (Qdefun): Remove. * src/lread.c (read1): Tiny simplification. * lib-src/make-docfile.c: Improve comment style. (search_lisp_doc_at_eol): New function. (scan_lisp_file): Use it. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-05-26 22:38:19 +0000 +++ lib-src/ChangeLog 2012-05-30 03:59:42 +0000 @@ -1,3 +1,9 @@ +2012-05-30 Stefan Monnier + + * make-docfile.c: Improve comment style. + (search_lisp_doc_at_eol): New function. + (scan_lisp_file): Use it. + 2012-05-26 Glenn Morris * Makefile.in (INSTALL_DATA): Remove; unused. @@ -441,8 +447,8 @@ * etags.c (canonicalize_filename, ISUPPER): Fix last change. - * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): Depend - on ../lib/min-max.h. + * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): + Depend on ../lib/min-max.h. 2011-02-22 Paul Eggert @@ -2819,7 +2825,7 @@ * make-docfile.c (read_c_string_or_comment): Declare msgno. - * Makefile.in (YACC): Deleted. + * Makefile.in (YACC): Delete. 2002-10-19 Andreas Schwab @@ -3037,7 +3043,7 @@ (TeX_commands): Names now include the initial backslash. (TeX_commands): Names do not include numeric args #n. (TeX_commands): Correct line char number in tags. - (TEX_tabent, TEX_token): Deleted. + (TEX_tabent, TEX_token): Delete. (TeX_commands, TEX_decode_env): Streamlined. 2002-06-05 Francesco Potortì @@ -3078,7 +3084,7 @@ (main): New argument -d, for specifying directory. (usage): Document. (get_user_id): Compute. - (get_home_dir): Deleted. + (get_home_dir): Delete. (get_prefix): New function, taken from main. (main): Check whether or not we are running setuid. Move prefix computation to get_prefix. Don't call getpwent; we don't need to @@ -3339,7 +3345,7 @@ (LOOKING_AT, get_tag, PHP_functions): Use notinname. (Ada_getit, Ada_funcs, Python_functions, Scheme_functions): Clarified, using strneq or notinname. - (L_isdef, L_isquote): Removed. + (L_isdef, L_isquote): Remove. (Lisp_functions, L_getit): Clarified. * etags.c (P_): Rename to __P for consistency with config.h. @@ -3776,7 +3782,7 @@ comma when --declarations is used. (C_entries): More accurate tagging of members and declarations. (yacc_rules): Was global, made local to C_entries. - (next_token_is_func): Removed. + (next_token_is_func): Remove. (fvdef): New constants fdefunkey, fdefunname. (consider_token, C_entries): Use them. (C_entries): Build proper lisp names for Emacs DEFUNs. @@ -4252,7 +4258,7 @@ (find_entries, takeprec, getit, Fortran_functions, Perl_functions) (Python_functions, L_getit, Lisp_functions, Scheme_functions) (prolog_pred, erlanf_func, erlang_attribute): Use them. - (eat_white): Deleted. + (eat_white): Delete. * etags.c (CHAR, init): Keep into account non US-ASCII characters and compilers with default signed chars. @@ -4775,7 +4781,7 @@ 1997-05-13 Francesco Potortì * etags.c (TeX_functions): Cleaned up. - (tex_getit): Removed. + (tex_getit): Remove. 1997-05-13 Paul Eggert @@ -5296,7 +5302,7 @@ * etags.c: Prolog language totally rewritten. (Prolog_functions): Rewritten from scratch. - (skip_comment, prolog_getit): Removed. + (skip_comment, prolog_getit): Remove. (prolog_skip_comment): New function, like old skip_comment. (prolog_pred, prolog_atom, prolog_white): New functions. (erlang_func, erlang_attributes): Forward declarations added. @@ -5797,7 +5803,7 @@ 1995-01-12 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted. + * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Delete. (append_to_tagfile, typedefs, typedefs_and_cplusplus) (constantypedefs, update, vgrind_style, no_warnings) (cxref_style, cplusplus, noindentypedefs): Were int, now logical. @@ -5816,9 +5822,9 @@ (consider_token): Don't take a token as argument. Use savenstr when saving a tag in structtag. Callers changed. (TOKEN): Structure changed. Now used only in C_entries. - (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted. + (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete. (C_entries): nameb and savenameb deleted. Use dinamic allocation. - (pfcnt): Deleted. Users updated. + (pfcnt): Delete. Users updated. (getit, Asm_labels, Pascal_functions, L_getit, get_scheme) (TEX_getit, prolog_getit): Use dinamic allocation for storing the tag instead of a fixed size buffer. @@ -6394,7 +6400,7 @@ 1994-03-25 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (emacs_tags_format, ETAGS): Removed. Use CTAGS instead. + * etags.c (emacs_tags_format, ETAGS): Remove. Use CTAGS instead. (main): Don't allow the use of -t and -T in etags mode. (print_help): Don't show options enabled by default. (print_version): Show the emacs version number if VERSION is #defined. @@ -6511,9 +6517,9 @@ 1994-01-14 Francesco Potortì (pot@cnuce.cnr.it) * etags.c (stab_entry, stab_create, stab_find, stab_search, - stab_type, add_keyword, C_reate_stab, C_create_stabs): Deleted. + stab_type, add_keyword, C_reate_stab, C_create_stabs): Delete. Use gperf generated hash table instead of linked list. - (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added. + (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Add. Mostly code generated by gperf. (consider_token): Remove unused parameter `lp'. (PF_funcs, getit): Allow subroutine and similar declarations @@ -6832,7 +6838,7 @@ * etags.c (consider_token): Was `==', now is `='. (consider_token): DEFUNs now treated like funcs in ctags mode. - * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed. + * etags.c (LEVEL_OK_FOR_FUNCDEF): Remove. (C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF. (C_entries): Remove a piece of useless code. (C_entries): Making typedef tags is delayed until a semicolon @@ -7131,10 +7137,10 @@ * etags.c (GET_COOKIE): And related macros removed. (logical): Is now int, no more a char. (reg): Define deleted. - (isgood, _gd, notgd): Deleted. - (gotone): Deleted. + (isgood, _gd, notgd): Delete. + (gotone): Delete. (TOKEN): Member linestart removed. - (linepos, prev_linepos, lb1): Deleted. + (linepos, prev_linepos, lb1): Delete. (main): Call initbuffer on lbs array instead of lb1. (init): Remove the initialization of the logical _gd array. (find_entries): A .sa suffix means assembler file. @@ -7142,7 +7148,7 @@ All C state machines rewritten. (C_entries): Complete rewrite. (condider_token): Complete rewrite. - (getline): Deleted. + (getline): Delete. 1993-03-01 Francesco Potortì (pot@fly.CNUCE.CNR.IT) === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2012-04-29 20:05:44 +0000 +++ lib-src/make-docfile.c 2012-05-30 03:59:42 +0000 @@ -35,7 +35,7 @@ #include -/* defined to be emacs_main, sys_fopen, etc. in config.h */ +/* Defined to be emacs_main, sys_fopen, etc. in config.h. */ #undef main #undef fopen #undef chdir @@ -66,7 +66,7 @@ #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) #endif -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ +/* Use this to suppress gcc's `...may be used before initialized' warnings. */ #ifdef lint # define IF_LINT(Code) Code #else @@ -226,7 +226,7 @@ for (tmp = filename; *tmp; tmp++) { - if (IS_DIRECTORY_SEP(*tmp)) + if (IS_DIRECTORY_SEP (*tmp)) filename = tmp + 1; } @@ -675,14 +675,14 @@ if (infile == NULL && extension == 'o') { - /* try .m */ + /* Try .m. */ filename[strlen (filename) - 1] = 'm'; infile = fopen (filename, mode); if (infile == NULL) - filename[strlen (filename) - 1] = 'c'; /* don't confuse people */ + filename[strlen (filename) - 1] = 'c'; /* Don't confuse people. */ } - /* No error if non-ex input file */ + /* No error if non-ex input file. */ if (infile == NULL) { perror (filename); @@ -800,8 +800,8 @@ input_buffer[i++] = c; c = getc (infile); } - while (! (c == ',' || c == ' ' || c == '\t' || - c == '\n' || c == '\r')); + while (! (c == ',' || c == ' ' || c == '\t' + || c == '\n' || c == '\r')); input_buffer[i] = '\0'; name = xmalloc (i + 1); @@ -820,7 +820,7 @@ commas = 3; else if (defvarflag) commas = 1; - else /* For DEFSIMPLE and DEFPRED */ + else /* For DEFSIMPLE and DEFPRED. */ commas = 2; while (commas) @@ -838,9 +838,9 @@ if (c < 0) goto eof; ungetc (c, infile); - if (commas == 2) /* pick up minargs */ + if (commas == 2) /* Pick up minargs. */ scanned = fscanf (infile, "%d", &minargs); - else /* pick up maxargs */ + else /* Pick up maxargs. */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ maxargs = -1; else @@ -893,7 +893,7 @@ fprintf (outfile, "%s\n", input_buffer); if (comment) - getc (infile); /* Skip past `*' */ + getc (infile); /* Skip past `*'. */ c = read_c_string_or_comment (infile, 1, comment, &saw_usage); /* If this is a defun, find the arguments and print them. If @@ -979,7 +979,7 @@ problem because byte-compiler output follows this convention. The NAME and DOCSTRING are output. NAME is preceded by `F' for a function or `V' for a variable. - An entry is output only if DOCSTRING has \ newline just after the opening " + An entry is output only if DOCSTRING has \ newline just after the opening ". */ static void @@ -1020,6 +1020,32 @@ } static int +search_lisp_doc_at_eol (FILE *infile) +{ + char c = 0, c1 = 0, c2 = 0; + + /* Skip until the end of line; remember two previous chars. */ + while (c != '\n' && c != '\r' && c >= 0) + { + c2 = c1; + c1 = c; + c = getc (infile); + } + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + return 0; + } + return 1; +} + +static int scan_lisp_file (const char *filename, const char *mode) { FILE *infile; @@ -1033,7 +1059,7 @@ if (infile == NULL) { perror (filename); - return 0; /* No error */ + return 0; /* No error. */ } c = '\n'; @@ -1110,7 +1136,7 @@ type = 'F'; read_lisp_symbol (infile, buffer); - /* Skip the arguments: either "nil" or a list in parens */ + /* Skip the arguments: either "nil" or a list in parens. */ c = getc (infile); if (c == 'n') /* nil */ @@ -1154,39 +1180,18 @@ || ! strcmp (buffer, "defconst") || ! strcmp (buffer, "defcustom")) { - char c1 = 0, c2 = 0; type = 'V'; read_lisp_symbol (infile, buffer); if (saved_string == 0) - { - - /* Skip until the end of line; remember two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "custom-declare-variable") || ! strcmp (buffer, "defvaralias") ) { - char c1 = 0, c2 = 0; type = 'V'; c = getc (infile); @@ -1221,31 +1226,12 @@ } if (saved_string == 0) - { - /* Skip to end of line; remember the two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) { - char c1 = 0, c2 = 0; type = 'F'; c = getc (infile); @@ -1278,26 +1264,8 @@ } if (saved_string == 0) - { - /* Skip to end of line; remember the two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "autoload")) @@ -1339,23 +1307,10 @@ continue; } read_c_string_or_comment (infile, 0, 0, 0); - skip_white (infile); if (saved_string == 0) - { - /* If the next three characters aren't `dquote bslash newline' - then we're not reading a docstring. */ - if ((c = getc (infile)) != '"' - || (c = getc (infile)) != '\\' - || ((c = getc (infile)) != '\n' && c != '\r')) - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } #ifdef DEBUG @@ -1373,12 +1328,10 @@ continue; } - /* At this point, we should either use the previous - dynamic doc string in saved_string - or gobble a doc string from the input file. - - In the latter case, the opening quote (and leading - backslash-newline) have already been read. */ + /* At this point, we should either use the previous dynamic doc string in + saved_string or gobble a doc string from the input file. + In the latter case, the opening quote (and leading backslash-newline) + have already been read. */ putc (037, outfile); putc (type, outfile); === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-29 20:14:18 +0000 +++ lisp/ChangeLog 2012-05-30 03:59:42 +0000 @@ -1,8 +1,32 @@ +2012-05-30 Stefan Monnier + + * emacs-lisp/byte-run.el (defmacro, defun): Move from C. + (macro-declaration-function): Move var from C code. + (macro-declaration-function): Define function with defalias. + * emacs-lisp/macroexp.el (macroexpand-all-1): + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle + defun/defmacro any more. + * emacs-lisp/bytecomp.el (byte-compile-arglist-signature): + Provide fallback for unknown arglist. + (byte-compile-arglist-warn): Change calling convention. + (byte-compile-output-file-form): Move print-vars binding. + (byte-compile-output-docform): Simplify accordingly. + (byte-compile-file-form-defun, byte-compile-file-form-defmacro) + (byte-compile-defmacro-declaration): Remove. + (byte-compile-file-form-defmumble): Generalize to defalias. + (byte-compile-output-as-comment): Return byte-positions. + Simplify callers accordingly. + (byte-compile-lambda): Use `assert'. + (byte-compile-defun, byte-compile-defmacro): Remove. + (byte-compile-file-form-defalias): + Use byte-compile-file-form-defmumble. + (byte-compile-defalias-warn): Remove. + 2012-05-29 Stefan Merten * textmodes/rst.el: Silence `checkdoc-ispell' errors where - possible. Fix authors. Improve comments. Improve loading of - `cl'. + possible. Fix authors. Improve comments. Improve loading of `cl'. (rst-mode-abbrev-table): Merge definition. (rst-mode): Make sure `font-lock-defaults' is buffer local. @@ -14,8 +38,8 @@ (icalendar-export-region): Export UID properly. 2012-05-29 Leo - * calendar/icalendar.el (icalendar-import-format): Add - `icalendar-import-format-uid' (Bug#11525). + * calendar/icalendar.el (icalendar-import-format): + Add `icalendar-import-format-uid' (Bug#11525). (icalendar-import-format-uid): New. (icalendar--parse-summary-and-rest, icalendar--format-ical-event): Export UID. === modified file 'lisp/emacs-lisp/byte-opt.el' --- lisp/emacs-lisp/byte-opt.el 2012-05-29 14:28:02 +0000 +++ lisp/emacs-lisp/byte-opt.el 2012-05-30 03:59:42 +0000 @@ -500,7 +500,7 @@ (prin1-to-string form)) nil) - ((memq fn '(defun defmacro function condition-case)) + ((memq fn '(function condition-case)) ;; These forms are compiled as constants or by breaking out ;; all the subexpressions and compiling them separately. form) === modified file 'lisp/emacs-lisp/byte-run.el' --- lisp/emacs-lisp/byte-run.el 2012-05-18 01:46:20 +0000 +++ lisp/emacs-lisp/byte-run.el 2012-05-30 03:59:42 +0000 @@ -34,33 +34,98 @@ ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. -(defun macro-declaration-function (macro decl) - "Process a declaration found in a macro definition. +(defvar macro-declaration-function #'macro-declaration-function + "Function to process declarations in a macro definition. +The function will be called with two args MACRO and DECL. +MACRO is the name of the macro being defined. +DECL is a list `(declare ...)' containing the declarations. +The value the function returns is not used.") + +(defalias 'macro-declaration-function + #'(lambda (macro decl) + "Process a declaration found in a macro definition. This is set as the value of the variable `macro-declaration-function'. MACRO is the name of the macro being defined. DECL is a list `(declare ...)' containing the declarations. The return value of this function is not used." - ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. - (let (d) - ;; Ignore the first element of `decl' (it's always `declare'). - (while (setq decl (cdr decl)) - (setq d (car decl)) - (if (and (consp d) - (listp (cdr d)) - (null (cdr (cdr d)))) - (cond ((eq (car d) 'indent) - (put macro 'lisp-indent-function (car (cdr d)))) - ((eq (car d) 'debug) - (put macro 'edebug-form-spec (car (cdr d)))) - ((eq (car d) 'doc-string) - (put macro 'doc-string-elt (car (cdr d)))) - (t - (message "Unknown declaration %s" d))) - (message "Invalid declaration %s" d))))) - - -(setq macro-declaration-function 'macro-declaration-function) - + ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. + (let (d) + ;; Ignore the first element of `decl' (it's always `declare'). + (while (setq decl (cdr decl)) + (setq d (car decl)) + (if (and (consp d) + (listp (cdr d)) + (null (cdr (cdr d)))) + (cond ((eq (car d) 'indent) + (put macro 'lisp-indent-function (car (cdr d)))) + ((eq (car d) 'debug) + (put macro 'edebug-form-spec (car (cdr d)))) + ((eq (car d) 'doc-string) + (put macro 'doc-string-elt (car (cdr d)))) + (t + (message "Unknown declaration %s" d))) + (message "Invalid declaration %s" d)))))) + +(put 'defmacro 'doc-string-elt 3) +(defalias 'defmacro + (cons + 'macro + #'(lambda (name arglist &optional docstring decl &rest body) + "Define NAME as a macro. +When the macro is called, as in (NAME ARGS...), +the function (lambda ARGLIST BODY...) is applied to +the list ARGS... as it appears in the expression, +and the result should be a form to be evaluated instead of the original. + +DECL is a declaration, optional, which can specify how to indent +calls to this macro, how Edebug should handle it, and which argument +should be treated as documentation. It looks like this: + (declare SPECS...) +The elements can look like this: + (indent INDENT) + Set NAME's `lisp-indent-function' property to INDENT. + + (debug DEBUG) + Set NAME's `edebug-form-spec' property to DEBUG. (This is + equivalent to writing a `def-edebug-spec' for the macro.) + + (doc-string ELT) + Set NAME's `doc-string-elt' property to ELT." + (if (stringp docstring) nil + (if decl (setq body (cons decl body))) + (setq decl docstring) + (setq docstring nil)) + (if (or (null decl) (eq 'declare (car-safe decl))) nil + (setq body (cons decl body)) + (setq decl nil)) + (if (null body) (setq body '(nil))) + (if docstring (setq body (cons docstring body))) + ;; Can't use backquote because it's not defined yet! + (let* ((fun (list 'function (cons 'lambda (cons arglist body)))) + (def (list 'defalias + (list 'quote name) + (list 'cons ''macro fun)))) + (if decl + (list 'progn + (list 'funcall 'macro-declaration-function + (list 'quote name) + (list 'quote decl)) + def) + def))))) + +;; Now that we defined defmacro we can use it! +(defmacro defun (name arglist &optional docstring &rest body) + "Define NAME as a function. +The definition is (lambda ARGLIST [DOCSTRING] BODY...). +See also the function `interactive'." + (declare (doc-string 3)) + (if docstring (setq body (cons docstring body)) + (if (null body) (setq body '(nil)))) + (list 'defalias + (list 'quote name) + (list 'function + (cons 'lambda + (cons arglist body))))) ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-05-29 14:28:02 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-05-30 03:59:42 +0000 @@ -1169,12 +1169,14 @@ (t fn))))))) (defun byte-compile-arglist-signature (arglist) - (if (integerp arglist) - ;; New style byte-code arglist. - (cons (logand arglist 127) ;Mandatory. - (if (zerop (logand arglist 128)) ;No &rest. - (lsh arglist -8))) ;Nonrest. - ;; Old style byte-code, or interpreted function. + (cond + ;; New style byte-code arglist. + ((integerp arglist) + (cons (logand arglist 127) ;Mandatory. + (if (zerop (logand arglist 128)) ;No &rest. + (lsh arglist -8)))) ;Nonrest. + ;; Old style byte-code, or interpreted function. + ((listp arglist) (let ((args 0) opts restp) @@ -1190,7 +1192,9 @@ (setq opts (1+ opts)) (setq args (1+ args))))) (setq arglist (cdr arglist))) - (cons args (if restp nil (if opts (+ args opts) args)))))) + (cons args (if restp nil (if opts (+ args opts) args))))) + ;; Unknown arglist. + (t '(0)))) (defun byte-compile-arglist-signatures-congruent-p (old new) @@ -1250,8 +1254,8 @@ ;; and/or remember its arity if it's unknown. (or (and (or def (fboundp (car form))) ; might be a subr or autoload. (not (memq (car form) byte-compile-noruntime-functions))) - (eq (car form) byte-compile-current-form) ; ## this doesn't work - ; with recursion. + (eq (car form) byte-compile-current-form) ; ## This doesn't work + ; with recursion. ;; It's a currently-undefined function. ;; Remember number of args in call. (let ((cons (assq (car form) byte-compile-unresolved-functions)) @@ -1316,9 +1320,8 @@ ;; Warn if the function or macro is being redefined with a different ;; number of arguments. -(defun byte-compile-arglist-warn (form macrop) - (let* ((name (nth 1 form)) - (old (byte-compile-fdefinition name macrop)) +(defun byte-compile-arglist-warn (name arglist macrop) + (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name byte-compile-initial-macro-environment))))) @@ -1337,12 +1340,12 @@ (`(closure ,_ ,args . ,_) args) ((pred byte-code-function-p) (aref old 0)) (t '(&rest def))))) - (sig2 (byte-compile-arglist-signature (nth 2 form)))) + (sig2 (byte-compile-arglist-signature arglist))) (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) (byte-compile-set-symbol-position name) (byte-compile-warn "%s %s used to take %s %s, now takes %s" - (if (eq (car form) 'defun) "function" "macro") + (if macrop "macro" "function") name (byte-compile-arglist-signature-string sig1) (if (equal sig1 '(1 . 1)) "argument" "arguments") @@ -1356,7 +1359,7 @@ 'byte-compile-inline-expand)) (byte-compile-warn "defsubst `%s' was used before it was defined" name)) - (setq sig (byte-compile-arglist-signature (nth 2 form)) + (setq sig (byte-compile-arglist-signature arglist) nums (sort (copy-sequence (cdr calls)) (function <)) min (car nums) max (car (nreverse nums))) @@ -2021,31 +2024,30 @@ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))) (defun byte-compile-output-file-form (form) - ;; writes the given form to the output buffer, being careful of docstrings + ;; Write the given form to the output buffer, being careful of docstrings ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and ;; custom-declare-variable because make-docfile is so amazingly stupid. ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. - (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst - autoload custom-declare-variable)) - (stringp (nth 3 form))) - (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil - (memq (car form) - '(defvaralias autoload - custom-declare-variable))) - (let ((print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-quoted t) - (print-gensym t) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle))) + (let ((print-escape-newlines t) + (print-length nil) + (print-level nil) + (print-quoted t) + (print-gensym t) + (print-circle ; Handle circular data structures. + (not byte-compile-disable-print-circle))) + (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst + autoload custom-declare-variable)) + (stringp (nth 3 form))) + (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil + (memq (car form) + '(defvaralias autoload + custom-declare-variable))) (princ "\n" byte-compile--outbuffer) (prin1 form byte-compile--outbuffer) nil))) -(defvar print-gensym-alist) ;Used before print-circle existed. (defvar byte-compile--for-effect) (defun byte-compile-output-docform (preface name info form specindex quoted) @@ -2075,7 +2077,6 @@ (setq position (byte-compile-output-as-comment (nth (nth 1 info) form) nil)) - (setq position (- (position-bytes position) (point-min) -1)) ;; If the doc string starts with * (a user variable), ;; negate POSITION. (if (and (stringp (nth (nth 1 info) form)) @@ -2088,17 +2089,7 @@ (insert preface) (prin1 name byte-compile--outbuffer))) (insert (car info)) - (let ((print-escape-newlines t) - (print-quoted t) - ;; For compatibility with code before print-circle, - ;; use a cons cell to say that we want - ;; print-gensym-alist not to be cleared - ;; between calls to print functions. - (print-gensym '(t)) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle)) - print-gensym-alist ; was used before print-circle existed. - (print-continuous-numbering t) + (let ((print-continuous-numbering t) print-number-table (index 0)) (prin1 (car form) byte-compile--outbuffer) @@ -2121,8 +2112,6 @@ (byte-compile-output-as-comment (cons (car form) (nth 1 form)) t))) - (setq position (- (position-bytes position) - (point-min) -1)) (princ (format "(#$ . %d) nil" position) byte-compile--outbuffer) (setq form (cdr form)) @@ -2317,143 +2306,132 @@ (nth 1 (nth 1 form)) (byte-compile-keep-pending form))) -(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun) -(defun byte-compile-file-form-defun (form) - (byte-compile-file-form-defmumble form nil)) - -(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) -(defun byte-compile-file-form-defmacro (form) - (byte-compile-file-form-defmumble form t)) - -(defun byte-compile-defmacro-declaration (form) - "Generate code for declarations in macro definitions. -Remove declarations from the body of the macro definition -by side-effects." - (let ((tail (nthcdr 2 form)) - (res '())) - (when (stringp (car (cdr tail))) - (setq tail (cdr tail))) - (while (and (consp (car (cdr tail))) - (eq (car (car (cdr tail))) 'declare)) - (let ((declaration (car (cdr tail)))) - (setcdr tail (cdr (cdr tail))) - (push `(if macro-declaration-function - (funcall macro-declaration-function - ',(car (cdr form)) ',declaration)) - res))) - res)) - -(defun byte-compile-file-form-defmumble (form macrop) - (let* ((name (car (cdr form))) - (this-kind (if macrop 'byte-compile-macro-environment - 'byte-compile-function-environment)) - (that-kind (if macrop 'byte-compile-function-environment - 'byte-compile-macro-environment)) - (this-one (assq name (symbol-value this-kind))) - (that-one (assq name (symbol-value that-kind))) - (byte-compile-free-references nil) - (byte-compile-free-assignments nil)) +(defun byte-compile-file-form-defmumble (name macro arglist body rest) + "Process a `defalias' for NAME. +If MACRO is non-nil, the definition is known to be a macro. +ARGLIST is the list of arguments, if it was recognized or t otherwise. +BODY of the definition, or t if not recognized. +Return non-nil if everything went as planned, or nil to imply that it decided +not to take responsibility for the actual compilation of the code." + (let* ((this-kind (if macro 'byte-compile-macro-environment + 'byte-compile-function-environment)) + (that-kind (if macro 'byte-compile-function-environment + 'byte-compile-macro-environment)) + (this-one (assq name (symbol-value this-kind))) + (that-one (assq name (symbol-value that-kind))) + (byte-compile-current-form name)) ; For warnings. + (byte-compile-set-symbol-position name) ;; When a function or macro is defined, add it to the call tree so that ;; we can tell when functions are not used. (if byte-compile-generate-call-tree - (or (assq name byte-compile-call-tree) - (setq byte-compile-call-tree - (cons (list name nil nil) byte-compile-call-tree)))) + (or (assq name byte-compile-call-tree) + (setq byte-compile-call-tree + (cons (list name nil nil) byte-compile-call-tree)))) - (setq byte-compile-current-form name) ; for warnings (if (byte-compile-warning-enabled-p 'redefine) - (byte-compile-arglist-warn form macrop)) + (byte-compile-arglist-warn name arglist macro)) + (if byte-compile-verbose - (message "Compiling %s... (%s)" - (or byte-compile-current-file "") (nth 1 form))) - (cond (that-one - (if (and (byte-compile-warning-enabled-p 'redefine) - ;; don't warn when compiling the stubs in byte-run... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn + (message "Compiling %s... (%s)" + (or byte-compile-current-file "") name)) + (cond ((not (or macro (listp body))) + ;; We do not know positively if the definition is a macro + ;; or a function, so we shouldn't emit warnings. + ;; This also silences "multiple definition" warnings for defmethods. + nil) + (that-one + (if (and (byte-compile-warning-enabled-p 'redefine) + ;; Don't warn when compiling the stubs in byte-run... + (not (assq name byte-compile-initial-macro-environment))) + (byte-compile-warn "`%s' defined multiple times, as both function and macro" - (nth 1 form))) - (setcdr that-one nil)) - (this-one - (when (and (byte-compile-warning-enabled-p 'redefine) - ;; hack: don't warn when compiling the magic internal + name)) + (setcdr that-one nil)) + (this-one + (when (and (byte-compile-warning-enabled-p 'redefine) + ;; Hack: Don't warn when compiling the magic internal ;; byte-compiler macros in byte-run.el... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn "%s `%s' defined multiple times in this file" - (if macrop "macro" "function") - (nth 1 form)))) - ((and (fboundp name) - (eq (car-safe (symbol-function name)) - (if macrop 'lambda 'macro))) - (when (byte-compile-warning-enabled-p 'redefine) - (byte-compile-warn "%s `%s' being redefined as a %s" - (if macrop "function" "macro") - (nth 1 form) - (if macrop "macro" "function"))) - ;; shadow existing definition - (set this-kind - (cons (cons name nil) - (symbol-value this-kind)))) - ) - (let ((body (nthcdr 3 form))) - (when (and (stringp (car body)) - (symbolp (car-safe (cdr-safe body))) - (car-safe (cdr-safe body)) - (stringp (car-safe (cdr-safe (cdr-safe body))))) - (byte-compile-set-symbol-position (nth 1 form)) - (byte-compile-warn "probable `\"' without `\\' in doc string of %s" - (nth 1 form)))) - - ;; Generate code for declarations in macro definitions. - ;; Remove declarations from the body of the macro definition. - (when macrop - (dolist (decl (byte-compile-defmacro-declaration form)) - (prin1 decl byte-compile--outbuffer))) - - (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) - (if this-one - ;; A definition in b-c-initial-m-e should always take precedence - ;; during compilation, so don't let it be redefined. (Bug#8647) - (or (and macrop - (assq name byte-compile-initial-macro-environment)) - (setcdr this-one code)) - (set this-kind - (cons (cons name code) - (symbol-value this-kind)))) - (byte-compile-flush-pending) - (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")) - (append code nil) ; Turn byte-code-function-p into list. - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")) - (append code nil) ; Turn byte-code-function-p into list. - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile--outbuffer) - nil))) - -;; Print Lisp object EXP in the output file, inside a comment, -;; and return the file position it will have. -;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. + (not (assq name byte-compile-initial-macro-environment))) + (byte-compile-warn "%s `%s' defined multiple times in this file" + (if macro "macro" "function") + name))) + ((and (fboundp name) + (eq (car-safe (symbol-function name)) + (if macro 'lambda 'macro))) + (when (byte-compile-warning-enabled-p 'redefine) + (byte-compile-warn "%s `%s' being redefined as a %s" + (if macro "function" "macro") + name + (if macro "macro" "function"))) + ;; Shadow existing definition. + (set this-kind + (cons (cons name nil) + (symbol-value this-kind)))) + ) + + (when (and (listp body) + (stringp (car body)) + (symbolp (car-safe (cdr-safe body))) + (car-safe (cdr-safe body)) + (stringp (car-safe (cdr-safe (cdr-safe body))))) + ;; FIXME: We've done that already just above, so this looks wrong! + ;;(byte-compile-set-symbol-position name) + (byte-compile-warn "probable `\"' without `\\' in doc string of %s" + name)) + + (if (not (listp body)) + ;; The precise definition requires evaluation to find out, so it + ;; will only be known at runtime. + ;; For a macro, that means we can't use that macro in the same file. + (progn + (unless macro + (push (cons name (if (listp arglist) `(declared ,arglist) t)) + byte-compile-function-environment)) + ;; Tell the caller that we didn't compile it yet. + nil) + + (let* ((code (byte-compile-lambda (cons arglist body) t))) + (if this-one + ;; A definition in b-c-initial-m-e should always take precedence + ;; during compilation, so don't let it be redefined. (Bug#8647) + (or (and macro + (assq name byte-compile-initial-macro-environment)) + (setcdr this-one code)) + (set this-kind + (cons (cons name code) + (symbol-value this-kind)))) + + (if rest + ;; There are additional args to `defalias' (like maybe a docstring) + ;; that the code below can't handle: punt! + nil + ;; Otherwise, we have a bona-fide defun/defmacro definition, and use + ;; special code to allow dynamic docstrings and byte-code. + (byte-compile-flush-pending) + (let ((index + ;; If there's no doc string, provide -1 as the "doc string + ;; index" so that no element will be treated as a doc string. + (if (not (stringp (car body))) -1 4))) + ;; Output the form by hand, that's much simpler than having + ;; b-c-output-file-form analyze the defalias. + (byte-compile-output-docform + "\n(defalias '" + name + (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil)) + (princ ")" byte-compile--outbuffer) + t))))) + (defun byte-compile-output-as-comment (exp quoted) - (let ((position (point))) - (with-current-buffer byte-compile--outbuffer + "Print Lisp object EXP in the output file, inside a comment, +and return the file (byte) position it will have. +If QUOTED is non-nil, print with quoting; otherwise, print without quoting." + (with-current-buffer byte-compile--outbuffer + (let ((position (point))) ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") @@ -2478,13 +2456,12 @@ (position-bytes position)))) ;; Save the file position of the object. - ;; Note we should add 1 to skip the space - ;; that we inserted before the actual doc string, - ;; and subtract 1 to convert from an 1-origin Emacs position - ;; to a file position; they cancel. - (setq position (point)) - (goto-char (point-max))) - position)) + ;; Note we add 1 to skip the space that we inserted before the actual doc + ;; string, and subtract point-min to convert from an 1-origin Emacs + ;; position to a file position. + (prog1 + (- (position-bytes (point)) (point-min) -1) + (goto-char (point-max)))))) @@ -2581,14 +2558,15 @@ (lsh nonrest 8) (lsh rest 7))))) -;; Byte-compile a lambda-expression and return a valid function. -;; The value is usually a compiled function but may be the original -;; lambda-expression. -;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head -;; of the list FUN and `byte-compile-set-symbol-position' is not called. -;; Use this feature to avoid calling `byte-compile-set-symbol-position' -;; for symbols generated by the byte compiler itself. + (defun byte-compile-lambda (fun &optional add-lambda reserved-csts) + "Byte-compile a lambda-expression and return a valid function. +The value is usually a compiled function but may be the original +lambda-expression. +When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head +of the list FUN and `byte-compile-set-symbol-position' is not called. +Use this feature to avoid calling `byte-compile-set-symbol-position' +for symbols generated by the byte compiler itself." (if add-lambda (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) @@ -2649,24 +2627,23 @@ (byte-compile-make-lambda-lexenv fun)) reserved-csts))) ;; Build the actual byte-coded function. - (if (eq 'byte-code (car-safe compiled)) - (apply 'make-byte-code - (if lexical-binding - (byte-compile-make-args-desc arglist) - arglist) - (append - ;; byte-string, constants-vector, stack depth - (cdr compiled) - ;; optionally, the doc string. - (cond (lexical-binding - (require 'help-fns) - (list (help-add-fundoc-usage doc arglist))) - ((or doc int) - (list doc))) - ;; optionally, the interactive spec. - (if int - (list (nth 1 int))))) - (error "byte-compile-top-level did not return byte-code"))))) + (assert (eq 'byte-code (car-safe compiled))) + (apply #'make-byte-code + (if lexical-binding + (byte-compile-make-args-desc arglist) + arglist) + (append + ;; byte-string, constants-vector, stack depth + (cdr compiled) + ;; optionally, the doc string. + (cond (lexical-binding + (require 'help-fns) + (list (help-add-fundoc-usage doc arglist))) + ((or doc int) + (list doc))) + ;; optionally, the interactive spec. + (if int + (list (nth 1 int)))))))) (defvar byte-compile-reserved-constants 0) @@ -3066,9 +3043,9 @@ (byte-compile-check-variable var 'assign) (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding - ;; VAR is lexically bound + ;; VAR is lexically bound. (byte-compile-stack-set (cdr lex-binding)) - ;; VAR is dynamically bound + ;; VAR is dynamically bound. (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) (boundp var) (memq var byte-compile-bound-variables) @@ -3353,6 +3330,7 @@ (body (nthcdr 3 form)) (fun (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) + (assert (> (length env) 0)) ;Otherwise, we don't need a closure. (assert (byte-code-function-p fun)) (byte-compile-form `(make-byte-code ',(aref fun 0) ',(aref fun 1) @@ -4074,36 +4052,11 @@ ;;; top-level forms elsewhere -(byte-defop-compiler-1 defun) -(byte-defop-compiler-1 defmacro) (byte-defop-compiler-1 defvar) (byte-defop-compiler-1 defconst byte-compile-defvar) (byte-defop-compiler-1 autoload) (byte-defop-compiler-1 lambda byte-compile-lambda-form) -(defun byte-compile-defun (form) - ;; This is not used for file-level defuns with doc strings. - (if (symbolp (car form)) - (byte-compile-set-symbol-position (car form)) - (byte-compile-set-symbol-position 'defun) - (error "defun name must be a symbol, not %s" (car form))) - (byte-compile-push-constant 'defalias) - (byte-compile-push-constant (nth 1 form)) - (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t)) - (byte-compile-out 'byte-call 2)) - -(defun byte-compile-defmacro (form) - ;; This is not used for file-level defmacros with doc strings. - (byte-compile-body-do-effect - (let ((decls (byte-compile-defmacro-declaration form)) - (code (byte-compile-lambda (cdr (cdr form)) t))) - `((defalias ',(nth 1 form) - ,(if (eq (car-safe code) 'make-byte-code) - `(cons 'macro ,code) - `'(macro . ,(eval code)))) - ,@decls - ',(nth 1 form))))) - ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will ;; actually use `toto' in order for this obsolete variable to still work ;; correctly, so paradoxically, while byte-compiling foo.el, the presence @@ -4179,38 +4132,53 @@ (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias) ;; Used for eieio--defalias as well. (defun byte-compile-file-form-defalias (form) - (if (and (consp (cdr form)) (consp (nth 1 form)) - (eq (car (nth 1 form)) 'quote) - (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form)))) - (let ((constant - (and (consp (nthcdr 2 form)) - (consp (nth 2 form)) - (eq (car (nth 2 form)) 'quote) - (consp (cdr (nth 2 form))) - (symbolp (nth 1 (nth 2 form)))))) - (byte-compile-defalias-warn (nth 1 (nth 1 form))) - (push (cons (nth 1 (nth 1 form)) - (if constant (nth 1 (nth 2 form)) t)) - byte-compile-function-environment))) - ;; We used to just do: (byte-compile-normal-call form) - ;; But it turns out that this fails to optimize the code. - ;; So instead we now do the same as what other byte-hunk-handlers do, - ;; which is to call back byte-compile-file-form and then return nil. - ;; Except that we can't just call byte-compile-file-form since it would - ;; call us right back. - (byte-compile-keep-pending form) - ;; Return nil so the form is not output twice. - nil) + ;; For the compilation itself, we could largely get rid of this hunk-handler, + ;; if it weren't for the fact that we need to figure out when a defalias + ;; defines a macro, so as to add it to byte-compile-macro-environment. + ;; + ;; FIXME: we also use this hunk-handler to implement the function's dynamic + ;; docstring feature. We could actually implement it more elegantly in + ;; byte-compile-lambda so it applies to all lambdas, but the problem is that + ;; the resulting .elc format will not be recognized by make-docfile, so + ;; either we stop using DOC for the docstrings of preloaded elc files (at the + ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to + ;; build DOC in a more clever way (e.g. handle anonymous elements). + (let ((byte-compile-free-references nil) + (byte-compile-free-assignments nil)) + (pcase form + ;; Decompose `form' into: + ;; - `name' is the name of the defined function. + ;; - `arg' is the expression to which it is defined. + ;; - `rest' is the rest of the arguments. + (`(,_ ',name ,arg . ,rest) + (pcase-let* + ;; `macro' is non-nil if it defines a macro. + ;; `fun' is the function part of `arg' (defaults to `arg'). + (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t)) + (and (let fun arg) (let macro nil))) + arg) + ;; `lam' is the lambda expression in `fun' (or nil if not + ;; recognized). + ((or `(,(or `quote `function) ,lam) (let lam nil)) + fun) + ;; `arglist' is the list of arguments (or t if not recognized). + ;; `body' is the body of `lam' (or t if not recognized). + ((or `(lambda ,arglist . ,body) + ;; `(closure ,_ ,arglist . ,body) + (and `(internal-make-closure ,arglist . ,_) (let body t)) + (and (let arglist t) (let body t))) + lam)) + (unless (byte-compile-file-form-defmumble + name macro arglist body rest) + (byte-compile-keep-pending form)))) -;; Turn off warnings about prior calls to the function being defalias'd. -;; This could be smarter and compare those calls with -;; the function it is being aliased to. -(defun byte-compile-defalias-warn (new) - (let ((calls (assq new byte-compile-unresolved-functions))) - (if calls - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions))))) + ;; We used to just do: (byte-compile-normal-call form) + ;; But it turns out that this fails to optimize the code. + ;; So instead we now do the same as what other byte-hunk-handlers do, + ;; which is to call back byte-compile-file-form and then return nil. + ;; Except that we can't just call byte-compile-file-form since it would + ;; call us right back. + (t (byte-compile-keep-pending form))))) (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings) (defun byte-compile-no-warnings (form) === modified file 'lisp/emacs-lisp/cconv.el' --- lisp/emacs-lisp/cconv.el 2012-04-26 03:18:47 +0000 +++ lisp/emacs-lisp/cconv.el 2012-05-30 03:59:42 +0000 @@ -73,8 +73,6 @@ ;; since afterwards they can because obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). -;; - turn defun and defmacro into macros (and remove special handling of -;; `declare' afterwards). ;; - let macros specify that some let-bindings come from the same source, ;; so the unused warning takes all uses into account. ;; - let interactive specs return a function to build the args (to stash into @@ -410,20 +408,6 @@ . ,(mapcar (lambda (form) (cconv-convert form env extend)) forms))) - ;defun, defmacro - (`(,(and sym (or `defun `defmacro)) - ,func ,args . ,body) - (assert (equal body (caar cconv-freevars-alist))) - (assert (null (cdar cconv-freevars-alist))) - - (let ((new (cconv--convert-function args body env form))) - (pcase new - (`(function (lambda ,newargs . ,new-body)) - (assert (equal args newargs)) - `(,sym ,func ,args . ,new-body)) - (t (byte-compile-report-error - (format "Internal error in cconv of (%s %s ...)" sym func)))))) - ;condition-case (`(condition-case ,var ,protected-form . ,handlers) (let ((newform (cconv--convert-function @@ -618,15 +602,6 @@ (dolist (vardata newvars) (cconv--analyse-use vardata form "variable")))) - ; defun special form - (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) - (when env - (byte-compile-log-warning - (format "Function %S will ignore its context %S" - func (mapcar #'car env)) - t :warning)) - (cconv--analyse-function vrs body-forms nil form)) - (`(function (lambda ,vrs . ,body-forms)) (cconv--analyse-function vrs body-forms env form)) === modified file 'lisp/emacs-lisp/elint.el' --- lisp/emacs-lisp/elint.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/elint.el 2012-05-30 03:59:42 +0000 @@ -357,6 +357,8 @@ (set (make-local-variable 'elint-buffer-env) (elint-init-env elint-buffer-forms)) (if elint-preloaded-env + ;; FIXME: This doesn't do anything! Should we setq the result to + ;; elint-buffer-env? (elint-env-add-env elint-preloaded-env elint-buffer-env)) (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick)) elint-buffer-forms)) === modified file 'lisp/emacs-lisp/lisp-mode.el' --- lisp/emacs-lisp/lisp-mode.el 2012-05-27 09:45:54 +0000 +++ lisp/emacs-lisp/lisp-mode.el 2012-05-30 03:59:42 +0000 @@ -135,11 +135,9 @@ ;; This was originally in autoload.el and is still used there. (put 'autoload 'doc-string-elt 3) -(put 'defun 'doc-string-elt 3) (put 'defmethod 'doc-string-elt 3) (put 'defvar 'doc-string-elt 3) (put 'defconst 'doc-string-elt 3) -(put 'defmacro 'doc-string-elt 3) (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/macroexp.el 2012-05-30 03:59:42 +0000 @@ -65,7 +65,7 @@ (,unshared nil) (,tail ,shared) ,var ,new-el) - (while ,tail + (while (consp ,tail) (setq ,var (car ,tail) ,new-el (progn ,@body)) (unless (eq ,var ,new-el) @@ -128,20 +128,6 @@ (cddr form)) (cdr form)) form)) - (`(defmacro ,name . ,args-and-body) - (push (cons name (cons 'lambda args-and-body)) - macroexpand-all-environment) - (let ((n 3)) - ;; Don't macroexpand `declare' since it should really be "expanded" - ;; away when `defmacro' is expanded, but currently defmacro is not - ;; itself a macro. So both `defmacro' and `declare' need to be - ;; handled directly in bytecomp.el. - ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote). - (while (or (stringp (nth n form)) - (eq (car-safe (nth n form)) 'declare)) - (setq n (1+ n))) - (macroexpand-all-forms form n))) - (`(defun . ,_) (macroexpand-all-forms form 3)) (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) (`(function ,(and f `(lambda . ,_))) (maybe-cons 'function === modified file 'lisp/loadup.el' --- lisp/loadup.el 2012-05-25 22:13:24 +0000 +++ lisp/loadup.el 2012-05-30 03:59:42 +0000 @@ -318,6 +318,21 @@ ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") +(when (hash-table-p purify-flag) + (let ((strings 0) + (vectors 0) + (conses 0) + (others 0)) + (maphash (lambda (k v) + (cond + ((stringp k) (setq strings (1+ strings))) + ((vectorp k) (setq vectors (1+ vectors))) + ((consp k) (setq conses (1+ conses))) + (t (setq others (1+ others))))) + purify-flag) + (message "Pure-hashed: %d strings, %d vectors, %d conses, %d others" + strings vectors conses others))) + ;; Avoid error if user loads some more libraries now and make sure the ;; hash-consing hash table is GC'd. (setq purify-flag nil) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-29 21:33:38 +0000 +++ src/ChangeLog 2012-05-30 03:59:42 +0000 @@ -1,3 +1,13 @@ +2012-05-30 Stefan Monnier + + * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): + Move to byte-run.el. + (Fautoload): Do the hash-doc more carefully. + * data.c (Fdefalias): Purify definition, except for keymaps. + (Qdefun): Move from eval.c. + * lisp.h (Qdefun): Remove. + * lread.c (read1): Tiny simplification. + 2012-05-29 Troels Nielsen Do not create empty overlays with the evaporate property (Bug#9642). @@ -11,8 +21,8 @@ * w32term.c (my_bring_window_to_top): New function. (x_raise_frame): Use handle returned by DeferWindowPos, which - could be different from the original one. Call - my_bring_window_to_top instead of my_set_foreground_window. + could be different from the original one. + Call my_bring_window_to_top instead of my_set_foreground_window. (Bug#11513) * w32fns.c (w32_wnd_proc): Accept and process WM_EMACS_BRINGTOTOP @@ -103,12 +113,12 @@ 2012-05-26 Eli Zaretskii Extend mouse support on W32 text-mode console. - * xdisp.c (draw_row_with_mouse_face): Call - tty_draw_row_with_mouse_face for WINDOWSNT as well. + * xdisp.c (draw_row_with_mouse_face): + Call tty_draw_row_with_mouse_face for WINDOWSNT as well. * w32console.c: Include window.h. - (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face): New - functions. + (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face): + New functions. (initialize_w32_display): Initialize mouse-highlight data. * w32inevt.c: Include termchar.h and window.h. @@ -646,7 +656,7 @@ (marker_byte_position, Fbuffer_has_markers_at): Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough. (Fset_marker, set_marker_restricted): Don't assume fixnum fits in int. - * menu.c (ensure_menu_items): Renamed from grow_menu_items. + * menu.c (ensure_menu_items): Rename from grow_menu_items. It now merely ensures that the menu is large enough, without necessarily growing it, as this avoids some integer overflow issues. All callers changed. @@ -1091,8 +1101,8 @@ * xdisp.c (handle_single_display_spec): Return 1 for left-margin and right-margin display specs even if the spec is invalid or we - are on a TTY, and thus unable to display on the fringes. That's - because the text with the property will not be displayed anyway, + are on a TTY, and thus unable to display on the fringes. + That's because the text with the property will not be displayed anyway, so we need to signal to the caller that this is a "replacing" display spec. This fixes display when the spec is invalid or we are on a TTY. === modified file 'src/data.c' --- src/data.c 2012-05-25 18:19:24 +0000 +++ src/data.c 2012-05-30 03:59:42 +0000 @@ -34,6 +34,7 @@ #include "syssignal.h" #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ #include "font.h" +#include "keymap.h" #include /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ @@ -92,6 +93,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; +static Lisp_Object Qdefun; Lisp_Object Qinteractive_form; @@ -130,7 +132,7 @@ } -/* Data type predicates */ +/* Data type predicates. */ DEFUN ("eq", Feq, Seq, 2, 2, 0, doc: /* Return t if the two args are the same Lisp object. */) @@ -656,6 +658,10 @@ if (CONSP (XSYMBOL (symbol)->function) && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, symbol)); + if (!NILP (Vpurify_flag) + /* If `definition' is a keymap, immutable (and copying) is wrong. */ + && !KEYMAPP (definition)) + definition = Fpurecopy (definition); definition = Ffset (symbol, definition); LOADHIST_ATTACH (Fcons (Qdefun, symbol)); if (!NILP (docstring)) @@ -3085,6 +3091,8 @@ DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); + DEFSYM (Qdefun, "defun"); + DEFSYM (Qfont_spec, "font-spec"); DEFSYM (Qfont_entity, "font-entity"); DEFSYM (Qfont_object, "font-object"); === modified file 'src/eval.c' --- src/eval.c 2012-05-25 18:19:24 +0000 +++ src/eval.c 2012-05-30 03:59:42 +0000 @@ -65,7 +65,7 @@ int gcpro_level; #endif -Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; +Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp; Lisp_Object Qinhibit_quit; Lisp_Object Qand_rest; static Lisp_Object Qand_optional; @@ -593,109 +593,6 @@ } -DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0, - doc: /* Define NAME as a function. -The definition is (lambda ARGLIST [DOCSTRING] BODY...). -See also the function `interactive'. -usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object fn_name; - register Lisp_Object defn; - - fn_name = Fcar (args); - CHECK_SYMBOL (fn_name); - defn = Fcons (Qlambda, Fcdr (args)); - if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ - defn = Ffunction (Fcons (defn, Qnil)); - if (!NILP (Vpurify_flag)) - defn = Fpurecopy (defn); - if (CONSP (XSYMBOL (fn_name)->function) - && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, fn_name)); - Ffset (fn_name, defn); - LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); - return fn_name; -} - -DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0, - doc: /* Define NAME as a macro. -The actual definition looks like - (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...). -When the macro is called, as in (NAME ARGS...), -the function (lambda ARGLIST BODY...) is applied to -the list ARGS... as it appears in the expression, -and the result should be a form to be evaluated instead of the original. - -DECL is a declaration, optional, which can specify how to indent -calls to this macro, how Edebug should handle it, and which argument -should be treated as documentation. It looks like this: - (declare SPECS...) -The elements can look like this: - (indent INDENT) - Set NAME's `lisp-indent-function' property to INDENT. - - (debug DEBUG) - Set NAME's `edebug-form-spec' property to DEBUG. (This is - equivalent to writing a `def-edebug-spec' for the macro.) - - (doc-string ELT) - Set NAME's `doc-string-elt' property to ELT. - -usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object fn_name; - register Lisp_Object defn; - Lisp_Object lambda_list, doc, tail; - - fn_name = Fcar (args); - CHECK_SYMBOL (fn_name); - lambda_list = Fcar (Fcdr (args)); - tail = Fcdr (Fcdr (args)); - - doc = Qnil; - if (STRINGP (Fcar (tail))) - { - doc = XCAR (tail); - tail = XCDR (tail); - } - - if (CONSP (Fcar (tail)) - && EQ (Fcar (Fcar (tail)), Qdeclare)) - { - if (!NILP (Vmacro_declaration_function)) - { - struct gcpro gcpro1; - GCPRO1 (args); - call2 (Vmacro_declaration_function, fn_name, Fcar (tail)); - UNGCPRO; - } - - tail = Fcdr (tail); - } - - if (NILP (doc)) - tail = Fcons (lambda_list, tail); - else - tail = Fcons (lambda_list, Fcons (doc, tail)); - - defn = Fcons (Qlambda, tail); - if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ - defn = Ffunction (Fcons (defn, Qnil)); - defn = Fcons (Qmacro, defn); - - if (!NILP (Vpurify_flag)) - defn = Fpurecopy (defn); - if (CONSP (XSYMBOL (fn_name)->function) - && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, fn_name)); - Ffset (fn_name, defn); - LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); - return fn_name; -} - - DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. Aliased variables always have the same value; setting one sets the other. @@ -2014,12 +1911,11 @@ /* Only add entries after dumping, because the ones before are not useful and else we get loads of them from the loaddefs.el. */ LOADHIST_ATTACH (Fcons (Qautoload, function)); - else - /* We don't want the docstring in purespace (instead, - Snarf-documentation should (hopefully) overwrite it). - We used to use 0 here, but that leads to accidental sharing in - purecopy's hash-consing, so we use a (hopefully) unique integer - instead. */ + else if (EQ (docstring, make_number (0))) + /* `read1' in lread.c has found the docstring starting with "\ + and assumed the docstring will be provided by Snarf-documentation, so it + passed us 0 instead. But that leads to accidental sharing in purecopy's + hash-consing, so we use a (hopefully) unique integer instead. */ docstring = make_number (XUNTAG (function, Lisp_Symbol)); return Ffset (function, Fpurecopy (list5 (Qautoload, file, docstring, @@ -3576,7 +3472,6 @@ DEFSYM (Qinteractive, "interactive"); DEFSYM (Qcommandp, "commandp"); - DEFSYM (Qdefun, "defun"); DEFSYM (Qand_rest, "&rest"); DEFSYM (Qand_optional, "&optional"); DEFSYM (Qclosure, "closure"); @@ -3638,23 +3533,16 @@ still determine whether to handle the particular condition. */); Vdebug_on_signal = Qnil; - DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function, - doc: /* Function to process declarations in a macro definition. -The function will be called with two args MACRO and DECL. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The value the function returns is not used. */); - Vmacro_declaration_function = Qnil; - /* When lexical binding is being used, - vinternal_interpreter_environment is non-nil, and contains an alist + Vinternal_interpreter_environment is non-nil, and contains an alist of lexically-bound variable, or (t), indicating an empty environment. The lisp name of this variable would be `internal-interpreter-environment' if it weren't hidden. Every element of this list can be either a cons (VAR . VAL) specifying a lexical binding, or a single symbol VAR indicating that this variable should use dynamic scoping. */ - DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment"); + DEFSYM (Qinternal_interpreter_environment, + "internal-interpreter-environment"); DEFVAR_LISP ("internal-interpreter-environment", Vinternal_interpreter_environment, doc: /* If non-nil, the current lexical environment of the lisp interpreter. @@ -3685,8 +3573,6 @@ defsubr (&Ssetq); defsubr (&Squote); defsubr (&Sfunction); - defsubr (&Sdefun); - defsubr (&Sdefmacro); defsubr (&Sdefvar); defsubr (&Sdefvaralias); defsubr (&Sdefconst); === modified file 'src/lisp.h' --- src/lisp.h 2012-05-27 07:51:09 +0000 +++ src/lisp.h 2012-05-30 03:59:42 +0000 @@ -3001,7 +3001,7 @@ extern void syms_of_lread (void); /* Defined in eval.c. */ -extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; +extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro; extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; === modified file 'src/lread.c' --- src/lread.c 2012-05-26 08:30:49 +0000 +++ src/lread.c 2012-05-30 03:59:42 +0000 @@ -2982,7 +2982,7 @@ /* If purifying, and string starts with \ newline, return zero instead. This is for doc strings - that we are really going to find in etc/DOC.nn.nn */ + that we are really going to find in etc/DOC.nn.nn. */ if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) return make_number (0); @@ -3095,18 +3095,17 @@ nbytes) : nbytes); - if (uninterned_symbol && ! NILP (Vpurify_flag)) - name = make_pure_string (read_buffer, nchars, nbytes, multibyte); - else - name = make_specified_string (read_buffer, nchars, nbytes, multibyte); + name = ((uninterned_symbol && ! NILP (Vpurify_flag) + ? make_pure_string : make_specified_string) + (read_buffer, nchars, nbytes, multibyte)); result = (uninterned_symbol ? Fmake_symbol (name) : Fintern (name, Qnil)); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) - Vread_symbol_positions_list = - Fcons (Fcons (result, make_number (start_position)), - Vread_symbol_positions_list); + Vread_symbol_positions_list + = Fcons (Fcons (result, make_number (start_position)), + Vread_symbol_positions_list); return result; } } @@ -3520,7 +3519,7 @@ We don't use Fexpand_file_name because that would make the directory absolute now. */ elt = concat2 (build_string ("../lisp/"), - Ffile_name_nondirectory (elt)); + Ffile_name_nondirectory (elt)); } else if (EQ (elt, Vload_file_name) && ! NILP (elt) ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.