mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

; Merge: backports from master

Browse source
This commit is contained in:
Noam Postavsky 2018-06-03 12:55:37 -04:00
commit 9a14b4d1ce
15 changed files with 169 additions and 128 deletions
Download patch file Download diff file Expand all files Collapse all files

9
lisp/emacs-lisp/cl-print.el
View file

@ -62,9 +62,12 @@ call other entry points instead, such as `cl-prin1'."
(princ "(" stream)
(cl-print-object car stream)
(while (and (consp object)
(not (if cl-print--number-table
(numberp (gethash object cl-print--number-table))
(memq object cl-print--currently-printing))))
(not (cond
(cl-print--number-table
(numberp (gethash object cl-print--number-table)))
((memq object cl-print--currently-printing))
(t (push object cl-print--currently-printing)
nil))))
(princ " " stream)
(cl-print-object (pop object) stream))
(when object

1
lisp/epa.el
View file

@ -701,6 +701,7 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use."
#'epa-progress-callback-function
(format "Decrypting %s..."
(file-name-nondirectory decrypt-file))))
(setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Decrypting %s..." (file-name-nondirectory decrypt-file))
(condition-case error
(epg-decrypt-file context decrypt-file plain-file)

13
lisp/eshell/esh-opt.el
View file

@ -244,26 +244,27 @@ switch is unrecognized."
options)))
(ai 0) arg
(eshell--args args))
(while (< ai (length args))
(setq arg (nth ai args))
(while (< ai (length eshell--args))
(setq arg (nth ai eshell--args))
(if (not (and (stringp arg)
(string-match "^-\\(-\\)?\\(.*\\)" arg)))
(setq ai (1+ ai))
(let* ((dash (match-string 1 arg))
(switch (match-string 2 arg)))
(if (= ai 0)
(setq args (cdr args))
(setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
(setq eshell--args (cdr eshell--args))
(setcdr (nthcdr (1- ai) eshell--args)
(nthcdr (1+ ai) eshell--args)))
(if dash
(if (> (length switch) 0)
(eshell--process-option name switch 1 ai options opt-vals)
(setq ai (length args)))
(setq ai (length eshell--args)))
(let ((len (length switch))
(index 0))
(while (< index len)
(eshell--process-option name (aref switch index)
0 ai options opt-vals)
(setq index (1+ index))))))))
(nconc (mapcar #'cdr opt-vals) args)))
(nconc (mapcar #'cdr opt-vals) eshell--args)))
;;; esh-opt.el ends here

39
lisp/mail/mail-extr.el
View file

@ -1406,26 +1406,25 @@ consing a string.)"
(insert (upcase mi) ". ")))
;; Nuke name if it is the same as mailbox name.
(when mail-extr-ignore-single-names
(let ((buffer-length (- (point-max) (point-min)))
(i 0)
(names-match-flag t))
(when (and (> buffer-length 0)
(eq buffer-length (- mbox-end mbox-beg)))
(goto-char (point-max))
(insert-buffer-substring canonicalization-buffer
mbox-beg mbox-end)
(while (and names-match-flag
(< i buffer-length))
(or (eq (downcase (char-after (+ i (point-min))))
(downcase
(char-after (+ i buffer-length (point-min)))))
(setq names-match-flag nil))
(setq i (1+ i)))
(delete-region (+ (point-min) buffer-length) (point-max))
(and names-match-flag
mail-extr-ignore-realname-equals-mailbox-name
(narrow-to-region (point) (point))))))
(let ((buffer-length (- (point-max) (point-min)))
(i 0)
(names-match-flag t))
(when (and (> buffer-length 0)
(eq buffer-length (- mbox-end mbox-beg)))
(goto-char (point-max))
(insert-buffer-substring canonicalization-buffer
mbox-beg mbox-end)
(while (and names-match-flag
(< i buffer-length))
(or (eq (downcase (char-after (+ i (point-min))))
(downcase
(char-after (+ i buffer-length (point-min)))))
(setq names-match-flag nil))
(setq i (1+ i)))
(delete-region (+ (point-min) buffer-length) (point-max))
(and names-match-flag
mail-extr-ignore-realname-equals-mailbox-name
(narrow-to-region (point) (point)))))
;; Nuke name if it's just one word.
(goto-char (point-min))

17
src/alloc.c
View file

@ -3884,15 +3884,6 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
return obj;
}
/* Put MARKER back on the free list after using it temporarily. */
void
free_marker (Lisp_Object marker)
{
unchain_marker (XMARKER (marker));
free_misc (marker);
}
/* Return a newly created vector or string with specified arguments as
elements. If all the arguments are characters that can fit
@ -6343,12 +6334,8 @@ mark_localized_symbol (struct Lisp_Symbol *ptr)
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
Lisp_Object where = blv->where;
/* If the value is set up for a killed buffer or deleted
frame, restore its global binding. If the value is
forwarded to a C variable, either it's not a Lisp_Object
var, or it's staticpro'd already. */
if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where)))
|| (FRAMEP (where) && !FRAME_LIVE_P (XFRAME (where))))
/* If the value is set up for a killed buffer restore its global binding. */
if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where))))
swap_in_global_binding (ptr);
mark_object (blv->where);
mark_object (blv->valcell);

55
src/buffer.c
View file

@ -108,7 +108,6 @@ int last_per_buffer_idx;
static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
bool after, Lisp_Object arg1,
Lisp_Object arg2, Lisp_Object arg3);
static void swap_out_buffer_local_variables (struct buffer *b);
static void reset_buffer_local_variables (struct buffer *, bool);
/* Alist of all buffer names vs the buffers. This used to be
@ -991,10 +990,29 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
else
{
Lisp_Object tmp, last = Qnil;
Lisp_Object buffer;
XSETBUFFER (buffer, b);
for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
{
Lisp_Object local_var = XCAR (XCAR (tmp));
Lisp_Object prop = Fget (local_var, Qpermanent_local);
Lisp_Object sym = local_var;
/* Watchers are run *before* modifying the var. */
if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, Qnil,
Qmakunbound, Fcurrent_buffer ());
eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is
now cached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
{
/* Symbol is set up for this buffer's old local value:
swap it out! */
swap_in_global_binding (XSYMBOL (sym));
}
if (!NILP (prop))
{
@ -1034,10 +1052,6 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
bset_local_var_alist (b, XCDR (tmp));
else
XSETCDR (last, XCDR (tmp));
if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, Qnil,
Qmakunbound, Fcurrent_buffer ());
}
}
@ -1867,7 +1881,6 @@ cleaning up all windows currently displaying the buffer to be killed. */)
won't be protected from GC. They would be protected
if they happened to remain cached in their symbols.
This gets rid of them for certain. */
swap_out_buffer_local_variables (b);
reset_buffer_local_variables (b, 1);
bset_name (b, Qnil);
@ -2737,11 +2750,6 @@ the normal hook `change-major-mode-hook'. */)
{
run_hook (Qchange_major_mode_hook);
/* Make sure none of the bindings in local_var_alist
remain swapped in, in their symbols. */
swap_out_buffer_local_variables (current_buffer);
/* Actually eliminate all local bindings of this buffer. */
reset_buffer_local_variables (current_buffer, 0);
@ -2753,31 +2761,6 @@ the normal hook `change-major-mode-hook'. */)
return Qnil;
}
/* Make sure no local variables remain set up with buffer B
for their current values. */
static void
swap_out_buffer_local_variables (struct buffer *b)
{
Lisp_Object oalist, alist, buffer;
XSETBUFFER (buffer, b);
oalist = BVAR (b, local_var_alist);
for (alist = oalist; CONSP (alist); alist = XCDR (alist))
{
Lisp_Object sym = XCAR (XCAR (alist));
eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is
now cached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
{
/* Symbol is set up for this buffer's old local value:
swap it out! */
swap_in_global_binding (XSYMBOL (sym));
}
}
}
/* Find all the overlays in the current buffer that contain position POS.
Return the number found, and store them in a vector in *VEC_PTR.

36
src/data.c
View file

@ -1188,7 +1188,7 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
/* Indicate that the global binding is set up now. */
set_blv_where (blv, Qnil);
set_blv_found (blv, 0);
set_blv_found (blv, false);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@ -1257,7 +1257,6 @@ find_symbol_value (Lisp_Object symbol)
swap_in_symval_forwarding (sym, blv);
return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
}
/* FALLTHROUGH */
case SYMBOL_FORWARDED:
return do_symval_forwarding (SYMBOL_FWD (sym));
default: emacs_abort ();
@ -1366,7 +1365,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
tem1 = assq_no_quit (symbol,
BVAR (XBUFFER (where), local_var_alist));
set_blv_where (blv, where);
blv->found = 1;
blv->found = true;
if (NILP (tem1))
{
@ -1381,7 +1380,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
if (bindflag || !blv->local_if_set
|| let_shadows_buffer_binding_p (sym))
{
blv->found = 0;
blv->found = false;
tem1 = blv->defcell;
}
/* If it's a local_if_set, being set not bound,
@ -1796,7 +1795,7 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded,
blv->local_if_set = 0;
set_blv_defcell (blv, tem);
set_blv_valcell (blv, tem);
set_blv_found (blv, 0);
set_blv_found (blv, false);
return blv;
}
@ -1946,30 +1945,17 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
CALLN (Fmessage, format, SYMBOL_NAME (variable));
}
/* Swap out any local binding for some other buffer, and make
sure the current value is permanently recorded, if it's the
default value. */
find_symbol_value (variable);
if (BUFFERP (blv->where) && current_buffer == XBUFFER (blv->where))
/* Make sure the current value is permanently recorded, if it's the
default value. */
swap_in_global_binding (sym);
bset_local_var_alist
(current_buffer,
Fcons (Fcons (variable, XCDR (blv->defcell)),
BVAR (current_buffer, local_var_alist)));
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
if (current_buffer == XBUFFER (blv->where))
set_blv_where (blv, Qnil);
set_blv_found (blv, 0);
}
/* If the symbol forwards into a C variable, then load the binding
for this buffer now. If C code modifies the variable before we
load the binding in, then that new value will clobber the default
binding the next time we unload it. */
if (blv->fwd)
swap_in_symval_forwarding (sym, blv);
return variable;
}
@ -2031,11 +2017,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
{
Lisp_Object buf; XSETBUFFER (buf, current_buffer);
if (EQ (buf, blv->where))
{
set_blv_where (blv, Qnil);
blv->found = 0;
find_symbol_value (variable);
}
swap_in_global_binding (sym);
}
return variable;

6
src/editfns.c
View file

@ -3876,9 +3876,9 @@ save_restriction_restore (Lisp_Object data)
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
/* These aren't needed anymore, so don't wait for GC. */
free_marker (XCAR (data));
free_marker (XCDR (data));
/* Detach the markers, and free the cons instead of waiting for GC. */
detach_marker (XCAR (data));
detach_marker (XCDR (data));
free_cons (XCONS (data));
}
else

4
src/insdel.c
View file

@ -2149,9 +2149,9 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
}
if (! NILP (start_marker))
free_marker (start_marker);
detach_marker (start_marker);
if (! NILP (end_marker))
free_marker (end_marker);
detach_marker (end_marker);
RESTORE_VALUE;
unbind_to (count, Qnil);

21
src/lisp.h
View file

@ -2587,18 +2587,15 @@ struct Lisp_Buffer_Objfwd
in the buffer structure itself. They are handled differently,
using struct Lisp_Buffer_Objfwd.)
The `realvalue' slot holds the variable's current value, or a
forwarding pointer to where that value is kept. This value is the
one that corresponds to the loaded binding. To read or set the
variable, you must first make sure the right binding is loaded;
then you can access the value in (or through) `realvalue'.
The `valcell' slot holds the variable's current value (unless `fwd'
is set). This value is the one that corresponds to the loaded binding.
To read or set the variable, you must first make sure the right binding
is loaded; then you can access the value in (or through) `valcell'.
`where' is the buffer for which the loaded binding was found. If
it has changed, to make sure the right binding is loaded it is
`where' is the buffer for which the loaded binding was found.
If it has changed, to make sure the right binding is loaded it is
necessary to find which binding goes with the current buffer, then
load it. To load it, first unload the previous binding, then copy
the value of the new binding into `realvalue' (or through it).
Also update LOADED-BINDING to point to the newly loaded binding.
load it. To load it, first unload the previous binding.
`local_if_set' indicates that merely setting the variable creates a
local binding for the current buffer. Otherwise the latter, setting
@ -3728,7 +3725,6 @@ extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
extern void init_alloc (void);
@ -4019,7 +4015,8 @@ extern ptrdiff_t marker_byte_position (Lisp_Object);
extern void clear_charpos_cache (struct buffer *);
extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
extern void unchain_marker (struct Lisp_Marker *marker);
extern void detach_marker (Lisp_Object);
extern void unchain_marker (struct Lisp_Marker *);
extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,

13
src/marker.c
View file

@ -530,7 +530,7 @@ POSITION is nil, makes marker point nowhere so it no longer slows down
editing in any buffer. Returns MARKER. */)
(Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
{
return set_marker_internal (marker, position, buffer, 0);
return set_marker_internal (marker, position, buffer, false);
}
/* Like the above, but won't let the position be outside the visible part. */
@ -539,7 +539,7 @@ Lisp_Object
set_marker_restricted (Lisp_Object marker, Lisp_Object position,
Lisp_Object buffer)
{
return set_marker_internal (marker, position, buffer, 1);
return set_marker_internal (marker, position, buffer, true);
}
/* Set the position of MARKER, specifying both the
@ -586,6 +586,15 @@ set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
return marker;
}
/* Detach a marker so that it no longer points anywhere and no longer
slows down editing. Do not free the marker, though, as a change
function could have inserted it into an undo list (Bug#30931). */
void
detach_marker (Lisp_Object marker)
{
Fset_marker (marker, Qnil, Qnil);
}
/* Remove MARKER from the chain of whatever buffer it is in,
leaving it points to nowhere. This is called during garbage
collection, so we must be careful to ignore and preserve

3
src/xterm.c
View file

@ -11548,7 +11548,8 @@ x_make_frame_visible (struct frame *f)
poll_for_input_1 ();
poll_suppress_count = old_poll_suppress_count;
#endif
x_wait_for_event (f, MapNotify);
if (! FRAME_VISIBLE_P (f))
x_wait_for_event (f, MapNotify);
}
}

10
test/lisp/emacs-lisp/cl-print-tests.el
View file

@ -55,4 +55,14 @@
(let ((print-circle t))
(should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x))))))
(ert-deftest cl-print-circle-2 ()
;; Bug#31146.
(let ((x '(0 . #1=(0 . #1#))))
(let ((print-circle nil))
(should (string-match "\\`(0 0 . #[0-9])\\'"
(cl-prin1-to-string x))))
(let ((print-circle t))
(should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
;;; cl-print-tests.el ends here.

19
test/src/data-tests.el
View file

@ -1,4 +1,4 @@
;;; data-tests.el --- tests for src/data.c
;;; data-tests.el --- tests for src/data.c -*- lexical-binding:t -*-
;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
@ -484,3 +484,20 @@ comparing the subr with a much slower lisp implementation."
(remove-variable-watcher 'data-tests-lvar collect-watch-data)
(setq data-tests-lvar 6)
(should (null watch-data)))))
(ert-deftest data-tests-kill-all-local-variables () ;bug#30846
(with-temp-buffer
(setq-local data-tests-foo1 1)
(setq-local data-tests-foo2 2)
(setq-local data-tests-foo3 3)
(let ((oldfoo2 nil))
(add-variable-watcher 'data-tests-foo2
(lambda (&rest _)
(setq oldfoo2 (bound-and-true-p data-tests-foo2))))
(kill-all-local-variables)
(should (equal oldfoo2 '2)) ;Watcher is run before changing the var.
(should (not (or (bound-and-true-p data-tests-foo1)
(bound-and-true-p data-tests-foo2)
(bound-and-true-p data-tests-foo3)))))))
;;; data-tests.el ends here

51
test/src/editfns-tests.el
View file

@ -247,4 +247,55 @@
(buffer-string)
"foo bar baz qux"))))))
(ert-deftest delete-region-undo-markers-1 ()
"Make sure we don't end up with freed markers reachable from Lisp."
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#40
(with-temp-buffer
(insert "1234567890")
(setq buffer-undo-list nil)
(narrow-to-region 2 5)
;; `save-restriction' in a narrowed buffer creates two markers
;; representing the current restriction.
(save-restriction
(widen)
;; Any markers *within* the deleted region are put onto the undo
;; list.
(delete-region 1 6))
;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
;; `buffer-undo-list' is now
;; (("12345" . 1) (#<temp-marker1> . -1) (#<temp-marker2> . 1))
;;
;; If temp-marker1 or temp-marker2 are freed prematurely, calling
;; `type-of' on them will cause Emacs to abort. Calling
;; `garbage-collect' will also abort if it finds any reachable
;; freed objects.
(should (eq (type-of (car (nth 1 buffer-undo-list))) 'marker))
(should (eq (type-of (car (nth 2 buffer-undo-list))) 'marker))
(garbage-collect)))
(ert-deftest delete-region-undo-markers-2 ()
"Make sure we don't end up with freed markers reachable from Lisp."
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#55
(with-temp-buffer
(insert "1234567890")
(setq buffer-undo-list nil)
;; signal_before_change creates markers delimiting a change
;; region.
(let ((before-change-functions
(list (lambda (beg end)
(delete-region (1- beg) (1+ end))))))
(delete-region 2 5))
;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
;; `buffer-undo-list' is now
;; (("678" . 1) ("12345" . 1) (#<marker in no buffer> . -1)
;; (#<temp-marker1> . -1) (#<temp-marker2> . -4))
;;
;; If temp-marker1 or temp-marker2 are freed prematurely, calling
;; `type-of' on them will cause Emacs to abort. Calling
;; `garbage-collect' will also abort if it finds any reachable
;; freed objects.
(should (eq (type-of (car (nth 3 buffer-undo-list))) 'marker))
(should (eq (type-of (car (nth 4 buffer-undo-list))) 'marker))
(garbage-collect)))
;;; editfns-tests.el ends here