commit 184ed36136d7d78a914979009db208518312137c (HEAD, refs/remotes/origin/master) Author: Martin Rudalics Date: Mon Dec 12 10:16:23 2016 +0100 Strengthen conditions for resizing sibling windows (Bug#25169) * lisp/window.el (window-resize, delete-window): Resize other siblings only if `window-combination-resize' equals t (Bug#25169). diff --git a/lisp/window.el b/lisp/window.el index 5255905..fdb67ed 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2797,7 +2797,7 @@ instead." window delta horizontal ignore nil nil nil t))) (window--resize-reset frame horizontal) (window--resize-this-window window delta horizontal ignore t) - (if (and (not window-combination-resize) + (if (and (not (eq window-combination-resize t)) (window-combined-p window horizontal) (setq sibling (or (window-right window) (window-left window))) (window-sizable-p @@ -4049,7 +4049,7 @@ that is its frame's root window." (sibling (or (window-left window) (window-right window)))) (window--resize-reset frame horizontal) (cond - ((and (not window-combination-resize) + ((and (not (eq window-combination-resize t)) sibling (window-sizable-p sibling size horizontal nil t)) ;; Resize WINDOW's sibling. (window--resize-this-window sibling size horizontal nil t) commit a92a027d58cb4df5bb6c7e3c546a72183a192f45 Author: Noam Postavsky Date: Thu Oct 27 22:17:11 2016 -0400 Quote filenames containing '~' in prompts When in a directory named '~', the default value given by `read-file-name' should be quoted by prepending '/:', in order to prevent it from being interpreted as referring to the $HOME directory (Bug#16984). * lisp/minibuffer.el (minibuffer-maybe-quote-filename): New function. (completion--sifn-requote, read-file-name-default): Use it instead of `minibuffer--double-dollars'. * test/lisp/files-tests.el (files-test-read-file-in-~): Test it. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 175189c..576b804 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2251,6 +2251,17 @@ This is only used when the minibuffer area has no active minibuffer.") (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar)) str)) +(defun minibuffer-maybe-quote-filename (filename) + "Protect FILENAME from `substitute-in-file-name', as needed. +Useful to give the user default values that won't be substituted." + (if (and (not (file-name-quoted-p filename)) + (file-name-absolute-p filename) + (string-match-p (if (memq system-type '(windows-nt ms-dos)) + "[/\\\\]~" "/~") + (file-local-name filename))) + (file-name-quote filename) + (minibuffer--double-dollars filename))) + (defun completion--make-envvar-table () (mapcar (lambda (enventry) (substring enventry 0 (string-match-p "=" enventry))) @@ -2420,7 +2431,7 @@ same as `substitute-in-file-name'." (substitute-in-file-name (substring qstr 0 (1- qpos))))) (setq qpos (1- qpos))) - (cons qpos #'minibuffer--double-dollars)))) + (cons qpos #'minibuffer-maybe-quote-filename)))) (defalias 'completion--file-name-table (completion-table-with-quoting #'completion-file-name-table @@ -2596,10 +2607,10 @@ See `read-file-name' for the meaning of the arguments." (let ((insdef (cond ((and insert-default-directory (stringp dir)) (if initial - (cons (minibuffer--double-dollars (concat dir initial)) - (length (minibuffer--double-dollars dir))) - (minibuffer--double-dollars dir))) - (initial (cons (minibuffer--double-dollars initial) 0))))) + (cons (minibuffer-maybe-quote-filename (concat dir initial)) + (length (minibuffer-maybe-quote-filename dir))) + (minibuffer-maybe-quote-filename dir))) + (initial (cons (minibuffer-maybe-quote-filename initial) 0))))) (let ((completion-ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) @@ -2693,7 +2704,7 @@ See `read-file-name' for the meaning of the arguments." ;; with what we will actually return. As an exception, ;; if that's the same as the second item in ;; file-name-history, it's really a repeat (Bug#4657). - (let ((val1 (minibuffer--double-dollars val))) + (let ((val1 (minibuffer-maybe-quote-filename val))) (if history-delete-duplicates (setcdr file-name-history (delete val1 (cdr file-name-history)))) @@ -2703,7 +2714,7 @@ See `read-file-name' for the meaning of the arguments." (if add-to-history ;; Add the value to the history--but not if it matches ;; the last value already there. - (let ((val1 (minibuffer--double-dollars val))) + (let ((val1 (minibuffer-maybe-quote-filename val))) (unless (and (consp file-name-history) (equal (car file-name-history) val1)) (setq file-name-history diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 80d5e5b..f4ccd5c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -220,5 +220,28 @@ form.") (should-not yes-or-no-p-prompts) (should (equal kill-emacs-args '(nil))))) +(ert-deftest files-test-read-file-in-~ () + "Test file prompting in directory named '~'. +If we are in a directory named '~', the default value should not +be $HOME." + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _coll &optional _pred _req init _hist def _) + (or def init))) + (dir (make-temp-file "read-file-name-test" t))) + (unwind-protect + (let ((subdir (expand-file-name "./~/"))) + (make-directory subdir t) + (with-temp-buffer + (setq default-directory subdir) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (expand-file-name "~/"))) + ;; Don't overquote either! + (setq default-directory (concat "/:" subdir)) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (concat "/:/:" subdir))))) + (delete-directory dir 'recursive)))) + (provide 'files-tests) ;;; files-tests.el ends here commit 2783e0e3899cf92910e97dc8bfda3e47b3df1478 Author: Eli Zaretskii Date: Sun Dec 11 19:19:10 2016 +0200 Undo part of last change * src/thread.h: * src/keyboard.c: * src/keyboard.h: Undo part of last change: input_available_clear_time is again a global variable. diff --git a/src/keyboard.c b/src/keyboard.c index cc78548..1fb1d49 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -319,6 +319,10 @@ static ptrdiff_t echo_length (void); /* Incremented whenever a timer is run. */ unsigned timers_run; +/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt + happens. */ +struct timespec *input_available_clear_time; + /* True means use SIGIO interrupts; false means use CBREAK mode. Default is true if INTERRUPT_INPUT is defined. */ bool interrupt_input; diff --git a/src/keyboard.h b/src/keyboard.h index 5084c39..435851f 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -415,6 +415,10 @@ extern void unuse_menu_items (void); #define EVENT_HEAD_KIND(event_head) \ (Fget ((event_head), Qevent_kind)) +/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt + happens. */ +extern struct timespec *input_available_clear_time; + extern bool ignore_mouse_drag_p; extern Lisp_Object parse_modifiers (Lisp_Object); diff --git a/src/thread.h b/src/thread.h index f10824f..739069a 100644 --- a/src/thread.h +++ b/src/thread.h @@ -159,11 +159,6 @@ struct thread_state bool m_waiting_for_input; #define waiting_for_input (current_thread->m_waiting_for_input) - /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt - happens. */ - struct timespec *m_input_available_clear_time; -#define input_available_clear_time (current_thread->m_input_available_clear_time) - /* The OS identifier for this thread. */ sys_thread_t thread_id; commit 997081634a3b6c2359226305db05c818c492a9b2 Author: Eli Zaretskii Date: Sun Dec 11 17:59:55 2016 +0200 Avoid aborts when a thread signals an error * src/thread.h (struct thread_state): Add members m_waiting_for_input and m_input_available_clear_time. (waiting_for_input, input_available_clear_time): New macros. * src/keyboard.c (waiting_for_input, input_available_clear_time): Remove; they are now macros that reference the current thread. (Bug#25171) * src/w32select.c: Don't include keyboard.h. * test/src/thread-tests.el (thread-errors): New test. diff --git a/src/keyboard.c b/src/keyboard.c index 01b9b3c..cc78548 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -148,9 +148,6 @@ static Lisp_Object regular_top_level_message; static sys_jmp_buf getcjmp; -/* True while doing kbd input. */ -bool waiting_for_input; - /* True while displaying for echoing. Delays C-g throwing. */ static bool echoing; @@ -322,10 +319,6 @@ static ptrdiff_t echo_length (void); /* Incremented whenever a timer is run. */ unsigned timers_run; -/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt - happens. */ -struct timespec *input_available_clear_time; - /* True means use SIGIO interrupts; false means use CBREAK mode. Default is true if INTERRUPT_INPUT is defined. */ bool interrupt_input; diff --git a/src/keyboard.h b/src/keyboard.h index a5ed5e1..5084c39 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -415,13 +415,6 @@ extern void unuse_menu_items (void); #define EVENT_HEAD_KIND(event_head) \ (Fget ((event_head), Qevent_kind)) -/* True while doing kbd input. */ -extern bool waiting_for_input; - -/* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt - happens. */ -extern struct timespec *input_available_clear_time; - extern bool ignore_mouse_drag_p; extern Lisp_Object parse_modifiers (Lisp_Object); diff --git a/src/thread.h b/src/thread.h index 6174032..f10824f 100644 --- a/src/thread.h +++ b/src/thread.h @@ -155,6 +155,15 @@ struct thread_state int m_waiting_for_user_input_p; #define waiting_for_user_input_p (current_thread->m_waiting_for_user_input_p) + /* True while doing kbd input. */ + bool m_waiting_for_input; +#define waiting_for_input (current_thread->m_waiting_for_input) + + /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt + happens. */ + struct timespec *m_input_available_clear_time; +#define input_available_clear_time (current_thread->m_input_available_clear_time) + /* The OS identifier for this thread. */ sys_thread_t thread_id; diff --git a/src/w32select.c b/src/w32select.c index 1754534..36908f9 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -77,7 +77,6 @@ along with GNU Emacs. If not, see . */ #include "w32common.h" /* os_subtype */ #include "w32term.h" /* for all of the w32 includes */ #include "w32select.h" -#include "keyboard.h" /* for waiting_for_input */ #include "blockinput.h" #include "coding.h" diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 4631882..4e7b052 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -209,5 +209,20 @@ (string= "hi bob" (condition-name (make-condition-variable (make-mutex) "hi bob"))))) +(defun call-error () + "Call `error'." + (error "Error is called")) + +;; This signals an error internally; the error should be caught. +(defun thread-custom () + (defcustom thread-custom-face 'highlight + "Face used for thread customizations." + :type 'face + :group 'widget-faces)) + +(ert-deftest thread-errors () + "Test what happens when a thread signals an error." + (should (threadp (make-thread #'call-error "call-error"))) + (should (threadp (make-thread #'thread-custom "thread-custom")))) ;;; threads.el ends here commit c0cfe9bc143686cd97d431831f47787753a95a42 Author: Philipp Stephani Date: Sat Dec 10 21:36:15 2016 +0100 Clean up compile-tests.el Switch to lexical binding. Make checkdoc happy. * test/lisp/progmodes/compile-tests.el (compile--test-error-line) (compile-test-error-regexps): Instead of checking a single Boolean value, use `should' for each attribute of the message to be compared. (compile-tests--test-regexps-data): Document sixth list element TYPE. diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 265baf2..631174f 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -1,4 +1,4 @@ -;;; compile-tests.el --- Test suite for compile.el. +;;; compile-tests.el --- Test suite for compile.el. -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -21,6 +21,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + +;; Unit tests for lisp/progmodes/compile.el. + ;;; Code: (require 'ert) @@ -323,15 +327,18 @@ ("index.html (13:1) Unknown element " 1 1 13 "index.html")) "List of tests for `compilation-error-regexp-alist'. -Each element has the form (STR POS COLUMN LINE FILENAME), where -STR is an error string, POS is the position of the error in STR, -COLUMN and LINE are the reported column and line numbers (or nil) -for that error, and FILENAME is the reported filename. +Each element has the form (STR POS COLUMN LINE FILENAME [TYPE]), +where STR is an error string, POS is the position of the error in +STR, COLUMN and LINE are the reported column and line numbers (or +nil) for that error, FILENAME is the reported filename, and TYPE +is 0 for an information message, 1 for a warning, and 2 for an +error. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) meaning a range of columns starting on LINE and ending on -END-LINE, if that matched.") +END-LINE, if that matched. TYPE can be left out, in which case +any message type is accepted.") (defun compile--test-error-line (test) (erase-buffer) @@ -339,35 +346,34 @@ END-LINE, if that matched.") (insert (car test)) (compilation-parse-errors (point-min) (point-max)) (let ((msg (get-text-property (nth 1 test) 'compilation-message))) - (when msg - (let ((loc (compilation--message->loc msg)) - (col (nth 2 test)) - (line (nth 3 test)) - (file (nth 4 test)) - (type (nth 5 test)) - end-col end-line) - (if (consp col) - (setq end-col (cdr col) col (car col))) - (if (consp line) - (setq end-line (cdr line) line (car line))) - (and (equal (compilation--loc->col loc) col) - (equal (compilation--loc->line loc) line) - (or (not file) - (equal (caar (compilation--loc->file-struct loc)) file)) - (or (null end-col) - (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) - end-col)) - (equal (car (nth 2 (compilation--loc->file-struct loc))) - (or end-line line)) - (or (null type) - (equal type (compilation--message->type msg)))))))) + (should msg) + (let ((loc (compilation--message->loc msg)) + (col (nth 2 test)) + (line (nth 3 test)) + (file (nth 4 test)) + (type (nth 5 test)) + end-col end-line) + (if (consp col) + (setq end-col (cdr col) col (car col))) + (if (consp line) + (setq end-line (cdr line) line (car line))) + (should (equal (compilation--loc->col loc) col)) + (should (equal (compilation--loc->line loc) line)) + (when file + (should (equal (caar (compilation--loc->file-struct loc)) file))) + (when end-col + (should (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) + end-col))) + (should (equal (car (nth 2 (compilation--loc->file-struct loc))) + (or end-line line))) + (when type + (should (equal type (compilation--message->type msg))))))) (ert-deftest compile-test-error-regexps () "Test the `compilation-error-regexp-alist' regexps. The test data is in `compile-tests--test-regexps-data'." (with-temp-buffer (font-lock-mode -1) - (dolist (test compile-tests--test-regexps-data) - (should (compile--test-error-line test))))) + (mapc #'compile--test-error-line compile-tests--test-regexps-data))) -;;; compile-tests.el ends here. +;;; compile-tests.el ends here