Now on revision 109163. ------------------------------------------------------------ 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; ------------------------------------------------------------ revno: 109162 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-07-20 08:13:04 +0400 message: Drop idle buffer compaction due to an absence of the proved efficiency. * lisp/compact.el: Remove. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 14:38:01 +0000 +++ lisp/ChangeLog 2012-07-20 04:13:04 +0000 @@ -1,3 +1,9 @@ +2012-07-20 Dmitry Antipov + + Drop idle buffer compaction due to an absence of the + proved efficiency. + * compact.el: Remove. + 2012-07-19 Sam Steingold * vc/vc-dispatcher.el (vc-compilation-mode): Add, based on === removed file 'lisp/compact.el' --- lisp/compact.el 2012-07-19 08:56:53 +0000 +++ lisp/compact.el 1970-01-01 00:00:00 +0000 @@ -1,60 +0,0 @@ -;;; compact.el --- compact buffers when idle - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Package: emacs - -;; 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: - -;; This package provides the ability to compact buffers when Emacs is idle. -;; Initially written by Dmitry Antipov . - -;;; Code: - -(require 'timer) - -(defun compact-buffers () - "Run `compact-buffer' for each buffer except current buffer. -Schedule next compaction if `compact-buffers-when-idle' is greater than zero." - (mapc (lambda (buffer) - (and (not (eq buffer (current-buffer))) - (compact-buffer buffer))) - (buffer-list)) - (compact-buffers-idle)) - -(defun compact-buffers-idle () - "Compact buffers if `compact-buffers-when-idle' is greater than zero." - (and (floatp compact-buffers-when-idle) - (> compact-buffers-when-idle 0.0) - (run-with-idle-timer compact-buffers-when-idle nil 'compact-buffers))) - -(defcustom compact-buffers-when-idle 1.0 - "Compact all buffers when Emacs is idle more than this period of time. -Compaction is done by truncating `buffer-undo-list' and shrinking the gap. -Value less than or equal to zero disables idle compaction." - :type 'float - :group 'alloc - :set (lambda (symbol value) - (progn (set-default symbol value) - (compact-buffers-idle))) - :version "24.2") - -(provide 'compact) - -;;; compact.el ends here ------------------------------------------------------------ revno: 109161 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-07-19 15:35:58 -0700 message: * buffer.h (FOR_EACH_BUFFER): Rename from 'for_each_buffer'. (FOR_EACH_PER_BUFFER_OBJECT_AT): Rename from 'for_each_per_buffer_object_at'. All uses changed. It's better to use upper-case for macros that cannot be implemented as functions, to give the reader a clue that they're special. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-19 11:39:38 +0000 +++ src/ChangeLog 2012-07-19 22:35:58 +0000 @@ -1,3 +1,12 @@ +2012-07-19 Paul Eggert + + * buffer.h (FOR_EACH_BUFFER): Rename from 'for_each_buffer'. + (FOR_EACH_PER_BUFFER_OBJECT_AT): Rename from + 'for_each_per_buffer_object_at'. + All uses changed. It's better to use upper-case for macros that + cannot be implemented as functions, to give the reader a clue + that they're special. + 2012-07-19 Stefan Monnier * alloc.c (Fgarbage_collect): Tweak docstring. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-19 11:39:38 +0000 +++ src/alloc.c 2012-07-19 22:35:58 +0000 @@ -5412,7 +5412,7 @@ /* Don't keep undo information around forever. Do this early on, so it is no problem if the user quits. */ - for_each_buffer (nextb) + FOR_EACH_BUFFER (nextb) compact_buffer (nextb); t1 = current_emacs_time (); @@ -5527,7 +5527,7 @@ Look thru every buffer's undo list for elements that update markers that were not marked, and delete them. */ - for_each_buffer (nextb) + FOR_EACH_BUFFER (nextb) { /* If a buffer's undo list is Qt, that means that undo is turned off in that buffer. Calling truncate_undo_list on @@ -5955,7 +5955,7 @@ if (po != &buffer_defaults && po != &buffer_local_symbols) { struct buffer *b; - for_each_buffer (b) + FOR_EACH_BUFFER (b) if (b == po) break; if (b == NULL) === modified file 'src/buffer.c' --- src/buffer.c 2012-07-19 08:56:53 +0000 +++ src/buffer.c 2012-07-19 22:35:58 +0000 @@ -460,7 +460,7 @@ { int offset; - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { Lisp_Object obj; @@ -612,7 +612,7 @@ eassert (NILP (BVAR (b->base_buffer, begv_marker))); eassert (NILP (BVAR (b->base_buffer, zv_marker))); - BVAR (b->base_buffer, pt_marker) + BVAR (b->base_buffer, pt_marker) = build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte); BVAR (b->base_buffer, begv_marker) @@ -817,7 +817,7 @@ SET_PER_BUFFER_VALUE_P (b, i, 0); /* For each slot that has a default value, copy that into the slot. */ - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { int idx = PER_BUFFER_IDX (offset); if ((idx > 0 @@ -862,7 +862,7 @@ { /* Note fileio.c:make_temp_name does random differently. */ tem2 = concat2 (name, make_formatted_string - (number, "-%"pI"d", + (number, "-%"pI"d", XFASTINT (Frandom (make_number (999999))))); tem = Fget_buffer (tem2); if (NILP (tem)) @@ -1072,7 +1072,7 @@ { int offset, idx; - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { idx = PER_BUFFER_IDX (offset); if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) @@ -1577,7 +1577,7 @@ GCPRO1 (buffer); - for_each_buffer (other) + FOR_EACH_BUFFER (other) if (other->base_buffer == b) { Lisp_Object buf; @@ -2095,7 +2095,7 @@ { /* This is probably harder to make work. */ struct buffer *other; - for_each_buffer (other) + FOR_EACH_BUFFER (other) if (other->base_buffer == other_buffer || other->base_buffer == current_buffer) error ("One of the buffers to swap has indirect buffers"); @@ -2472,7 +2472,7 @@ /* Copy this buffer's new multibyte status into all of its indirect buffers. */ - for_each_buffer (other) + FOR_EACH_BUFFER (other) if (other->base_buffer == current_buffer && !NILP (BVAR (other, name))) { BVAR (other, enable_multibyte_characters) @@ -5078,7 +5078,7 @@ Map new memory. */ struct buffer *b; - for_each_buffer (b) + FOR_EACH_BUFFER (b) if (b->text->beg == NULL) enlarge_buffer_text (b, 0); } === modified file 'src/buffer.h' --- src/buffer.h 2012-07-19 08:56:53 +0000 +++ src/buffer.h 2012-07-19 22:35:58 +0000 @@ -866,7 +866,7 @@ /* Used to iterate over the chain above. */ -#define for_each_buffer(b) \ +#define FOR_EACH_BUFFER(b) \ for ((b) = all_buffers; (b); (b) = (b)->header.next.buffer) /* This points to the current buffer. */ @@ -1021,7 +1021,7 @@ Lisp_Objects except undo_list). If you add, remove, or reorder Lisp_Objects in a struct buffer, make sure that this is still correct. */ -#define for_each_per_buffer_object_at(offset) \ +#define FOR_EACH_PER_BUFFER_OBJECT_AT(offset) \ for (offset = PER_BUFFER_VAR_OFFSET (name); \ offset <= PER_BUFFER_VAR_OFFSET (cursor_in_non_selected_windows); \ offset += sizeof (Lisp_Object)) === modified file 'src/data.c' --- src/data.c 2012-07-19 03:55:59 +0000 +++ src/data.c 2012-07-19 22:35:58 +0000 @@ -1401,7 +1401,7 @@ { struct buffer *b; - for_each_buffer (b) + FOR_EACH_BUFFER (b) if (!PER_BUFFER_VALUE_P (b, idx)) PER_BUFFER_VALUE (b, offset) = value; } ------------------------------------------------------------ revno: 109160 committer: Sam Steingold branch nick: trunk timestamp: Thu 2012-07-19 10:38:01 -0400 message: * lisp/vc/vc-dispatcher.el (vc-compilation-mode): Add, based on vc-bzr-pull & vc-bzr-merge-branch. * lisp/vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Use it. (vc-bzr-error-regexp-alist): Rename from vc-bzr-error-regex-alist for consistency with compilation-error-regexp-alist. * lisp/vc/vc-git.el (vc-git-error-regexp-alist): Add. (vc-git-pull, vc-git-merge-branch): Call vc-compilation-mode. * lisp/vc/vc-hg.el (vc-hg-error-regexp-alist): Add. (vc-hg-pull, vc-hg-merge-branch): Call vc-compilation-mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 11:39:38 +0000 +++ lisp/ChangeLog 2012-07-19 14:38:01 +0000 @@ -1,3 +1,15 @@ +2012-07-19 Sam Steingold + + * vc/vc-dispatcher.el (vc-compilation-mode): Add, based on + vc-bzr-pull & vc-bzr-merge-branch. + * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Use it. + (vc-bzr-error-regexp-alist): Rename from vc-bzr-error-regex-alist + for consistency with compilation-error-regexp-alist. + * vc/vc-git.el (vc-git-error-regexp-alist): Add. + (vc-git-pull, vc-git-merge-branch): Call vc-compilation-mode. + * vc/vc-hg.el (vc-hg-error-regexp-alist): Add. + (vc-hg-pull, vc-hg-merge-branch): Call vc-compilation-mode. + 2012-07-19 Stefan Monnier * emacs-lisp/chart.el: Use lexical-binding. === modified file 'lisp/vc/vc-bzr.el' --- lisp/vc/vc-bzr.el 2012-07-11 23:13:41 +0000 +++ lisp/vc/vc-bzr.el 2012-07-19 14:38:01 +0000 @@ -311,7 +311,7 @@ (when rootdir (file-relative-name filename* rootdir)))) -(defvar vc-bzr-error-regex-alist +(defvar vc-bzr-error-regexp-alist '(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1) ("^C \\(.+\\)" 2) ("^Text conflict in \\(.+\\)" 1 nil nil 2) @@ -347,14 +347,7 @@ command (cadr args) args (cddr args))) (let ((buf (apply 'vc-bzr-async-command command args))) - (with-current-buffer buf - (vc-exec-after - `(progn - (let ((compilation-error-regexp-alist - vc-bzr-error-regex-alist)) - (compilation-mode)) - (set (make-local-variable 'compilation-error-regexp-alist) - vc-bzr-error-regex-alist)))) + (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) (defun vc-bzr-merge-branch () @@ -385,14 +378,7 @@ (command (cadr cmd)) (args (cddr cmd))) (let ((buf (apply 'vc-bzr-async-command command args))) - (with-current-buffer buf - (vc-exec-after - `(progn - (let ((compilation-error-regexp-alist - vc-bzr-error-regex-alist)) - (compilation-mode)) - (set (make-local-variable 'compilation-error-regexp-alist) - vc-bzr-error-regex-alist)))) + (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) (defun vc-bzr-status (file) === modified file 'lisp/vc/vc-dispatcher.el' --- lisp/vc/vc-dispatcher.el 2012-07-11 04:35:13 +0000 +++ lisp/vc/vc-dispatcher.el 2012-07-19 14:38:01 +0000 @@ -386,6 +386,17 @@ (set-window-start window new-window-start)) buffer)) +(defun vc-compilation-mode (backend) + "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." + (let* ((error-regexp-alist + (vc-make-backend-sym backend 'error-regexp-alist)) + (compilation-error-regexp-alist + (and (boundp error-regexp-alist) + (symbol-value error-regexp-alist)))) + (compilation-mode) + (set (make-local-variable 'compilation-error-regexp-alist) + compilation-error-regexp-alist))) + (defun vc-set-async-update (process-buffer) "Set a `vc-exec-after' action appropriate to the current buffer. This action will update the current buffer after the current === modified file 'lisp/vc/vc-git.el' --- lisp/vc/vc-git.el 2012-07-18 15:04:36 +0000 +++ lisp/vc/vc-git.el 2012-07-19 14:38:01 +0000 @@ -646,6 +646,10 @@ (vc-git-command nil 0 file "reset" "-q" "--") (vc-git-command nil nil file "checkout" "-q" "--"))) +(defvar vc-git-error-regexp-alist + '(("^ \\(.+\\) |" 1 nil nil 0)) + "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") + (defun vc-git-pull (prompt) "Pull changes into the current Git branch. Normally, this runs \"git pull\". If PROMPT is non-nil, prompt @@ -666,6 +670,7 @@ command (cadr args) args (cddr args))) (apply 'vc-do-async-command buffer root git-program command args) + (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git))) (vc-set-async-update buffer))) (defun vc-git-merge-branch () @@ -685,6 +690,7 @@ nil t))) (apply 'vc-do-async-command buffer root vc-git-program "merge" (list merge-source)) + (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git))) (vc-set-async-update buffer))) ;;; HISTORY FUNCTIONS === modified file 'lisp/vc/vc-hg.el' --- lisp/vc/vc-hg.el 2012-07-11 23:13:41 +0000 +++ lisp/vc/vc-hg.el 2012-07-19 14:38:01 +0000 @@ -611,6 +611,14 @@ (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (error "No log entries selected for push")))) +(defvar vc-hg-error-regexp-alist nil + ;; 'hg pull' does not list modified files, so, for now, the only + ;; benefit of `vc-compilation-mode' is that one can get rid of + ;; *vc-hg* buffer with 'q' or 'z'. + ;; TODO: call 'hg incoming' before pull/merge to get the list of + ;; modified files + "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") + (defun vc-hg-pull (prompt) "Issue a Mercurial pull command. If called interactively with a set of marked Log View buffers, @@ -651,6 +659,7 @@ args (cddr args))) (apply 'vc-do-async-command buffer root hg-program command args) + (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg))) (vc-set-async-update buffer))))) (defun vc-hg-merge-branch () @@ -659,6 +668,7 @@ (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root)))) (apply 'vc-do-async-command buffer root vc-hg-program '("merge")) + (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg))) (vc-set-async-update buffer))) ;;; Internal functions ------------------------------------------------------------ revno: 109159 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-07-19 07:39:38 -0400 message: * lisp/emacs-lisp/chart.el: Use lexical-binding. (chart-emacs-storage): Don't hardcode the list of entries. * src/alloc.c (Fgarbage_collect): Tweak docstring. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 09:50:01 +0000 +++ lisp/ChangeLog 2012-07-19 11:39:38 +0000 @@ -1,3 +1,8 @@ +2012-07-19 Stefan Monnier + + * emacs-lisp/chart.el: Use lexical-binding. + (chart-emacs-storage): Don't hardcode the list of entries. + 2012-07-19 Dmitry Antipov Next round of tweaks caused by Fgarbage_collect changes. === modified file 'lisp/emacs-lisp/chart.el' --- lisp/emacs-lisp/chart.el 2012-07-19 09:50:01 +0000 +++ lisp/emacs-lisp/chart.el 2012-07-19 11:39:38 +0000 @@ -1,4 +1,4 @@ -;;; chart.el --- Draw charts (bar charts, etc) +;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*- ;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012 ;; Free Software Foundation, Inc. @@ -156,7 +156,7 @@ ) "Superclass for all charts to be displayed in an Emacs buffer.") -(defmethod initialize-instance :AFTER ((obj chart) &rest fields) +(defmethod initialize-instance :AFTER ((obj chart) &rest _fields) "Initialize the chart OBJ being created with FIELDS. Make sure the width/height is correct." (oset obj x-width (- (window-width) 10)) @@ -276,7 +276,7 @@ (float (- (cdr range) (car range))))))))) ) -(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end) +(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end) "Draw axis information based upon a range to be spread along the edge. A is the chart to draw. DIR is the direction. MARGIN, ZONE, START, and END specify restrictions in chart space." @@ -329,7 +329,7 @@ (+ m -1 (round (* lpn (+ 1.0 (float n)))))) )) -(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end) +(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end) "Draw axis information based upon A range to be spread along the edge. Optional argument DIR is the direction of the chart. Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing." @@ -675,32 +675,14 @@ (defun chart-emacs-storage () "Chart the current storage requirements of Emacs." (interactive) - (let* ((data (garbage-collect)) - (cons-info (nth 0 data)) - (symbol-info (nth 1 data)) - (misc-info (nth 2 data)) - (string-info (nth 3 data)) - (string-bytes-info (nth 4 data)) - ;; (nth 5 data) is not used - (vector-slots-info (nth 6 data)) - (float-info (nth 7 data)) - (interval-info (nth 8 data)) - (buffer-info (nth 9 data)) - (names '("conses" "symbols" "miscs" "strings" - "vectors" "floats" "intervals" "buffers")) - (nums (list (* (nth 1 cons-info) (nth 2 cons-info)) - (* (nth 1 symbol-info) (nth 2 symbol-info)) - (* (nth 1 misc-info) (nth 2 misc-info)) - (+ (* (nth 1 string-info) (nth 2 string-info)) - (nth 2 string-bytes-info)) - (* (nth 1 vector-slots-info) (nth 2 vector-slots-info)) - (* (nth 1 float-info) (nth 2 float-info)) - (* (nth 1 interval-info) (nth 2 interval-info)) - (* (nth 1 buffer-info) (nth 2 buffer-info))))) + (let* ((data (garbage-collect))) ;; Let's create the chart! (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" - names "Storage Items" - nums "Objects"))) + (mapcar (lambda (x) (symbol-name (car x))) data) + "Storage Items" + (mapcar (lambda (x) (* (nth 1 x) (nth 2 x))) + data) + "Bytes"))) (defun chart-emacs-lists () "Chart out the size of various important lists." === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-19 09:50:01 +0000 +++ src/ChangeLog 2012-07-19 11:39:38 +0000 @@ -1,3 +1,7 @@ +2012-07-19 Stefan Monnier + + * alloc.c (Fgarbage_collect): Tweak docstring. + 2012-07-19 Dmitry Antipov Tweak the value returned from Fgarbage_collect again. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-19 09:50:01 +0000 +++ src/alloc.c 2012-07-19 11:39:38 +0000 @@ -5378,17 +5378,14 @@ doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. -`garbage-collect' normally returns a list with info on amount of space in use: - ((CONS INTERNAL-SIZE USED-CONSES FREE-CONSES) - (SYMBOL INTERNAL-SIZE USED-SYMBOLS FREE-SYMBOLS) - (MISC INTERNAL-SIZE USED-MISCS FREE-MISCS) - (STRING INTERNAL-SIZE USED-STRINGS FREE-STRING) - (STRING-BYTES 1 USED-STRING-BYTES) - (VECTOR INTERNAL-SIZE USED-VECTORS) - (VECTOR-SLOTS INTERNAL-SIZE USED-VECTOR-SLOTS FREE-VECTOR-SLOTS) - (FLOAT INTERNAL-SIZE USED-FLOATS FREE-FLOATS) - (INTERVAL INTERNAL-SIZE USED-INTERVALS FREE-INTERVALS) - (BUFFER INTERNAL-SIZE USED-BUFFERS)) +`garbage-collect' normally returns a list with info on amount of space in use, +where each entry has the form (NAME SIZE USED FREE), where: +- NAME is a symbol describing the kind of objects this entry represents, +- SIZE is the number of bytes used by each one, +- USED is the number of those objects that were found live in the heap, +- FREE is the number of those objects that are not live but that Emacs + keeps around for future allocations (maybe because it does not know how + to return them to the OS). However, if there was overflow in pure space, `garbage-collect' returns nil, because real GC can't be done. See Info node `(elisp)Garbage Collection'. */) === modified file 'src/xmenu.c' --- src/xmenu.c 2012-07-11 07:19:44 +0000 +++ src/xmenu.c 2012-07-19 11:39:38 +0000 @@ -679,19 +679,17 @@ /* This callback is invoked when a dialog or menu is finished being used and has been unposted. */ +static void +popup_deactivate_callback ( #ifdef USE_GTK -static void -popup_deactivate_callback (GtkWidget *widget, gpointer client_data) -{ - popup_activated_flag = 0; -} + GtkWidget *widget, gpointer client_data #else -static void -popup_deactivate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) -{ - popup_activated_flag = 0; -} + Widget widget, LWLIB_ID id, XtPointer client_data #endif + ) +{ + popup_activated_flag = 0; +} /* Function that finds the frame for WIDGET and shows the HELP text ------------------------------------------------------------ revno: 109158 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2012-07-19 13:50:01 +0400 message: Tweak the value returned from Fgarbage_collect again. * src/alloc.c (Fgarbage_collect): New return value, as confirmed in http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00418.html. Adjust documentation. (total_vector_bytes): Rename to total_vector_slots, adjust accounting. (total_free_vector_bytes): Rename to total_free_vector_slots, adjust accounting. (Qstring_bytes, Qvector_slots): New symbols. (syms_of_alloc): DEFSYM them. * lisp/emacs-lisp/chart.el (chart-emacs-storage): Adjust again. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 08:56:53 +0000 +++ lisp/ChangeLog 2012-07-19 09:50:01 +0000 @@ -1,5 +1,10 @@ 2012-07-19 Dmitry Antipov + Next round of tweaks caused by Fgarbage_collect changes. + * emacs-lisp/chart.el (chart-emacs-storage): Adjust again. + +2012-07-19 Dmitry Antipov + Compact buffers when idle. * compact.el: New file. === modified file 'lisp/emacs-lisp/chart.el' --- lisp/emacs-lisp/chart.el 2012-07-18 05:44:36 +0000 +++ lisp/emacs-lisp/chart.el 2012-07-19 09:50:01 +0000 @@ -680,18 +680,20 @@ (symbol-info (nth 1 data)) (misc-info (nth 2 data)) (string-info (nth 3 data)) - (vector-info (nth 4 data)) - (float-info (nth 5 data)) - (interval-info (nth 6 data)) - (buffer-info (nth 7 data)) + (string-bytes-info (nth 4 data)) + ;; (nth 5 data) is not used + (vector-slots-info (nth 6 data)) + (float-info (nth 7 data)) + (interval-info (nth 8 data)) + (buffer-info (nth 9 data)) (names '("conses" "symbols" "miscs" "strings" "vectors" "floats" "intervals" "buffers")) (nums (list (* (nth 1 cons-info) (nth 2 cons-info)) (* (nth 1 symbol-info) (nth 2 symbol-info)) (* (nth 1 misc-info) (nth 2 misc-info)) (+ (* (nth 1 string-info) (nth 2 string-info)) - (nth 3 string-info)) - (nth 3 vector-info) + (nth 2 string-bytes-info)) + (* (nth 1 vector-slots-info) (nth 2 vector-slots-info)) (* (nth 1 float-info) (nth 2 float-info)) (* (nth 1 interval-info) (nth 2 interval-info)) (* (nth 1 buffer-info) (nth 2 buffer-info))))) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-19 08:56:53 +0000 +++ src/ChangeLog 2012-07-19 09:50:01 +0000 @@ -1,5 +1,18 @@ 2012-07-19 Dmitry Antipov + Tweak the value returned from Fgarbage_collect again. + * alloc.c (Fgarbage_collect): New return value, as confirmed in + http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00418.html. + Adjust documentation. + (total_vector_bytes): Rename to total_vector_slots, adjust + accounting. + (total_free_vector_bytes): Rename to total_free_vector_slots, + adjust accounting. + (Qstring_bytes, Qvector_slots): New symbols. + (syms_of_alloc): DEFSYM them. + +2012-07-19 Dmitry Antipov + Buffer compaction primitive which may be used from Lisp. * buffer.c (compact_buffer, Fcompact_buffer): New function. (syms_of_buffer): Register Fcompact_buffer. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-19 08:56:53 +0000 +++ src/alloc.c 2012-07-19 09:50:01 +0000 @@ -258,6 +258,7 @@ static ptrdiff_t stack_copy_size; #endif +static Lisp_Object Qstring_bytes, Qvector_slots; static Lisp_Object Qgc_cons_threshold; Lisp_Object Qchar_table_extra_slots; @@ -2937,7 +2938,7 @@ eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ (v)->header.next.vector = vector_free_lists[index]; \ vector_free_lists[index] = (v); \ - total_free_vector_bytes += (nbytes); \ + total_free_vector_slots += (nbytes) / word_size; \ } while (0) struct vector_block @@ -2967,9 +2968,9 @@ static EMACS_INT total_vectors; -/* Number of bytes used by live and free vectors. */ +/* Total size of live and free vectors, in Lisp_Object units. */ -static EMACS_INT total_vector_bytes, total_free_vector_bytes; +static EMACS_INT total_vector_slots, total_free_vector_slots; /* Get a new vector block. */ @@ -3016,7 +3017,7 @@ vector = vector_free_lists[index]; vector_free_lists[index] = vector->header.next.vector; vector->header.next.nbytes = nbytes; - total_free_vector_bytes -= nbytes; + total_free_vector_slots -= nbytes / word_size; return vector; } @@ -3031,7 +3032,7 @@ vector = vector_free_lists[index]; vector_free_lists[index] = vector->header.next.vector; vector->header.next.nbytes = nbytes; - total_free_vector_bytes -= nbytes; + total_free_vector_slots -= nbytes / word_size; /* Excess bytes are used for the smaller vector, which should be set on an appropriate free list. */ @@ -3085,7 +3086,7 @@ struct vector_block *block = vector_blocks, **bprev = &vector_blocks; struct Lisp_Vector *vector, *next, **vprev = &large_vectors; - total_vectors = total_vector_bytes = total_free_vector_bytes = 0; + total_vectors = total_vector_slots = total_free_vector_slots = 0; memset (vector_free_lists, 0, sizeof (vector_free_lists)); /* Looking through vector blocks. */ @@ -3101,7 +3102,7 @@ { VECTOR_UNMARK (vector); total_vectors++; - total_vector_bytes += vector->header.next.nbytes; + total_vector_slots += vector->header.next.nbytes / word_size; next = ADVANCE (vector, vector->header.next.nbytes); } else @@ -3167,14 +3168,14 @@ pseudovector type grows beyond VBLOCK_BYTES_MAX. */ eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR)); - total_vector_bytes + total_vector_slots += (bool_header_size + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR)); + / BOOL_VECTOR_BITS_PER_CHAR)) / word_size; } else - total_vector_bytes += (header_size - + vector->header.size * word_size); + total_vector_slots + += header_size / word_size + vector->header.size; vprev = &vector->header.next.vector; } else @@ -5381,8 +5382,10 @@ ((CONS INTERNAL-SIZE USED-CONSES FREE-CONSES) (SYMBOL INTERNAL-SIZE USED-SYMBOLS FREE-SYMBOLS) (MISC INTERNAL-SIZE USED-MISCS FREE-MISCS) - (STRING INTERNAL-SIZE USED-STRINGS USED-STRING-BYTES FREE-STRING) - (VECTOR INTERNAL-SIZE USED-VECTORS USED-VECTOR-BYTES FREE-VECTOR-BYTES) + (STRING INTERNAL-SIZE USED-STRINGS FREE-STRING) + (STRING-BYTES 1 USED-STRING-BYTES) + (VECTOR INTERNAL-SIZE USED-VECTORS) + (VECTOR-SLOTS INTERNAL-SIZE USED-VECTOR-SLOTS FREE-VECTOR-SLOTS) (FLOAT INTERNAL-SIZE USED-FLOATS FREE-FLOATS) (INTERVAL INTERNAL-SIZE USED-INTERVALS FREE-INTERVALS) (BUFFER INTERNAL-SIZE USED-BUFFERS)) @@ -5396,7 +5399,7 @@ char stack_top_variable; ptrdiff_t i; int message_p; - Lisp_Object total[8]; + Lisp_Object total[10]; ptrdiff_t count = SPECPDL_INDEX (); EMACS_TIME t1; @@ -5596,7 +5599,7 @@ tot += total_symbols * sizeof (struct Lisp_Symbol); tot += total_markers * sizeof (union Lisp_Misc); tot += total_string_bytes; - tot += total_vector_bytes; + tot += total_vector_slots * word_size; tot += total_floats * sizeof (struct Lisp_Float); tot += total_intervals * sizeof (struct interval); tot += total_strings * sizeof (struct Lisp_String); @@ -5633,25 +5636,29 @@ bounded_number (total_markers), bounded_number (total_free_markers)); - total[3] = list5 (Qstring, make_number (sizeof (struct Lisp_String)), + total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)), bounded_number (total_strings), - bounded_number (total_string_bytes), bounded_number (total_free_strings)); - total[4] = list5 (Qvector, make_number (sizeof (struct Lisp_Vector)), - bounded_number (total_vectors), - bounded_number (total_vector_bytes), - bounded_number (total_free_vector_bytes)); - - total[5] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)), + total[4] = list3 (Qstring_bytes, make_number (1), + bounded_number (total_string_bytes)); + + total[5] = list3 (Qvector, make_number (sizeof (struct Lisp_Vector)), + bounded_number (total_vectors)); + + total[6] = list4 (Qvector_slots, make_number (word_size), + bounded_number (total_vector_slots), + bounded_number (total_free_vector_slots)); + + total[7] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)), bounded_number (total_floats), bounded_number (total_free_floats)); - total[6] = list4 (Qinterval, make_number (sizeof (struct interval)), + total[8] = list4 (Qinterval, make_number (sizeof (struct interval)), bounded_number (total_intervals), bounded_number (total_free_intervals)); - total[7] = list3 (Qbuffer, make_number (sizeof (struct buffer)), + total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)), bounded_number (total_buffers)); #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES @@ -6620,7 +6627,7 @@ + total_free_floats * sizeof (struct Lisp_Float) + total_free_intervals * sizeof (struct interval) + total_free_strings * sizeof (struct Lisp_String) - + total_free_vector_bytes + + total_free_vector_slots * word_size + 1023) >> 10)); #ifdef DOUG_LEA_MALLOC XSETCAR (XCDR (val), bounded_number ((mallinfo ().fordblks + 1023) >> 10)); @@ -6842,6 +6849,9 @@ doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); Vmemory_full = Qnil; + DEFSYM (Qstring_bytes, "string-bytes"); + DEFSYM (Qvector_slots, "vector-slots"); + DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); ------------------------------------------------------------ revno: 109157 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2012-07-19 12:56:53 +0400 message: Compact buffers when idle. * lisp/compact.el: New file. * src/buffer.c (compact_buffer, Fcompact_buffer): New function. (syms_of_buffer): Register Fcompact_buffer. * src/alloc.c (Fgarbage_collect): Use compact_buffer. * src/buffer.h (compact_buffer): New prototype. (struct buffer_text): New member. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 06:24:04 +0000 +++ lisp/ChangeLog 2012-07-19 08:56:53 +0000 @@ -1,3 +1,8 @@ +2012-07-19 Dmitry Antipov + + Compact buffers when idle. + * compact.el: New file. + 2012-07-19 Stefan Monnier * subr.el (eventp): Presume that if it looks vaguely like an event, === added file 'lisp/compact.el' --- lisp/compact.el 1970-01-01 00:00:00 +0000 +++ lisp/compact.el 2012-07-19 08:56:53 +0000 @@ -0,0 +1,60 @@ +;;; compact.el --- compact buffers when idle + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Package: emacs + +;; 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: + +;; This package provides the ability to compact buffers when Emacs is idle. +;; Initially written by Dmitry Antipov . + +;;; Code: + +(require 'timer) + +(defun compact-buffers () + "Run `compact-buffer' for each buffer except current buffer. +Schedule next compaction if `compact-buffers-when-idle' is greater than zero." + (mapc (lambda (buffer) + (and (not (eq buffer (current-buffer))) + (compact-buffer buffer))) + (buffer-list)) + (compact-buffers-idle)) + +(defun compact-buffers-idle () + "Compact buffers if `compact-buffers-when-idle' is greater than zero." + (and (floatp compact-buffers-when-idle) + (> compact-buffers-when-idle 0.0) + (run-with-idle-timer compact-buffers-when-idle nil 'compact-buffers))) + +(defcustom compact-buffers-when-idle 1.0 + "Compact all buffers when Emacs is idle more than this period of time. +Compaction is done by truncating `buffer-undo-list' and shrinking the gap. +Value less than or equal to zero disables idle compaction." + :type 'float + :group 'alloc + :set (lambda (symbol value) + (progn (set-default symbol value) + (compact-buffers-idle))) + :version "24.2") + +(provide 'compact) + +;;; compact.el ends here === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-19 03:55:59 +0000 +++ src/ChangeLog 2012-07-19 08:56:53 +0000 @@ -1,5 +1,14 @@ 2012-07-19 Dmitry Antipov + Buffer compaction primitive which may be used from Lisp. + * buffer.c (compact_buffer, Fcompact_buffer): New function. + (syms_of_buffer): Register Fcompact_buffer. + * alloc.c (Fgarbage_collect): Use compact_buffer. + * buffer.h (compact_buffer): New prototype. + (struct buffer_text): New member. + +2012-07-19 Dmitry Antipov + New macro to iterate over all buffers, miscellaneous cleanups. * lisp.h (all_buffers): Remove declaration. * buffer.h (all_buffers): Add declaration, with comment. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-19 03:55:59 +0000 +++ src/alloc.c 2012-07-19 08:56:53 +0000 @@ -5413,33 +5413,7 @@ /* Don't keep undo information around forever. Do this early on, so it is no problem if the user quits. */ for_each_buffer (nextb) - { - /* If a buffer's undo list is Qt, that means that undo is - turned off in that buffer. Calling truncate_undo_list on - Qt tends to return NULL, which effectively turns undo back on. - So don't call truncate_undo_list if undo_list is Qt. */ - if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) - && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) - truncate_undo_list (nextb); - - /* Shrink buffer gaps, but skip indirect and dead buffers. */ - if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name)) - && ! nextb->text->inhibit_shrinking) - { - /* If a buffer's gap size is more than 10% of the buffer - size, or larger than 2000 bytes, then shrink it - accordingly. Keep a minimum size of 20 bytes. */ - int size = min (2000, max (20, (nextb->text->z_byte / 10))); - - if (nextb->text->gap_size > size) - { - struct buffer *save_current = current_buffer; - current_buffer = nextb; - make_gap (-(nextb->text->gap_size - size)); - current_buffer = save_current; - } - } - } + compact_buffer (nextb); t1 = current_emacs_time (); === modified file 'src/buffer.c' --- src/buffer.c 2012-07-19 03:55:59 +0000 +++ src/buffer.c 2012-07-19 08:56:53 +0000 @@ -1434,14 +1434,59 @@ return Qnil; } -/* - DEFVAR_LISP ("kill-buffer-hook", ..., "\ -Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\ -The buffer being killed will be current while the hook is running.\n\ - -Functions run by this hook are supposed to not change the current -buffer. See `kill-buffer'." -*/ +/* Truncate undo list and shrink the gap of BUFFER. */ + +int +compact_buffer (struct buffer *buffer) +{ + /* Skip dead buffers, indirect buffers and buffers + which aren't changed since last compaction. */ + if (!NILP (buffer->BUFFER_INTERNAL_FIELD (name)) + && (buffer->base_buffer == NULL) + && (buffer->text->compact != buffer->text->modiff)) + { + /* If a buffer's undo list is Qt, that means that undo is + turned off in that buffer. Calling truncate_undo_list on + Qt tends to return NULL, which effectively turns undo back on. + So don't call truncate_undo_list if undo_list is Qt. */ + if (!EQ (buffer->BUFFER_INTERNAL_FIELD (undo_list), Qt)) + truncate_undo_list (buffer); + + /* Shrink buffer gaps. */ + if (!buffer->text->inhibit_shrinking) + { + /* If a buffer's gap size is more than 10% of the buffer + size, or larger than 2000 bytes, then shrink it + accordingly. Keep a minimum size of 20 bytes. */ + int size = min (2000, max (20, (buffer->text->z_byte / 10))); + + if (buffer->text->gap_size > size) + { + struct buffer *save_current = current_buffer; + current_buffer = buffer; + make_gap (-(buffer->text->gap_size - size)); + current_buffer = save_current; + } + } + buffer->text->compact = buffer->text->modiff; + return 1; + } + 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. @@ -5992,7 +6037,6 @@ defsubr (&Smake_indirect_buffer); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); -/*defsubr (&Sbuffer_number);*/ defsubr (&Sbuffer_file_name); defsubr (&Sbuffer_base_buffer); defsubr (&Sbuffer_local_value); @@ -6004,6 +6048,7 @@ 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); === modified file 'src/buffer.h' --- src/buffer.h 2012-07-19 03:55:59 +0000 +++ src/buffer.h 2012-07-19 08:56:53 +0000 @@ -436,6 +436,9 @@ EMACS_INT overlay_modiff; /* Counts modifications to overlays. */ + EMACS_INT compact; /* Set to modiff each time when compact_buffer + is called for this buffer. */ + /* Minimum value of GPT - BEG since last redisplay that finished. */ ptrdiff_t beg_unchanged; @@ -903,6 +906,7 @@ extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); +extern int compact_buffer (struct buffer *); extern void evaporate_overlays (ptrdiff_t); extern ptrdiff_t overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, ptrdiff_t *next_ptr, ------------------------------------------------------------ revno: 109156 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=10190 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-07-19 02:24:04 -0400 message: * lisp/subr.el (eventp): Presume that if it looks vaguely like an event, it's an event. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-19 00:55:55 +0000 +++ lisp/ChangeLog 2012-07-19 06:24:04 +0000 @@ -1,3 +1,8 @@ +2012-07-19 Stefan Monnier + + * subr.el (eventp): Presume that if it looks vaguely like an event, + it's an event (bug#10190). + 2012-07-19 Fabián Ezequiel Gallina Enhancements to ppss related code (thanks Stefan). @@ -5,7 +10,7 @@ (python-indent-calculate-indentation, python-indent-dedent-line) (python-indent-electric-colon, python-nav-forward-block) (python-mode-abbrev-table) - (python-info-assignment-continuation-line-p): Simplified checks + (python-info-assignment-continuation-line-p): Simplify checks for ppss context. (python-info-continuation-line-p): Cleanup. (python-info-ppss-context): Do not catch 'quote. === modified file 'lisp/subr.el' --- lisp/subr.el 2012-07-18 14:48:25 +0000 +++ lisp/subr.el 2012-07-19 06:24:04 +0000 @@ -909,17 +909,9 @@ (defsubst eventp (obj) "True if the argument is an event object." - (or (and (integerp obj) - ;; FIXME: Why bother? - ;; Filter out integers too large to be events. - ;; M is the biggest modifier. - (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) - (characterp (event-basic-type obj))) - (and (symbolp obj) - (get obj 'event-symbol-elements)) - (and (consp obj) - (symbolp (car obj)) - (get (car obj) 'event-symbol-elements)))) + (or (integerp obj) + (and (symbolp obj) obj (not (keywordp obj))) + (and (consp obj) (symbolp (car obj))))) (defun event-modifiers (event) "Return a list of symbols representing the modifier keys in event EVENT.