Now on revision 109173. ------------------------------------------------------------ revno: 109173 fixes bug(s): http://debbugs.gnu.org/11984 committer: Chong Yidong branch nick: trunk timestamp: Sat 2012-07-21 14:17:30 +0800 message: Disallow windows on dead frames in decode_any_window. * window.c (decode_any_window): Signal an error if the window is on a dead frame. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-21 06:13:23 +0000 +++ src/ChangeLog 2012-07-21 06:17:30 +0000 @@ -1,3 +1,8 @@ +2012-07-21 Chong Yidong + + * window.c (decode_any_window): Signal an error if the window is + on a dead frame (Bug#11984). + 2012-07-20 Dmitry Antipov Add indirection counting to speed up Fkill_buffer. === modified file 'src/window.c' --- src/window.c 2012-07-21 06:13:23 +0000 +++ src/window.c 2012-07-21 06:17:30 +0000 @@ -144,11 +144,15 @@ static struct window * decode_any_window (register Lisp_Object window) { + struct window *w; + if (NILP (window)) return XWINDOW (selected_window); CHECK_WINDOW (window); - return XWINDOW (window); + w = XWINDOW (window); + CHECK_LIVE_FRAME (w->frame); + return w; } DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0, ------------------------------------------------------------ revno: 109172 [merge] committer: Chong Yidong branch nick: trunk timestamp: Sat 2012-07-21 14:14:00 +0800 message: Merge from emacs-24 branch; up to r108077 diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-07-17 07:43:01 +0000 +++ doc/emacs/ChangeLog 2012-07-21 06:13:23 +0000 @@ -1,3 +1,7 @@ +2012-07-19 Chong Yidong + + * emacs.texi: Update ISBN. + 2012-07-17 Chong Yidong * basic.texi (Inserting Text): Replace ucs-insert with === modified file 'doc/emacs/emacs.texi' --- doc/emacs/emacs.texi 2012-07-06 04:48:35 +0000 +++ doc/emacs/emacs.texi 2012-07-21 06:13:23 +0000 @@ -94,7 +94,7 @@ Published by the Free Software Foundation @* 51 Franklin Street, Fifth Floor @* Boston, MA 02110-1301 USA @* -ISBN 978-0-9831592-2-3 +ISBN 978-0-9831592-3-0 @sp 2 Cover art by Etienne Suvasa; cover design by Matt Lee. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-20 21:09:04 +0000 +++ lisp/ChangeLog 2012-07-21 06:13:23 +0000 @@ -1,3 +1,24 @@ +2012-07-21 Leo Liu + + * progmodes/cc-cmds.el (c-defun-name): Use + match-string-no-properties instead for consistency. + +2012-07-20 Leo Liu + + * progmodes/cc-cmds.el (c-defun-name): Handle objc selectors properly. + (Bug#7879) + + * progmodes/cc-langs.el (c-symbol-start): Include char _ (bug#11986). + +2012-07-20 Stefan Monnier + + * userlock.el, emacs-lisp/map-ynp.el: Declare part of `emacs' package. + * progmodes/bug-reference.el, misearch.el: Provide themselves + (bug#11915). + + * progmodes/cperl-mode.el (cperl-unwind-to-safe): Don't inf-loop at end + of narrowed buffer (bug#11966). + 2012-07-20 Vincent Belaïche * ses.el (ses-rename-cell): Set new name also in reference list of === modified file 'lisp/emacs-lisp/map-ynp.el' --- lisp/emacs-lisp/map-ynp.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/map-ynp.el 2012-07-18 11:44:13 +0000 @@ -5,6 +5,7 @@ ;; Author: Roland McGrath ;; Maintainer: FSF ;; Keywords: lisp, extensions +;; Package: emacs ;; This file is part of GNU Emacs. === modified file 'lisp/misearch.el' --- lisp/misearch.el 2012-05-29 09:09:38 +0000 +++ lisp/misearch.el 2012-07-21 06:13:23 +0000 @@ -373,5 +373,5 @@ (provide 'multi-isearch) - +(provide 'misearch) ;;; misearch.el ends here === modified file 'lisp/progmodes/bug-reference.el' --- lisp/progmodes/bug-reference.el 2012-07-03 02:16:11 +0000 +++ lisp/progmodes/bug-reference.el 2012-07-21 06:13:23 +0000 @@ -30,6 +30,8 @@ ;; Two minor modes are provided. One works on any text in the buffer; ;; the other operates only on comments and strings. +;;; Code: + (defvar bug-reference-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'bug-reference-push-button) @@ -154,4 +156,5 @@ (widen) (bug-reference-unfontify (point-min) (point-max))))) +(provide 'bug-reference) ;;; bug-reference.el ends here === modified file 'lisp/progmodes/cc-cmds.el' --- lisp/progmodes/cc-cmds.el 2012-07-14 09:08:36 +0000 +++ lisp/progmodes/cc-cmds.el 2012-07-21 06:13:23 +0000 @@ -1826,14 +1826,16 @@ ;; DEFFLAGSET(syslog_opt_flags,LOG_PID ...) ==> syslog_opt_flags (match-string-no-properties 1)) - ;; Objective-C method starting with + or -. - ((and (derived-mode-p 'objc-mode) - (looking-at "[-+]\s*(")) - (when (c-syntactic-re-search-forward ")\s*" nil t) - (c-forward-token-2) - (setq name-end (point)) - (c-backward-token-2) - (buffer-substring-no-properties (point) name-end))) + ;; Objc selectors. + ((assq 'objc-method-intro (c-guess-basic-syntax)) + (let ((bound (save-excursion (c-end-of-statement) (point))) + (kw-re (concat "\\(?:" c-symbol-key "\\)?:")) + (stretches)) + (when (c-syntactic-re-search-forward c-symbol-key bound t t t) + (push (match-string-no-properties 0) stretches) + (while (c-syntactic-re-search-forward kw-re bound t t t) + (push (match-string-no-properties 0) stretches))) + (apply 'concat (nreverse stretches)))) (t ;; Normal function or initializer. === modified file 'lisp/progmodes/cc-langs.el' --- lisp/progmodes/cc-langs.el 2012-03-02 22:16:21 +0000 +++ lisp/progmodes/cc-langs.el 2012-07-20 11:36:41 +0000 @@ -578,7 +578,7 @@ operator at the top level." t (concat "[" c-alpha "_]") java (concat "[" c-alpha "_@]") - objc (concat "[" c-alpha "@]") + objc (concat "[" c-alpha "_@]") pike (concat "[" c-alpha "_`]")) (c-lang-defvar c-symbol-start (c-lang-const c-symbol-start)) === modified file 'lisp/progmodes/cperl-mode.el' --- lisp/progmodes/cperl-mode.el 2012-06-29 06:28:37 +0000 +++ lisp/progmodes/cperl-mode.el 2012-07-21 06:13:23 +0000 @@ -3497,7 +3497,8 @@ (if end ;; Do the same for end, going small steps (save-excursion - (while (and end (get-text-property end 'syntax-type)) + (while (and end (< end (point-max)) + (get-text-property end 'syntax-type)) (setq pos end end (next-single-property-change end 'syntax-type nil (point-max))) (if end (progn (goto-char end) === modified file 'lisp/userlock.el' --- lisp/userlock.el 2012-01-19 07:21:25 +0000 +++ lisp/userlock.el 2012-07-18 11:44:13 +0000 @@ -4,6 +4,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. === modified file 'src/window.c' --- src/window.c 2012-07-10 16:53:26 +0000 +++ src/window.c 2012-07-21 06:13:23 +0000 @@ -484,9 +484,7 @@ (Lisp_Object window, Lisp_Object limit) { register struct window *w = decode_any_window (window); - w->combination_limit = limit; - return w->combination_limit; } ------------------------------------------------------------ revno: 109171 committer: Vincent Belaïche branch nick: trunk timestamp: Fri 2012-07-20 23:09:04 +0200 message: * ses.el (ses-rename-cell): Set new name also in reference list of cells of which the renamed cell depends. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-20 11:32:30 +0000 +++ lisp/ChangeLog 2012-07-20 21:09:04 +0000 @@ -1,3 +1,8 @@ +2012-07-20 Vincent Belaïche + + * ses.el (ses-rename-cell): Set new name also in reference list of + cells of which the renamed cell depends. + 2012-07-20 Masatake YAMATO * term/x-win.el (x-menu-bar-open): Use `frame-parameter' === modified file 'lisp/ses.el' --- lisp/ses.el 2012-07-11 23:13:41 +0000 +++ lisp/ses.el 2012-07-20 21:09:04 +0000 @@ -3209,17 +3209,28 @@ new-name))) (error "Already a bound cell name"))) (let* ((rowcol (ses-sym-rowcol ses--curcell)) - (cell (ses-get-cell (car rowcol) (cdr rowcol)))) + (row (car rowcol)) + (col (cdr rowcol)) + (cell (ses-get-cell row col))) (put new-name 'ses-cell rowcol) - (dolist (reference (ses-cell-references (car rowcol) (cdr rowcol))) - (let* ((rowcol (ses-sym-rowcol reference)) - (cell (ses-get-cell (car rowcol) (cdr rowcol)))) + ;; replace name by new name in formula of cells refering to renamed cell + (dolist (ref (ses-cell-references cell)) + (let* ((x (ses-sym-rowcol ref)) + (xcell (ses-get-cell (car x) (cdr x)))) (ses-cell-set-formula (car rowcol) (cdr rowcol) (ses-replace-name-in-formula - (ses-cell-formula cell) + (ses-cell-formula xcell) ses--curcell new-name)))) + ;; replace name by new name in reference list of cells to which renamed cell refers to + (dolist (ref (ses-formula-references (ses-cell-formula cell))) + (let* ((x (ses-sym-rowcol ref)) + (xrow (car x)) + (xcol (cdr x))) + (ses-set-cell xrow xcol 'references + (cons new-name (delq ses--curcell + (ses-cell-references xrow xcol)))))) (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value ses--curcell)) (aset cell 0 new-name) ------------------------------------------------------------ revno: 109170 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 20:05:47 +0400 message: Add indirection counting to speed up Fkill_buffer. * buffer.h (struct buffer): New member. * buffer.c (Fget_buffer_create): Set indirection counter to 0. (Fmake_indirect_buffer): Set indirection counter to -1, increment base buffer indirection counter. (compact_buffer): If ENABLE_CHECKING, verify indirection counters. (Fkill_buffer): Adjust indirection counters as needed, don't walk through buffer list if indirection counter is 0. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-20 14:07:28 +0000 +++ src/ChangeLog 2012-07-20 16:05:47 +0000 @@ -1,5 +1,16 @@ 2012-07-20 Dmitry Antipov + Add indirection counting to speed up Fkill_buffer. + * buffer.h (struct buffer): New member. + * buffer.c (Fget_buffer_create): Set indirection counter to 0. + (Fmake_indirect_buffer): Set indirection counter to -1, increment + base buffer indirection counter. + (compact_buffer): If ENABLE_CHECKING, verify indirection counters. + (Fkill_buffer): Adjust indirection counters as needed, don't walk + through buffer list if indirection counter is 0. + +2012-07-20 Dmitry Antipov + Extend the value returned by Fgarbage_collect with heap statistics. * alloc.c (Qheap): New symbol. (syms_of_alloc): DEFSYM it. === modified file 'src/buffer.c' --- src/buffer.c 2012-07-20 14:07:28 +0000 +++ src/buffer.c 2012-07-20 16:05:47 +0000 @@ -329,7 +329,9 @@ /* An ordinary buffer uses its own struct buffer_text. */ b->text = &b->own_text; - b->base_buffer = 0; + b->base_buffer = NULL; + /* No one shares the text with us now. */ + b->indirections = 0; BUF_GAP_SIZE (b) = 20; BLOCK_INPUT; @@ -568,12 +570,18 @@ b = allocate_buffer (); + /* No double indirection - if base buffer is indirect, + new buffer becomes an indirect to base's base. */ b->base_buffer = (XBUFFER (base_buffer)->base_buffer ? XBUFFER (base_buffer)->base_buffer : XBUFFER (base_buffer)); /* Use the base buffer's text object. */ b->text = b->base_buffer->text; + /* We have no own text. */ + b->indirections = -1; + /* Notify base buffer that we share the text now. */ + b->base_buffer->indirections++; b->pt = b->base_buffer->pt; b->begv = b->base_buffer->begv; @@ -1439,6 +1447,15 @@ int compact_buffer (struct buffer *buffer) { + /* Verify indirection counters. */ + if (buffer->base_buffer) + { + eassert (buffer->indirections == -1); + eassert (buffer->base_buffer->indirections > 0); + } + else + eassert (buffer->indirections >= 0); + /* Skip dead buffers, indirect buffers and buffers which aren't changed since last compaction. */ if (!NILP (buffer->BUFFER_INTERNAL_FIELD (name)) @@ -1555,10 +1572,19 @@ if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; - /* When we kill a base buffer, kill all its indirect buffers. + /* Notify our base buffer that we don't share the text anymore. */ + if (b->base_buffer) + { + eassert (b->indirections == -1); + b->base_buffer->indirections--; + eassert (b->base_buffer->indirections >= 0); + } + + /* When we kill an ordinary buffer which shares it's buffer text + with indirect buffer(s), we must kill indirect buffer(s) too. We do it at this stage so nothing terrible happens if they ask questions or their hooks get errors. */ - if (! b->base_buffer) + if (!b->base_buffer && b->indirections > 0) { struct buffer *other; === modified file 'src/buffer.h' --- src/buffer.h 2012-07-19 22:35:58 +0000 +++ src/buffer.h 2012-07-20 16:05:47 +0000 @@ -775,6 +775,11 @@ In an ordinary buffer, it is 0. */ struct buffer *base_buffer; + /* In an indirect buffer, this is -1. In an ordinary buffer, + it's the number of indirect buffers which shares our text; + zero means that we're the only owner of this text. */ + int indirections; + /* A non-zero value in slot IDX means that per-buffer variable with index IDX has a local value in this buffer. The index IDX for a buffer-local variable is stored in that variable's slot ------------------------------------------------------------ revno: 109169 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 18:07:28 +0400 message: Extend the value returned by Fgarbage_collect with heap statistics. * alloc.c (Qheap): New symbol. (syms_of_alloc): DEFSYM it. (Fgarbage_collect): If DOUG_LEA_MALLOC, add mallinfo data. (Fmemory_free): Remove. (syms_of_alloc): Don't defsubr it. * buffer.c (Fcompact_buffer): Remove. (syms_of_buffer): Don't defsubr it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-20 13:14:58 +0000 +++ src/ChangeLog 2012-07-20 14:07:28 +0000 @@ -1,5 +1,16 @@ 2012-07-20 Dmitry Antipov + Extend the value returned by Fgarbage_collect with heap statistics. + * alloc.c (Qheap): New symbol. + (syms_of_alloc): DEFSYM it. + (Fgarbage_collect): If DOUG_LEA_MALLOC, add mallinfo data. + (Fmemory_free): Remove. + (syms_of_alloc): Don't defsubr it. + * buffer.c (Fcompact_buffer): Remove. + (syms_of_buffer): Don't defsubr it. + +2012-07-20 Dmitry Antipov + Make maybe_gc inline. Verify that inlining is always possible (GCC 4.7.1, -O3 -Winline). * lisp.h (consing_since_gc, gc_relative_threshold) === modified file 'src/alloc.c' --- src/alloc.c 2012-07-20 13:14:58 +0000 +++ src/alloc.c 2012-07-20 14:07:28 +0000 @@ -258,7 +258,7 @@ static ptrdiff_t stack_copy_size; #endif -static Lisp_Object Qstring_bytes, Qvector_slots; +static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; static Lisp_Object Qgc_cons_threshold; Lisp_Object Qchar_table_extra_slots; @@ -5396,7 +5396,7 @@ char stack_top_variable; ptrdiff_t i; int message_p; - Lisp_Object total[10]; + Lisp_Object total[11]; ptrdiff_t count = SPECPDL_INDEX (); EMACS_TIME t1; @@ -5655,6 +5655,15 @@ total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)), bounded_number (total_buffers)); + total[10] = list4 (Qheap, make_number (1024), +#ifdef DOUG_LEA_MALLOC + bounded_number ((mallinfo ().uordblks + 1023) >> 10), + bounded_number ((mallinfo ().fordblks + 1023) >> 10) +#else + Qnil, Qnil +#endif + ); + #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES { /* Compute average percentage of zombies. */ @@ -6602,33 +6611,6 @@ return end; } -DEFUN ("memory-free", Fmemory_free, Smemory_free, 0, 0, 0, - doc: /* Return a list (E H) of two measures of free memory. -E counts free lists maintained by Emacs itself. H counts the heap, -freed by Emacs but not released to the operating system; this is zero -if heap statistics are not available. Both counters are in units of -1024 bytes, rounded up. */) - (void) -{ - /* Make the return value first, so that its storage is accounted for. */ - Lisp_Object val = Fmake_list (make_number (2), make_number (0)); - - XSETCAR (val, - bounded_number - ((total_free_conses * sizeof (struct Lisp_Cons) - + total_free_markers * sizeof (union Lisp_Misc) - + total_free_symbols * sizeof (struct Lisp_Symbol) - + total_free_floats * sizeof (struct Lisp_Float) - + total_free_intervals * sizeof (struct interval) - + total_free_strings * sizeof (struct Lisp_String) - + total_free_vector_slots * word_size - + 1023) >> 10)); -#ifdef DOUG_LEA_MALLOC - XSETCAR (XCDR (val), bounded_number ((mallinfo ().fordblks + 1023) >> 10)); -#endif - return val; -} - DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, doc: /* Return a list of counters that measure how much consing there has been. Each of these counters increments for a certain kind of object. @@ -6845,6 +6827,7 @@ DEFSYM (Qstring_bytes, "string-bytes"); DEFSYM (Qvector_slots, "vector-slots"); + DEFSYM (Qheap, "heap"); DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); @@ -6868,7 +6851,6 @@ defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Smemory_limit); - defsubr (&Smemory_free); defsubr (&Smemory_use_counts); #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES === modified file 'src/buffer.c' --- src/buffer.c 2012-07-19 22:35:58 +0000 +++ src/buffer.c 2012-07-20 14:07:28 +0000 @@ -1474,19 +1474,6 @@ return 0; } -DEFUN ("compact-buffer", Fcompact_buffer, Scompact_buffer, 0, 1, 0, - doc: /* Compact BUFFER by truncating undo list and shrinking the gap. -If buffer is nil, compact current buffer. Compaction is performed -only if buffer was changed since last compaction. Return t if -buffer compaction was performed, and nil otherwise. */) - (Lisp_Object buffer) -{ - if (NILP (buffer)) - XSETBUFFER (buffer, current_buffer); - CHECK_BUFFER (buffer); - return compact_buffer (XBUFFER (buffer)) ? Qt : Qnil; -} - DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ", doc: /* Kill the buffer specified by BUFFER-OR-NAME. The argument may be a buffer or the name of an existing buffer. @@ -6048,7 +6035,6 @@ defsubr (&Srename_buffer); defsubr (&Sother_buffer); defsubr (&Sbuffer_enable_undo); - defsubr (&Scompact_buffer); defsubr (&Skill_buffer); defsubr (&Sbury_buffer_internal); defsubr (&Sset_buffer_major_mode); ------------------------------------------------------------ revno: 109168 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 17:14:58 +0400 message: Make maybe_gc inline. Verify that inlining is always possible (GCC 4.7.1, -O3 -Winline). * lisp.h (consing_since_gc, gc_relative_threshold) (memory_full_cons_threshold): Revert declaration. (maybe_gc): Remove prototype, define as inline. * alloc.c: Remove old commented-out code. (consing_since_gc, gc_relative_threshold) (memory_full_cons_threshold): Revert to global. (maybe_gc): Remove. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-20 07:29:04 +0000 +++ src/ChangeLog 2012-07-20 13:14:58 +0000 @@ -1,5 +1,17 @@ 2012-07-20 Dmitry Antipov + Make maybe_gc inline. + Verify that inlining is always possible (GCC 4.7.1, -O3 -Winline). + * lisp.h (consing_since_gc, gc_relative_threshold) + (memory_full_cons_threshold): Revert declaration. + (maybe_gc): Remove prototype, define as inline. + * alloc.c: Remove old commented-out code. + (consing_since_gc, gc_relative_threshold) + (memory_full_cons_threshold): Revert to global. + (maybe_gc): Remove. + +2012-07-20 Dmitry Antipov + Simple wrapper for make_unibyte_string, adjust font_open_by_name. * lisp.h (build_unibyte_string): New function. * dosfns.c, fileio.c, fns.c, ftfont.c, process.c: === modified file 'src/alloc.c' --- src/alloc.c 2012-07-20 05:28:00 +0000 +++ src/alloc.c 2012-07-20 13:14:58 +0000 @@ -166,16 +166,16 @@ /* Number of bytes of consing done since the last gc. */ -static EMACS_INT consing_since_gc; +EMACS_INT consing_since_gc; /* Similar minimum, computed from Vgc_cons_percentage. */ -static EMACS_INT gc_relative_threshold; +EMACS_INT gc_relative_threshold; /* Minimum number of bytes of consing since GC before next GC, when memory is full. */ -static EMACS_INT memory_full_cons_threshold; +EMACS_INT memory_full_cons_threshold; /* Nonzero during GC. */ @@ -5374,18 +5374,6 @@ return make_number (min (MOST_POSITIVE_FIXNUM, number)); } -/* Check whether it's time for GC, and run it if so. */ - -void -maybe_gc (void) -{ - if ((consing_since_gc > gc_cons_threshold - && consing_since_gc > gc_relative_threshold) - || (!NILP (Vmemory_full) - && consing_since_gc > memory_full_cons_threshold)) - Fgarbage_collect (); -} - DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than @@ -5474,8 +5462,6 @@ gc_in_progress = 1; - /* clear_marks (); */ - /* Mark all the special slots that serve as the roots of accessibility. */ for (i = 0; i < staticidx; i++) @@ -5592,7 +5578,6 @@ CHECK_CONS_LIST (); - /* clear_marks (); */ gc_in_progress = 0; consing_since_gc = 0; === modified file 'src/lisp.h' --- src/lisp.h 2012-07-20 07:29:04 +0000 +++ src/lisp.h 2012-07-20 13:14:58 +0000 @@ -2593,10 +2593,12 @@ #if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif -extern void maybe_gc (void); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; extern Lisp_Object *stack_base; +extern EMACS_INT consing_since_gc; +extern EMACS_INT gc_relative_threshold; +extern EMACS_INT memory_full_cons_threshold; extern Lisp_Object list1 (Lisp_Object); extern Lisp_Object list2 (Lisp_Object, Lisp_Object); extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); @@ -3434,4 +3436,16 @@ #include "globals.h" +/* Check whether it's time for GC, and run it if so. */ + +static inline void +maybe_gc (void) +{ + if ((consing_since_gc > gc_cons_threshold + && consing_since_gc > gc_relative_threshold) + || (!NILP (Vmemory_full) + && consing_since_gc > memory_full_cons_threshold)) + Fgarbage_collect (); +} + #endif /* EMACS_LISP_H */ ------------------------------------------------------------ revno: 109167 author: Masatake YAMATO committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-07-20 07:32:30 -0400 message: * lisp/term/x-win.el (x-menu-bar-open): Use `frame-parameter' to check whether menu-bar is shown or not. If not shown, show the menu-bar as a popup menu instead of using tmm. * lisp/mouse.el (popup-menu): Accept `point' as `position' argument. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-20 11:10:25 +0000 +++ lisp/ChangeLog 2012-07-20 11:32:30 +0000 @@ -1,3 +1,10 @@ +2012-07-20 Masatake YAMATO + + * term/x-win.el (x-menu-bar-open): Use `frame-parameter' + to check whether menu-bar is shown or not. If not shown, + show the menu-bar as a popup menu instead of using tmm. + * mouse.el (popup-menu): Accept `point' as `position' argument. + 2012-07-20 Dmitry Gutov * progmodes/ruby-mode.el (ruby-parse-partial): No error when end === modified file 'lisp/mouse.el' --- lisp/mouse.el 2012-07-08 08:26:21 +0000 +++ lisp/mouse.el 2012-07-20 11:32:30 +0000 @@ -102,7 +102,8 @@ MENU can be a keymap, an easymenu-style menu or a list of keymaps as for `x-popup-menu'. POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to - the current mouse position. + the current mouse position. If POSITION is a symbol, `point' the current point +position is used. PREFIX is the prefix argument (if any) to pass to the command." (let* ((map (cond ((keymapp menu) menu) @@ -112,9 +113,17 @@ (plist-get (get map 'menu-prop) :filter)))) (if filter (funcall filter (symbol-function map)) map))))) event cmd) - (unless position - (let ((mp (mouse-pixel-position))) - (setq position (list (list (cadr mp) (cddr mp)) (car mp))))) + (setq position + (cond + ((eq position 'point) + (let* ((pp (posn-at-point pos window)) + (xy (posn-x-y pp))) + (list (list (car xy) (cdr xy)) (posn-window pp)))) + ((not position) + (let ((mp (mouse-pixel-position))) + (list (list (cadr mp) (cddr mp)) (car mp)))) + (t + position))) ;; The looping behavior was taken from lmenu's popup-menu-popup (while (and map (setq event ;; map could be a prefix key, in which case === modified file 'lisp/term/x-win.el' --- lisp/term/x-win.el 2012-04-27 05:40:46 +0000 +++ lisp/term/x-win.el 2012-07-20 11:32:30 +0000 @@ -1305,12 +1305,18 @@ (declare-function accelerate-menu "xmenu.c" (&optional frame) t) (defun x-menu-bar-open (&optional frame) - "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'." + "Open the menu bar if it is shown. +`popup-menu' is used if it is off " (interactive "i") - (if (and menu-bar-mode - (fboundp 'accelerate-menu)) - (accelerate-menu frame) - (tmm-menubar))) + (cond + ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))) + (fboundp 'accelerate-menu)) + (accelerate-menu frame)) + (t + (popup-menu (mouse-menu-bar-map) + (if (listp last-nonmenu-event) + nil + 'point))))) ;;; Window system initialization. ------------------------------------------------------------ revno: 109166 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11923 author: Dmitry Gutov committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-07-20 07:10:25 -0400 message: * lisp/progmodes/ruby-mode.el (ruby-parse-partial): No error when end up inside string symbol literal. * test/automated/ruby-mode-tests.el: New file with one test. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-20 10:29:32 +0000 +++ lisp/ChangeLog 2012-07-20 11:10:25 +0000 @@ -1,3 +1,8 @@ +2012-07-20 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-parse-partial): No error when end + up inside string symbol literal (bug#11923). + 2012-07-20 Eli Zaretskii * startup.el (fancy-startup-text): Read the whole tutorial, not === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2012-04-24 17:02:46 +0000 +++ lisp/progmodes/ruby-mode.el 2012-07-20 11:10:25 +0000 @@ -594,7 +594,7 @@ (goto-char pnt)) ((looking-at ":\\(['\"]\\)") (goto-char (match-beginning 1)) - (ruby-forward-string (buffer-substring (match-beginning 1) (match-end 1)) end)) + (ruby-forward-string (match-string 1) end t)) ((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\|![~=]?\\)") (goto-char (match-end 0))) ((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?") === modified file 'test/ChangeLog' --- test/ChangeLog 2012-07-17 08:38:12 +0000 +++ test/ChangeLog 2012-07-20 11:10:25 +0000 @@ -1,3 +1,7 @@ +2012-07-20 Dmitry Gutov + + * automated/ruby-mode-tests.el: New file with one test. + 2012-07-17 Stefan Monnier * indent/shell.sh: Add test case for ${#VAR}. === added file 'test/automated/ruby-mode-tests.el' --- test/automated/ruby-mode-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/ruby-mode-tests.el 2012-07-20 11:10:25 +0000 @@ -0,0 +1,39 @@ +;;; ruby-mode-tests.el --- Test suite for ruby-mode + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ruby-mode) + +(ert-deftest indent-line-after-symbol-made-from-string-interpolation () + "It can indent the line after symbol made using string interpolation." + (let ((initial-content "def foo(suffix)\n :\"bar#{suffix}\"\n") + (expected-content "def foo(suffix)\n :\"bar#{suffix}\"\n ")) + (with-temp-buffer + (insert initial-content) + (ruby-indent-line) ; Doesn't rely on text properties or the syntax table. + (let ((buffer-content (buffer-substring-no-properties (point-min) + (point-max)))) + (should (string= buffer-content expected-content)))))) + +(provide 'ruby-mode-tests) + +;;; ruby-mode-tests.el ends here ------------------------------------------------------------ revno: 109165 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2012-07-20 13:29:32 +0300 message: Fix display of Hebrew tutorial title on splash screen. lisp/startup.el (fancy-startup-text): Read the whole tutorial, not just its first 256 bytes. Prevents gibberish in display of the tutorial title. etc/tutorials/TUTORIAL.he: Make the first sentence display correctly in a left-to-right paragraph, such as what is shown on the fancy splash screen, by using directional control characters. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2012-07-15 00:52:16 +0000 +++ etc/ChangeLog 2012-07-20 10:29:32 +0000 @@ -1,3 +1,9 @@ +2012-07-20 Eli Zaretskii + + * tutorials/TUTORIAL.he: Make the first sentence display correctly + in a left-to-right paragraph, such as what is shown on the fancy + splash screen. + 2012-07-15 Leo Liu * NEWS: Mention exclamation-mark and flymake. === modified file 'etc/tutorials/TUTORIAL.he' --- etc/tutorials/TUTORIAL.he 2012-01-14 11:23:45 +0000 +++ etc/tutorials/TUTORIAL.he 2012-07-20 10:29:32 +0000 @@ -1,4 +1,4 @@ -שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך. +שיעור ראשון בשימוש ב־‫Emacs‬. זכויות שימוש ראה בסוף המסמך. פקודות רבות של Emacs משתמשות במקש CONTROL (לפעמים הוא מסומן ב־CTRL או CTL) או במקש META (לפעמים מסומן EDIT או ALT). במקום לציין את כל השמות האפשריים === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-20 04:13:04 +0000 +++ lisp/ChangeLog 2012-07-20 10:29:32 +0000 @@ -1,3 +1,9 @@ +2012-07-20 Eli Zaretskii + + * startup.el (fancy-startup-text): Read the whole tutorial, not + just its first 256 bytes. Prevents gibberish in display of the + tutorial title. + 2012-07-20 Dmitry Antipov Drop idle buffer compaction due to an absence of the === modified file 'lisp/startup.el' --- lisp/startup.el 2012-06-22 21:24:54 +0000 +++ lisp/startup.el 2012-07-20 10:29:32 +0000 @@ -1311,7 +1311,15 @@ (title (with-temp-buffer (insert-file-contents (expand-file-name tut tutorial-directory) - nil 0 256) + ;; We used to read only the first 256 bytes of + ;; the tutorial, but that prevents the coding: + ;; setting, if any, in file-local variables + ;; section to be seen by insert-file-contents, + ;; and results in gibberish when the language + ;; environment's preferred encoding is + ;; different from what the file-local variable + ;; says. One case in point is Hebrew. + nil) (search-forward ".") (buffer-substring (point-min) (1- (point)))))) ;; If there is a specific tutorial for the current language ------------------------------------------------------------ revno: 109164 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 11:29:04 +0400 message: Simple wrapper for make_unibyte_string, adjust font_open_by_name. * src/lisp.h (build_unibyte_string): New function. * src/dosfns.c, src/fileio.c, src/fns.c, src/ftfont.c, src/process.c: * src/sysdep.c, src/w32fns.c, src/xfns.c: Use it. * src/font.c (font_open_by_name): Change 2nd and 3rd args to the only arg of type Lisp_Object to avoid redundant calls to make_unibyte_string. Adjust users accordingly. * src/font.h (font_open_by_name): Adjust prototype. * admin/coccinelle/unibyte_string.cocci: Semantic patch to convert from make_unibyte_string to build_unibyte_string where appropriate. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-17 11:52:00 +0000 +++ admin/ChangeLog 2012-07-20 07:29:04 +0000 @@ -1,3 +1,8 @@ +2012-07-20 Dmitry Antipov + + * coccinelle/unibyte_string.cocci: Semantic patch to convert from + make_unibyte_string to build_unibyte_string where appropriate. + 2012-07-17 Eli Zaretskii * CPP-DEFINES: Remove FILE_SYSTEM_CASE. @@ -5,6 +10,7 @@ 2012-07-17 Chong Yidong * Version 24.1 released. + 2012-07-11 Paul Eggert Assume mkdir, perror, rename, rmdir, strerror. === added file 'admin/coccinelle/unibyte_string.cocci' --- admin/coccinelle/unibyte_string.cocci 1970-01-01 00:00:00 +0000 +++ admin/coccinelle/unibyte_string.cocci 2012-07-20 07:29:04 +0000 @@ -0,0 +1,6 @@ +// make_unibyte_string (str, strlen (str)) -> build_unibyte_string (str) +@@ +identifier I; +@@ +- make_unibyte_string (I, strlen (I)) ++ build_unibyte_string (I) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-20 05:28:00 +0000 +++ src/ChangeLog 2012-07-20 07:29:04 +0000 @@ -1,5 +1,16 @@ 2012-07-20 Dmitry Antipov + Simple wrapper for make_unibyte_string, adjust font_open_by_name. + * lisp.h (build_unibyte_string): New function. + * dosfns.c, fileio.c, fns.c, ftfont.c, process.c: + * sysdep.c, w32fns.c, xfns.c: Use it. + * font.c (font_open_by_name): Change 2nd and 3rd args to the only arg + of type Lisp_Object to avoid redundant calls to make_unibyte_string. + Adjust users accordingly. + * font.h (font_open_by_name): Adjust prototype. + +2012-07-20 Dmitry Antipov + Cleanup calls to Fgarbage_collect. * lisp.h (maybe_gc): New prototype. (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold): === modified file 'src/dosfns.c' --- src/dosfns.c 2012-07-03 18:24:42 +0000 +++ src/dosfns.c 2012-07-20 07:29:04 +0000 @@ -562,7 +562,7 @@ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); strcpy (cmd, basename (__crt0_argv[0])); /* Command name is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (cmd, strlen (cmd)); + cmd_str = build_unibyte_string (cmd); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); @@ -630,7 +630,7 @@ q[-1] = '\0'; /* Command line is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (cmdline, strlen (cmdline)); + cmd_str = build_unibyte_string (cmdline); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); xfree (cmdline); === modified file 'src/fileio.c' --- src/fileio.c 2012-07-17 11:52:00 +0000 +++ src/fileio.c 2012-07-20 07:29:04 +0000 @@ -159,8 +159,7 @@ synchronize_system_messages_locale (); str = strerror (errorno); - errstring = code_convert_string_norecord (make_unibyte_string (str, - strlen (str)), + errstring = code_convert_string_norecord (build_unibyte_string (str), Vlocale_coding_system, 0); while (1) @@ -1658,7 +1657,7 @@ env variables twice should be acceptable. Note that decoding may cause a garbage collect. */ Lisp_Object orig, decoded; - orig = make_unibyte_string (o, strlen (o)); + orig = build_unibyte_string (o); decoded = DECODE_FILE (orig); total += SBYTES (decoded); substituted = 1; === modified file 'src/fns.c' --- src/fns.c 2012-07-16 04:47:31 +0000 +++ src/fns.c 2012-07-20 07:29:04 +0000 @@ -2818,7 +2818,7 @@ for (i = 0; i < 7; i++) { str = nl_langinfo (days[i]); - val = make_unibyte_string (str, strlen (str)); + val = build_unibyte_string (str); /* Fixme: Is this coding system necessarily right, even if it is consistent with CODESET? If not, what to do? */ Faset (v, make_number (i), @@ -2842,7 +2842,7 @@ for (i = 0; i < 12; i++) { str = nl_langinfo (months[i]); - val = make_unibyte_string (str, strlen (str)); + val = build_unibyte_string (str); Faset (v, make_number (i), code_convert_string_norecord (val, Vlocale_coding_system, 0)); } === modified file 'src/font.c' --- src/font.c 2012-07-15 07:57:54 +0000 +++ src/font.c 2012-07-20 07:29:04 +0000 @@ -3350,13 +3350,13 @@ found, return Qnil. */ Lisp_Object -font_open_by_name (FRAME_PTR f, const char *name, ptrdiff_t len) +font_open_by_name (FRAME_PTR f, Lisp_Object name) { Lisp_Object args[2]; Lisp_Object spec, ret; args[0] = QCname; - args[1] = make_unibyte_string (name, len); + args[1] = name; spec = Ffont_spec (2, args); ret = font_open_by_spec (f, spec); /* Do not lose name originally put in. */ @@ -4878,7 +4878,7 @@ if (fontset >= 0) name = fontset_ascii (fontset); - font_object = font_open_by_name (f, SSDATA (name), SBYTES (name)); + font_object = font_open_by_name (f, name); } else if (FONT_OBJECT_P (name)) font_object = name; === modified file 'src/font.h' --- src/font.h 2012-07-11 06:14:19 +0000 +++ src/font.h 2012-07-20 07:29:04 +0000 @@ -771,7 +771,7 @@ extern void font_done_for_face (FRAME_PTR f, struct face *face); extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec); -extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name, ptrdiff_t len); +extern Lisp_Object font_open_by_name (FRAME_PTR f, Lisp_Object name); extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len, int force_symbol); === modified file 'src/frame.c' --- src/frame.c 2012-07-18 08:11:08 +0000 +++ src/frame.c 2012-07-20 07:29:04 +0000 @@ -3167,16 +3167,14 @@ fontset = fs_query_fontset (arg, 0); if (fontset < 0) { - font_object = font_open_by_name (f, SSDATA (arg), SBYTES (arg)); + font_object = font_open_by_name (f, arg); if (NILP (font_object)) error ("Font `%s' is not defined", SSDATA (arg)); arg = AREF (font_object, FONT_NAME_INDEX); } else if (fontset > 0) { - Lisp_Object ascii_font = fontset_ascii (fontset); - - font_object = font_open_by_name (f, SSDATA (ascii_font), SBYTES (ascii_font)); + font_object = font_open_by_name (f, fontset_ascii (fontset)); if (NILP (font_object)) error ("Font `%s' is not defined", SDATA (arg)); arg = AREF (font_object, FONT_NAME_INDEX); === modified file 'src/ftfont.c' --- src/ftfont.c 2012-07-11 06:14:19 +0000 +++ src/ftfont.c 2012-07-20 07:29:04 +0000 @@ -211,7 +211,7 @@ return Qnil; file = (char *) str; - key = Fcons (make_unibyte_string (file, strlen (file)), make_number (idx)); + key = Fcons (build_unibyte_string (file), make_number (idx)); cache = ftfont_lookup_cache (key, FTFONT_CACHE_FOR_ENTITY); entity = XCAR (cache); if (! NILP (entity)) === modified file 'src/lisp.h' --- src/lisp.h 2012-07-20 05:28:00 +0000 +++ src/lisp.h 2012-07-20 07:29:04 +0000 @@ -2609,6 +2609,15 @@ extern Lisp_Object make_formatted_string (char *, const char *, ...) ATTRIBUTE_FORMAT_PRINTF (2, 3); extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t); + +/* Make unibyte string from C string when the length isn't known. */ + +static inline Lisp_Object +build_unibyte_string (const char *str) +{ + return make_unibyte_string (str, strlen (str)); +} + extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_event_array (int, Lisp_Object *); extern Lisp_Object make_uninit_string (EMACS_INT); === modified file 'src/process.c' --- src/process.c 2012-07-13 00:07:29 +0000 +++ src/process.c 2012-07-20 07:29:04 +0000 @@ -497,7 +497,7 @@ { int c1, c2; - string = make_unibyte_string (signame, strlen (signame)); + string = build_unibyte_string (signame); if (! NILP (Vlocale_coding_system)) string = (code_convert_string_norecord (string, Vlocale_coding_system, 0)); === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-11 07:05:21 +0000 +++ src/sysdep.c 2012-07-20 07:29:04 +0000 @@ -3092,7 +3092,7 @@ decoded_comm = (code_convert_string_norecord - (make_unibyte_string (args, strlen (args)), + (build_unibyte_string (args), Vlocale_coding_system, 0)); attrs = Fcons (Fcons (Qargs, decoded_comm), attrs); === modified file 'src/w32fns.c' --- src/w32fns.c 2012-07-11 04:31:53 +0000 +++ src/w32fns.c 2012-07-20 07:29:04 +0000 @@ -4036,7 +4036,7 @@ for (i = 0; names[i]; i++) { - font = font_open_by_name (f, names[i], strlen (names[i])); + font = font_open_by_name (f, build_unibyte_string (names[i])); if (! NILP (font)) break; } @@ -6197,8 +6197,7 @@ if (!NILP (Vlocale_coding_system)) { Lisp_Object decoded = - code_convert_string_norecord (make_unibyte_string (errstr, - strlen (errstr)), + code_convert_string_norecord (build_unibyte_string (errstr), Vlocale_coding_system, 0); errstr = SSDATA (decoded); } === modified file 'src/xfns.c' --- src/xfns.c 2012-07-11 04:31:53 +0000 +++ src/xfns.c 2012-07-20 07:29:04 +0000 @@ -2956,7 +2956,7 @@ read yet. */ const char *system_font = xsettings_get_system_font (); if (system_font) - font = font_open_by_name (f, system_font, strlen (system_font)); + font = font_open_by_name (f, build_unibyte_string (system_font)); } if (NILP (font)) @@ -2986,7 +2986,7 @@ for (i = 0; names[i]; i++) { - font = font_open_by_name (f, names[i], strlen (names[i])); + font = font_open_by_name (f, build_unibyte_string (names[i])); if (! NILP (font)) break; } ------------------------------------------------------------ revno: 109163 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 09:28:00 +0400 message: Cleanup calls to Fgarbage_collect. * lisp.h (maybe_gc): New prototype. (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold): Remove declarations. * alloc.c (maybe_gc): New function. (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold): Make them static. * bytecode.c (MAYBE_GC): Use maybe_gc. * eval.c (eval_sub, Ffuncall): Likewise. * keyboard.c (read_char): Likewise. Adjust call to maybe_gc to avoid dependency from auto-save feature. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-19 22:35:58 +0000 +++ src/ChangeLog 2012-07-20 05:28:00 +0000 @@ -1,3 +1,17 @@ +2012-07-20 Dmitry Antipov + + Cleanup calls to Fgarbage_collect. + * lisp.h (maybe_gc): New prototype. + (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold): + Remove declarations. + * alloc.c (maybe_gc): New function. + (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold): + Make them static. + * bytecode.c (MAYBE_GC): Use maybe_gc. + * eval.c (eval_sub, Ffuncall): Likewise. + * keyboard.c (read_char): Likewise. Adjust call to maybe_gc + to avoid dependency from auto-save feature. + 2012-07-19 Paul Eggert * buffer.h (FOR_EACH_BUFFER): Rename from 'for_each_buffer'. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-19 22:35:58 +0000 +++ src/alloc.c 2012-07-20 05:28:00 +0000 @@ -166,16 +166,16 @@ /* Number of bytes of consing done since the last gc. */ -EMACS_INT consing_since_gc; +static EMACS_INT consing_since_gc; /* Similar minimum, computed from Vgc_cons_percentage. */ -EMACS_INT gc_relative_threshold; +static EMACS_INT gc_relative_threshold; /* Minimum number of bytes of consing since GC before next GC, when memory is full. */ -EMACS_INT memory_full_cons_threshold; +static EMACS_INT memory_full_cons_threshold; /* Nonzero during GC. */ @@ -5374,6 +5374,18 @@ return make_number (min (MOST_POSITIVE_FIXNUM, number)); } +/* Check whether it's time for GC, and run it if so. */ + +void +maybe_gc (void) +{ + if ((consing_since_gc > gc_cons_threshold + && consing_since_gc > gc_relative_threshold) + || (!NILP (Vmemory_full) + && consing_since_gc > memory_full_cons_threshold)) + Fgarbage_collect (); +} + DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than === modified file 'src/bytecode.c' --- src/bytecode.c 2012-07-10 22:40:34 +0000 +++ src/bytecode.c 2012-07-20 05:28:00 +0000 @@ -423,15 +423,11 @@ /* Garbage collect if we have consed enough since the last time. We do this at every branch, to avoid loops that never GC. */ -#define MAYBE_GC() \ - do { \ - if (consing_since_gc > gc_cons_threshold \ - && consing_since_gc > gc_relative_threshold) \ - { \ - BEFORE_POTENTIAL_GC (); \ - Fgarbage_collect (); \ - AFTER_POTENTIAL_GC (); \ - } \ +#define MAYBE_GC() \ + do { \ + BEFORE_POTENTIAL_GC (); \ + maybe_gc (); \ + AFTER_POTENTIAL_GC (); \ } while (0) /* Check for jumping out of range. */ === modified file 'src/eval.c' --- src/eval.c 2012-07-18 15:20:33 +0000 +++ src/eval.c 2012-07-20 05:28:00 +0000 @@ -2040,15 +2040,7 @@ return form; QUIT; - if ((consing_since_gc > gc_cons_threshold - && consing_since_gc > gc_relative_threshold) - || - (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold)) - { - GCPRO1 (form); - Fgarbage_collect (); - UNGCPRO; - } + maybe_gc (); if (++lisp_eval_depth > max_lisp_eval_depth) { @@ -2737,11 +2729,7 @@ ptrdiff_t i; QUIT; - if ((consing_since_gc > gc_cons_threshold - && consing_since_gc > gc_relative_threshold) - || - (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold)) - Fgarbage_collect (); + maybe_gc (); if (++lisp_eval_depth > max_lisp_eval_depth) { === modified file 'src/keyboard.c' --- src/keyboard.c 2012-07-18 13:20:59 +0000 +++ src/keyboard.c 2012-07-20 05:28:00 +0000 @@ -2705,17 +2705,13 @@ && ! CONSP (Vunread_command_events)) { Fdo_auto_save (Qnil, Qnil); - - /* If we have auto-saved and there is still no input - available, garbage collect if there has been enough - consing going on to make it worthwhile. */ - if (!detect_input_pending_run_timers (0) - && consing_since_gc > gc_cons_threshold / 2) - Fgarbage_collect (); - redisplay (); } } + + /* If there is still no input available, ask for GC. */ + if (!detect_input_pending_run_timers (0)) + maybe_gc (); } /* Notify the caller if an autosave hook, or a timer, sentinel or === modified file 'src/lisp.h' --- src/lisp.h 2012-07-19 03:55:59 +0000 +++ src/lisp.h 2012-07-20 05:28:00 +0000 @@ -2091,14 +2091,6 @@ extern Lisp_Object Vascii_downcase_table; extern Lisp_Object Vascii_canon_table; -/* Number of bytes of structure consed since last GC. */ - -extern EMACS_INT consing_since_gc; - -extern EMACS_INT gc_relative_threshold; - -extern EMACS_INT memory_full_cons_threshold; - /* Structure for recording stack slots that need marking. */ /* This is a chain of structures, each of which points at a Lisp_Object @@ -2601,6 +2593,7 @@ #if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif +extern void maybe_gc (void); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; extern Lisp_Object *stack_base; ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.