commit d0fd9809d7574c67a181225fcc1c59afdbb1295c (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Mon Jan 22 09:12:16 2018 +0100 Finish changes in autorevert from commit 530bb2dc68 * lisp/autorevert.el (auto-revert-buffers): Check `auto-revert-timer' being a timerp. * test/lisp/filenotify-tests.el (file-notify-test04-autorevert): Adapt test in order to cover changed behavior of autorevert. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index da8942664b..cf145e0ee3 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -803,7 +803,8 @@ the timer when no buffers need to be checked." ;; Check if we should cancel the timer. (when (and (not global-auto-revert-mode) (null auto-revert-buffer-list)) - (cancel-timer auto-revert-timer) + (if (timerp auto-revert-timer) + (cancel-timer auto-revert-timer)) (setq auto-revert-timer nil))))) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 8745fdc9e5..f2feef6132 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -884,8 +884,8 @@ delivered." ;; Stop file notification. Autorevert shall still work via polling. (file-notify-rm-watch auto-revert-notify-watch-descriptor) (file-notify--wait-for-events - timeout (null auto-revert-use-notify)) - (should-not auto-revert-use-notify) + timeout (null auto-revert-notify-watch-descriptor)) + (should auto-revert-use-notify) (should-not auto-revert-notify-watch-descriptor) ;; Modify file. We wait for two seconds, in order to @@ -902,7 +902,10 @@ delivered." (string-match (format-message "Reverting buffer `%s'." (buffer-name buf)) captured-messages)) - (should (string-match "foo bla" (buffer-string))))) + (should (string-match "foo bla" (buffer-string)))) + + ;; Stop autorevert, in order to cleanup descriptor. + (auto-revert-mode -1)) ;; The environment shall be cleaned up. (file-notify--test-cleanup-p)) commit b3fb0d47c158cb0d1acdce5008628e1d1a337bbb Author: Juri Linkov Date: Sun Jan 21 23:48:32 2018 +0200 * lisp/vc/add-log.el (change-log-next-buffer): Check file for nil. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index ec9299a947..ea2e8ec874 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1095,7 +1095,7 @@ file were isearch was started." ;; If there are no files that match the default pattern ChangeLog.[0-9], ;; return the current buffer to force isearch wrapping to its beginning. ;; If file is nil, multi-isearch-search-fun will signal "end of multi". - (if (file-exists-p file) + (if (and file (file-exists-p file)) (find-file-noselect file) (current-buffer)))) commit afba4ccb8b8c6347a44efd0b9f4d6fb85756f85b Author: Juri Linkov Date: Sun Jan 21 23:45:43 2018 +0200 New function read-answer (bug#30073) * lisp/emacs-lisp/map-ynp.el (read-answer): New function. (read-answer-short): New defcustom. * lisp/dired.el (dired-delete-file): Use read-answer. (dired--yes-no-all-quit-help): Remove function. (dired-delete-help): Remove defconst. * lisp/subr.el (assoc-delete-all): New function. diff --git a/etc/NEWS b/etc/NEWS index ed07b105e4..d30f0b087c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -240,6 +240,9 @@ file name extensions. ** The ecomplete sorting has changed to a decay-based algorithm. This can be controlled by the new `ecomplete-sort-predicate' variable. +** The new function 'read-answer' accepts either long or short answers +depending on the new customizable variable 'read-answer-short'. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/lisp/dired.el b/lisp/dired.el index b853d64c56..eebf8362cf 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2997,37 +2997,6 @@ Any other value means to ask for each directory." ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") -(defconst dired-delete-help - "Type: -`yes' to delete recursively the current directory, -`no' to skip to next, -`all' to delete all remaining directories with no more questions, -`quit' to exit, -`help' to show this help message.") - -(defun dired--yes-no-all-quit-help (prompt &optional help-msg) - "Ask a question with valid answers: yes, no, all, quit, help. -PROMPT must end with '? ', for instance, 'Delete it? '. -If optional arg HELP-MSG is non-nil, then is a message to show when -the user answers 'help'. Otherwise, default to `dired-delete-help'." - (let ((valid-answers (list "yes" "no" "all" "quit")) - (answer "") - (input-fn (lambda () - (read-string - (format "%s [yes, no, all, quit, help] " prompt))))) - (setq answer (funcall input-fn)) - (when (string= answer "help") - (with-help-window "*Help*" - (with-current-buffer "*Help*" - (insert (or help-msg dired-delete-help))))) - (while (not (member answer valid-answers)) - (unless (string= answer "help") - (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (sleep-for 2)) - (setq answer (funcall input-fn))) - answer)) - ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. @@ -3057,11 +3026,17 @@ TRASH non-nil means to trash the file instead of deleting, provided "trash" "delete") (dired-make-relative file)))) - (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user. + (pcase (read-answer + prompt + '(("yes" ?y "delete recursively the current directory") + ("no" ?n "skip to next") + ("all" ?! "delete all remaining directories with no more questions") + ("quit" ?q "exit"))) ('"all" (setq recursive 'always dired-recursive-deletes recursive)) ('"yes" (if (eq recursive 'top) (setq recursive 'always))) ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit))))) + ('"quit" (keyboard-quit)) + (_ (keyboard-quit))))) ; catch all unknown answers (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index dd80524a15..61c04ff7b3 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -252,4 +252,126 @@ C-g to quit (cancel the whole command); ;; Return the number of actions that were taken. actions)) + +;; read-answer is a general-purpose question-asker that supports +;; either long or short answers. + +;; For backward compatibility check if short y/n answers are preferred. +(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) + "If non-nil, accept short answers to the question." + :type 'boolean + :version "27.1" + :group 'minibuffer) + +(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal)) + +(defun read-answer (question answers) + "Read an answer either as a complete word or its character abbreviation. +Ask user a question and accept an answer from the list of possible answers. + +QUESTION should end in a space; this function adds a list of answers to it. + +ANSWERS is an alist with elements in the following format: + (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE) +where + LONG-ANSWER is a complete answer, + SHORT-ANSWER is an abbreviated one-character answer, + HELP-MESSAGE is a string describing the meaning of the answer. + +Example: + \\='((\"yes\" ?y \"perform the action\") + (\"no\" ?n \"skip to the next\") + (\"all\" ?! \"accept all remaining without more questions\") + (\"help\" ?h \"show help\") + (\"quit\" ?q \"exit\")) + +When `read-answer-short' is non-nil, accept short answers. + +Return a long answer even in case of accepting short ones. + +When `use-dialog-box' is t, pop up a dialog window to get user input." + (custom-reevaluate-setting 'read-answer-short) + (let* ((short read-answer-short) + (answers-with-help + (if (assoc "help" answers) + answers + (append answers '(("help" ?? "show this help message"))))) + (answers-without-help + (assoc-delete-all "help" (copy-alist answers-with-help))) + (prompt + (format "%s(%s) " question + (mapconcat (lambda (a) + (if short + (format "%c" (nth 1 a)) + (nth 0 a))) + answers-with-help ", "))) + (message + (format "Please answer %s." + (mapconcat (lambda (a) + (format "`%s'" (if short + (string (nth 1 a)) + (nth 0 a)))) + answers-with-help " or "))) + (short-answer-map + (when short + (or (gethash answers read-answer-map--memoize) + (puthash answers + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (dolist (a answers-with-help) + (define-key map (vector (nth 1 a)) + (lambda () + (interactive) + (delete-minibuffer-contents) + (insert (nth 0 a)) + (exit-minibuffer)))) + (define-key map [remap self-insert-command] + (lambda () + (interactive) + (delete-minibuffer-contents) + (beep) + (message message) + (sleep-for 2))) + map) + read-answer-map--memoize)))) + answer) + (while (not (assoc (setq answer (downcase + (cond + ((and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (x-popup-dialog + t + (cons question + (mapcar (lambda (a) + (cons (capitalize (nth 0 a)) + (nth 0 a))) + answers-with-help)))) + (short + (read-from-minibuffer + prompt nil short-answer-map nil + 'yes-or-no-p-history)) + (t + (read-from-minibuffer + prompt nil nil nil + 'yes-or-no-p-history))))) + answers-without-help)) + (if (string= answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert "Type:\n" + (mapconcat + (lambda (a) + (format "`%s'%s to %s" + (if short (string (nth 1 a)) (nth 0 a)) + (if short (format " (%s)" (nth 0 a)) "") + (nth 2 a))) + answers-with-help ",\n") + ".\n"))) + (beep) + (message message) + (sleep-for 2))) + answer)) + ;;; map-ynp.el ends here diff --git a/lisp/subr.el b/lisp/subr.el index 46cf5a34cc..092850a44d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -705,6 +705,21 @@ Non-strings in LIST are ignored." (setq list (cdr list))) list) +(defun assoc-delete-all (key alist) + "Delete from ALIST all elements whose car is `equal' to KEY. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + (while (and (consp (car alist)) + (equal (car (car alist)) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (equal (car (car tail-cdr)) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + (defun assq-delete-all (key alist) "Delete from ALIST all elements whose car is `eq' to KEY. Return the modified alist. diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 89cb7b6111..ab6d1cb056 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -59,7 +59,7 @@ (unwind-protect (if ,yes-or-no (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (prompt) (eq ,yes-or-no 'yes)))) + (lambda (_prompt) (eq ,yes-or-no 'yes)))) ,@body) ,@body) ;; clean up diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index c0242137b3..bb0e1bc388 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -384,9 +384,9 @@ (dired-test-with-temp-dirs 'just-empty-dirs (let (asked) - (advice-add 'dired--yes-no-all-quit-help + (advice-add 'read-answer :override - (lambda (_) (setq asked t) "") + (lambda (_q _a) (setq asked t) "") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -395,44 +395,44 @@ (progn (should-not asked) (should-not (dired-get-marked-files))) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) ;; Answer yes (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + (advice-add 'read-answer :override (lambda (_q _a) "yes") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer no (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + (advice-add 'read-answer :override (lambda (_q _a) "no") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer all (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + (advice-add 'read-answer :override (lambda (_q _a) "all") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer quit (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit") + (advice-add 'read-answer :override (lambda (_q _a) "quit") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -440,7 +440,7 @@ (dired-do-delete nil)) (unwind-protect (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) (provide 'dired-tests) commit 9ae0e4aa1aee3d7ff2546e34aa83536f72f8c06a Author: Lars Ingebrigtsen Date: Sun Jan 21 21:41:36 2018 +0100 (archive-rar-summarize): Adjust parsing to be more permissive * lisp/arc-mode.el (archive-rar-summarize): Adjust parsing to be more permissive. The previous code would stop parsing if we had a directory entry or a negative ratio as seen from the output of lsar on Debian jessie: 0. D---- 16221659 ----- Nr20 2005-12-24 19:30 foo/ 4. ----- 466509 -0.0% Nr20 2005-12-24 19:19 foo/bar.jpg diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 3973e97d62..adb3669903 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -2043,13 +2043,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (if copy (delete-file copy)) (goto-char (point-min)) (re-search-forward "^\\(\s+=+\s?+\\)+\n") - (while (looking-at (concat "^\s+[0-9.]+\s+-+\s+" ; Flags - "\\([0-9-]+\\)\s+" ; Size - "\\([0-9.%]+\\)\s+" ; Ratio - "\\([0-9a-zA-Z]+\\)\s+" ; Mode - "\\([0-9-]+\\)\s+" ; Date - "\\([0-9:]+\\)\s+" ; Time - "\\(.*\\)\n" ; Name + (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags + "\\([0-9-]+\\)\s+" ; Size + "\\([-0-9.%]+\\|-+\\)\s+" ; Ratio + "\\([0-9a-zA-Z]+\\)\s+" ; Mode + "\\([0-9-]+\\)\s+" ; Date + "\\([0-9:]+\\)\s+" ; Time + "\\(.*\\)\n" ; Name )) (goto-char (match-end 0)) (let ((name (match-string 6)) commit c965e5a641d9478d23a233b48977503506b1b603 Author: Alan Mackenzie Date: Sun Jan 21 18:29:26 2018 +0000 Handle C99 Compound Literals in return statements and argument lists. * lisp/progmodes/cc-engine.el (c-looking-at-or-maybe-in-bracelist): Recognize a brace list when preceded by "return" or inside parentheses, either immediately after the "(" or following a comma. (c-looking-at-inexpr-block): Test c-has-compound-literals rather than hard coded C++ Mode. (c-guess-basic-syntax, CASE 7B): Test additionally for not being just inside a parenthesis or being at a Java "new" keyword. CASE 9: Remove the simple minded test on the contents of a block to determine a brace list. * lisp/progmodes/cc-langs.el (c-has-compound-literals): New lang const and lang var. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b5f085b4b3..b78e85a670 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10525,6 +10525,17 @@ comment at the start of cc-engine.el for more info." ((and class-key (looking-at class-key)) (setq braceassignp nil)) + ((and c-has-compound-literals + (looking-at c-return-key)) + (setq braceassignp t) + nil) + ((and c-has-compound-literals + (eq (char-after) ?,)) + (save-excursion + (when (and (c-go-up-list-backward nil lim) + (eq (char-after) ?\()) + (setq braceassignp t) + nil))) ((eq (char-after) ?=) ;; We've seen a =, but must check earlier tokens so ;; that it isn't something that should be ignored. @@ -10563,9 +10574,14 @@ comment at the start of cc-engine.el for more info." )))) nil) (t t)))))) - (if (and (eq braceassignp 'dontknow) - (/= (c-backward-token-2 1 t lim) 0)) - (setq braceassignp nil))) + (when (and (eq braceassignp 'dontknow) + (/= (c-backward-token-2 1 t lim) 0)) + (if (save-excursion + (and c-has-compound-literals + (eq (c-backward-token-2 1 nil lim) 0) + (eq (char-after) ?\())) + (setq braceassignp t) + (setq braceassignp nil)))) (cond (braceassignp @@ -10930,7 +10946,7 @@ comment at the start of cc-engine.el for more info." (c-on-identifier))) (and c-special-brace-lists (c-looking-at-special-brace-list)) - (and (c-major-mode-is 'c++-mode) + (and c-has-compound-literals (save-excursion (goto-char block-follows) (not (c-looking-at-statement-block))))) @@ -12437,6 +12453,11 @@ comment at the start of cc-engine.el for more info." ;; in-expression block or brace list. C.f. cases 4, 16A ;; and 17E. ((and (eq char-after-ip ?{) + (or (not (eq (char-after containing-sexp) ?\()) + (save-excursion + (and c-opt-inexpr-brace-list-key + (eq (c-beginning-of-statement-1 lim t nil t) 'same) + (looking-at c-opt-inexpr-brace-list-key)))) (progn (setq placeholder (c-inside-bracelist-p (point) paren-state diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 271cc2f846..c06dd2164d 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -617,6 +617,12 @@ EOL terminated statements." c++ t) (c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers)) +(c-lang-defconst c-has-compound-literals + "Whether literal initializers {...} are used other than in initializations." + t nil + (c c++) t) +(c-lang-defvar c-has-compound-literals (c-lang-const c-has-compound-literals)) + (c-lang-defconst c-modified-constant "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", a “long character”. In particular, this recognizes forms of constant commit cff45e6f4e6a684d233140b5ab3edbf73fa5edae Author: Simen Heggestøyl Date: Sat Jan 13 09:41:47 2018 +0100 Parse percent values in CSS alpha components * lisp/textmodes/css-mode.el (css--rgb-color): Support parsing percent values in the alpha component. * test/lisp/textmodes/css-mode-tests.el (css-test-rgb-to-named-color-or-hex, css-test-rgb-parser): Update for the above changes. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 1d13070f12..7e997ac2c0 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -954,11 +954,11 @@ the returned hex string." (let* ((is-percent (match-beginning 1)) (str (match-string (if is-percent 1 2))) (number (string-to-number str))) - (when is-percent - (setq number (* 255 (/ number 100.0)))) - (if (and include-alpha (= iter 3)) - (push (round (* number 255)) result) - (push (min (max 0 (truncate number)) 255) result)) + (if is-percent + (setq number (* 255 (/ number 100.0))) + (when (and include-alpha (= iter 3)) + (setq number (* number 255)))) + (push (min (max 0 (round number)) 255) result) (goto-char (match-end 0)) (css--color-skip-blanks) (cl-incf iter) diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 537a88ec52..272d281217 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -293,7 +293,9 @@ ("rgb(255, 255, 255)" "white") ("rgb(255, 255, 240)" "ivory") ("rgb(18, 52, 86)" "#123456") - ("rgba(18, 52, 86, 0.5)" "#12345680"))) + ("rgba(18, 52, 86, 0.5)" "#12345680") + ("rgba(18, 52, 86, 50%)" "#12345680") + ("rgba(50%, 50%, 50%, 50%)" "#80808080"))) (with-temp-buffer (css-mode) (insert (nth 0 item)) @@ -330,11 +332,11 @@ (ert-deftest css-test-rgb-parser () (with-temp-buffer (css-mode) - (dolist (input '("255, 0, 127" - "255, /* comment */ 0, 127" - "255 0 127" - "255, 0, 127, 0.75" - "255 0 127 / 0.75" + (dolist (input '("255, 0, 128" + "255, /* comment */ 0, 128" + "255 0 128" + "255, 0, 128, 0.75" + "255 0 128 / 0.75" "100%, 0%, 50%" "100%, 0%, 50%, 0.115" "100% 0% 50%" @@ -342,7 +344,7 @@ (erase-buffer) (save-excursion (insert input ")")) - (should (equal (css--rgb-color) "#ff007f"))))) + (should (equal (css--rgb-color) "#ff0080"))))) (ert-deftest css-test-hsl-parser () (with-temp-buffer