commit 7c1fa1795551af0890cfbc798d88d656d57c1728 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Tue Jun 5 09:43:34 2018 +0200 Fix selinux test in files-tests.el * test/lisp/files-tests.el (files-tests-file-name-non-special-set-file-selinux-context): Adapt test. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 30a09c796e..3b192ee872 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -998,7 +998,8 @@ unquoted file names." (set-file-selinux-context nospecial (file-selinux-context nospecial)))) (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (unless (equal (file-selinux-context tmpfile) '(nil nil nil nil)) - (set-file-selinux-context nospecial (file-selinux-context nospecial))))) + (should-error + (set-file-selinux-context nospecial (file-selinux-context nospecial)))))) (ert-deftest files-tests-file-name-non-special-set-file-times () (files-tests--with-temp-non-special (tmpfile nospecial) commit 1dafa4a02ed45bb4d02c6dc34c55518858422088 Merge: 4ee82a4ea9 5d448ca98c Author: Glenn Morris Date: Mon Jun 4 09:25:22 2018 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 5d448ca (origin/emacs-26) Make cl-print respect print-level and print... commit 4ee82a4ea98a17362fe36bfd5253eda768003683 Merge: a3ec2e7edd 03697e648c Author: Glenn Morris Date: Mon Jun 4 09:25:22 2018 -0700 Merge from origin/emacs-26 03697e6 Fix remote-host directory tracking for shells in `term' buffers 16e8541 Update doc string of 'rx' commit a3ec2e7edd9d84b83d22453dcaa37488b5c5d9e9 Merge: b12333f122 9a14b4d1ce Author: Glenn Morris Date: Mon Jun 4 09:25:22 2018 -0700 ; Merge from origin/emacs-26 The following commits were skipped: 9a14b4d ; Merge: backports from master ed962f2 Fix bug#30846, along with misc cleanups found along the way 3ba5fc2 esh-opt.el: Fix improper parsing of first argument (Bug#28323) 0ac98cc * lisp/epa.el (epa-decrypt-file): Apply epa-pinentry-mode (Bu... 9552485 Fix cl-print for circular sublists (Bug#31146) 4c6cdf6 Revert "Make mail-extract-address-components return the user ... 51ee8bc Centralize Bug#30931 fix daa6023 Fix another case of freed markers in the undo-list (Bug#30931) 7460840 Fix CHECK_ALLOCATED_AND_LIVE abort during GC 71192e0 Don't wait for visible frames to become visible 5fa73a7 query-replace undo: Handle when user edits the replacement st... 031004e Backport: Fix corner case in query-replace-regexp undo 50c0624 Backport: Preserve case in query-replace undo commit b12333f122eecf491ffb88a8410432bf62c22cbc Merge: 5e307525b9 defd53a56c Author: Glenn Morris Date: Mon Jun 4 09:25:22 2018 -0700 Merge from origin/emacs-26 defd53a Set accessibility subroles for child frame (bug#31324) de6a876 Fix redefinition of child frames on NS commit 5e307525b907601ccda2a7914fea898366b25b91 Author: Michael Albinus Date: Mon Jun 4 18:15:54 2018 +0200 Fix Bug#31489 * lisp/files.el (file-name-unquote-non-special): Remove. (file-name-quoted-p, file-name-quote, file-name-unquote): Add optional argument TOP. (file-name-non-special): Adapt callees. Finish implementation of functions which need a local copy. (Bug#31489) diff --git a/lisp/files.el b/lisp/files.el index 68423f87bb..dbe95bb665 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7044,8 +7044,7 @@ only these files will be asked to be saved." ;; Use a temporary local copy. (copy-file local-copy) (rename-file local-copy) - ;;`copy-directory' needs special handling. - (copy-directory copy-directory) + (copy-directory local-copy) ;; List the arguments which are filenames. (file-name-completion 0 1) (file-name-all-completions 0 1) @@ -7072,21 +7071,20 @@ only these files will be asked to be saved." (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) (when (car pair) - (setcar pair (file-name-unquote-non-special (car pair))))) + (setcar pair (file-name-unquote (car pair) t)))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) - (`add (file-name-quote (apply operation arguments))) + (`add (file-name-quote (apply operation arguments) t)) (`buffer-file-name - (let ((buffer-file-name - (file-name-unquote-non-special buffer-file-name))) + (let ((buffer-file-name (file-name-unquote buffer-file-name t))) (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect (apply operation arguments) (when (and visit buffer-file-name) - (setq buffer-file-name (file-name-quote buffer-file-name)))))) + (setq buffer-file-name (file-name-quote buffer-file-name t)))))) (`unquote-then-quote ;; We can't use `cl-letf' with `(buffer-local-value)' here ;; because it wouldn't work during bootstrapping. @@ -7095,8 +7093,7 @@ only these files will be asked to be saved." ;; `verify-visited-file-modtime' action, which takes a buffer ;; as only optional argument. (with-current-buffer (or (car arguments) buffer) - (let ((buffer-file-name - (file-name-unquote-non-special buffer-file-name))) + (let ((buffer-file-name (file-name-unquote buffer-file-name t))) ;; Make sure to hide the temporary buffer change from the ;; underlying operation. (with-current-buffer buffer @@ -7105,62 +7102,67 @@ only these files will be asked to be saved." (let* ((file-name-handler-alist saved-file-name-handler-alist) (source (car arguments)) (target (car (cdr arguments))) - (tmpfile (file-local-copy source))) - (let ((handler (find-file-name-handler target 'copy-file))) - (unless (and handler (not (eq handler 'file-name-non-special))) - (setq target (file-name-unquote-non-special target)))) - (setcar arguments (or tmpfile (file-name-unquote-non-special source))) - (setcar (cdr arguments) target) - (apply operation arguments) - (when (and tmpfile (file-exists-p tmpfile)) (delete-file tmpfile)))) - (`copy-directory - (let* ((file-name-handler-alist saved-file-name-handler-alist) - (source (car arguments)) - (target (car (cdr arguments))) - tmpdir) - (let ((handler (find-file-name-handler source 'copy-directory))) - (if (and handler (not (eq handler 'file-name-non-special))) - (progn - (setq tmpdir (make-temp-name temporary-file-directory)) - (setcar (cdr arguments) tmpdir) - (apply operation arguments) - (setq source tmpdir)) - (setq source (file-name-unquote-non-special source)))) - (let ((handler (find-file-name-handler target 'copy-directory))) - (unless (and handler (not (eq handler 'file-name-non-special))) - (setq target (file-name-unquote-non-special target)))) + (prefix (expand-file-name + "file-name-non-special" temporary-file-directory)) + tmpfile) + (cond + ;; If source is remote, we must create a local copy. + ((file-remote-p source) + (setq tmpfile (make-temp-name prefix)) + (apply operation source tmpfile (cddr arguments)) + (setq source tmpfile)) + ;; If source is quoted, and the unquoted source looks + ;; remote, we must create a local copy. + ((file-name-quoted-p source t) + (setq source (file-name-unquote source t)) + (when (file-remote-p source) + (setq tmpfile (make-temp-name prefix)) + (let (file-name-handler-alist) + (apply operation source tmpfile (cddr arguments))) + (setq source tmpfile)))) + ;; If target is quoted, and the unquoted target looks remote, + ;; we must disable the file name handler. + (when (file-name-quoted-p target t) + (setq target (file-name-unquote target t)) + (when (file-remote-p target) + (setq file-name-handler-alist nil))) + ;; Do it. (setcar arguments source) (setcar (cdr arguments) target) (apply operation arguments) - (when tmpdir (delete-directory tmpdir 'recursive)))) + ;; Cleanup. + (when (and tmpfile (file-exists-p tmpfile)) + (if (file-directory-p tmpfile) + (delete-directory tmpfile 'recursive) (delete-file tmpfile))))) (_ (apply operation arguments))))) -(defsubst file-name-quoted-p (name) +(defsubst file-name-quoted-p (name &optional top) "Whether NAME is quoted with prefix \"/:\". -If NAME is a remote file name, check the local part of NAME." - (string-prefix-p "/:" (file-local-name name))) +If NAME is a remote file name and TOP is nil, check the local part of NAME." + (let ((file-name-handler-alist (unless top file-name-handler-alist))) + (string-prefix-p "/:" (file-local-name name)))) -(defsubst file-name-quote (name) +(defsubst file-name-quote (name &optional top) "Add the quotation prefix \"/:\" to file NAME. -If NAME is a remote file name, the local part of NAME is quoted. -If NAME is already a quoted file name, NAME is returned unchanged." - (if (file-name-quoted-p name) - name - (concat (file-remote-p name) "/:" (file-local-name name)))) - -(defsubst file-name-unquote-non-special (name) - "Remove quotation prefix \"/:\" from file NAME, if any." - (let (file-name-handler-alist) - (if (file-name-quoted-p name) - (if (= (length name) 2) "/" (substring name 2)) - name))) - -(defsubst file-name-unquote (name) +If NAME is a remote file name and TOP is nil, the local part of +NAME is quoted. If NAME is already a quoted file name, NAME is +returned unchanged." + (let ((file-name-handler-alist (unless top file-name-handler-alist))) + (if (file-name-quoted-p name top) + name + (concat (file-remote-p name) "/:" (file-local-name name))))) + +(defsubst file-name-unquote (name &optional top) "Remove quotation prefix \"/:\" from file NAME, if any. -If NAME is a remote file name, the local part of NAME is unquoted." - (concat - (file-remote-p name) (file-name-unquote-non-special (file-local-name name)))) +If NAME is a remote file name and TOP is nil, the local part of +NAME is unquoted." + (let* ((file-name-handler-alist (unless top file-name-handler-alist)) + (localname (file-local-name name))) + (when (file-name-quoted-p localname top) + (setq + localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))) ;; Symbolic modes and read-file-modes. commit 5d448ca98cd59287b2c20175e2e6638f1922db57 Author: Gemini Lasswell Date: Sun May 27 11:38:00 2018 -0700 Make cl-print respect print-level and print-length (bug#31559) * lisp/emacs-lisp/cl-print.el (cl-print--depth): New variable. (cl-print-object) : Print ellipsis if printing depth greater than 'print-level' or length of list greater than 'print-length'. (cl-print-object) : Truncate printing with ellipsis if vector is longer than 'print-length'. (cl-print-object) : Truncate printing with ellipsis if structure has more slots than 'print-length'. (cl-print-object) <:around>: Bind 'cl-print--depth'. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-3, cl-print-tests-4): New tests. (cherry picked from commit 0f48d18fd2a30f29cc3592a835d2a2254c9b0afb) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 7c0e81c934..780b9fb3fe 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -40,6 +40,10 @@ (defvar cl-print--number-table nil) (defvar cl-print--currently-printing nil) +(defvar cl-print--depth nil + "Depth of recursion within cl-print functions. +Compared to `print-level' to determine when to stop recursing.") + ;;;###autoload (cl-defgeneric cl-print-object (object stream) @@ -52,33 +56,45 @@ call other entry points instead, such as `cl-prin1'." (prin1 object stream)) (cl-defmethod cl-print-object ((object cons) stream) - (let ((car (pop object))) - (if (and (memq car '(\, quote \` \,@ \,.)) - (consp object) - (null (cdr object))) - (progn - (princ (if (eq car 'quote) '\' car) stream) - (cl-print-object (car object) stream)) - (princ "(" stream) - (cl-print-object car stream) - (while (and (consp object) - (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 - (princ " . " stream) (cl-print-object object stream)) - (princ ")" stream)))) + (if (and cl-print--depth (natnump print-level) + (> cl-print--depth print-level)) + (princ "..." stream) + (let ((car (pop object)) + (count 1)) + (if (and (memq car '(\, quote \` \,@ \,.)) + (consp object) + (null (cdr object))) + (progn + (princ (if (eq car 'quote) '\' car) stream) + (cl-print-object (car object) stream)) + (princ "(" stream) + (cl-print-object car stream) + (while (and (consp object) + (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) + (if (or (not (natnump print-length)) (> print-length count)) + (cl-print-object (pop object) stream) + (princ "..." stream) + (setq object nil)) + (cl-incf count)) + (when object + (princ " . " stream) (cl-print-object object stream)) + (princ ")" stream))))) (cl-defmethod cl-print-object ((object vector) stream) (princ "[" stream) - (dotimes (i (length object)) - (unless (zerop i) (princ " " stream)) - (cl-print-object (aref object i) stream)) + (let ((count (length object))) + (dotimes (i (if (natnump print-length) + (min print-length count) count)) + (unless (zerop i) (princ " " stream)) + (cl-print-object (aref object i) stream)) + (when (and (natnump print-length) (< print-length count)) + (princ " ..." stream))) (princ "]" stream)) (cl-defmethod cl-print-object ((object hash-table) stream) @@ -180,14 +196,18 @@ into a button whose action shows the function's disassembly.") (cl-defmethod cl-print-object ((object cl-structure-object) stream) (princ "#s(" stream) (let* ((class (cl-find-class (type-of object))) - (slots (cl--struct-class-slots class))) + (slots (cl--struct-class-slots class)) + (count (length slots))) (princ (cl--struct-class-name class) stream) - (dotimes (i (length slots)) + (dotimes (i (if (natnump print-length) + (min print-length count) count)) (let ((slot (aref slots i))) (princ " :" stream) (princ (cl--slot-descriptor-name slot) stream) (princ " " stream) - (cl-print-object (aref object (1+ i)) stream)))) + (cl-print-object (aref object (1+ i)) stream))) + (when (and (natnump print-length) (< print-length count)) + (princ " ..." stream))) (princ ")" stream)) ;;; Circularity and sharing. @@ -198,26 +218,27 @@ into a button whose action shows the function's disassembly.") (cl-defmethod cl-print-object :around (object stream) ;; FIXME: Only put such an :around method on types where it's relevant. - (cond - (print-circle - (let ((n (gethash object cl-print--number-table))) - (if (not (numberp n)) - (cl-call-next-method) - (if (> n 0) - ;; Already printed. Just print a reference. - (progn (princ "#" stream) (princ n stream) (princ "#" stream)) - (puthash object (- n) cl-print--number-table) - (princ "#" stream) (princ (- n) stream) (princ "=" stream) - (cl-call-next-method))))) - ((let ((already-printing (memq object cl-print--currently-printing))) - (when already-printing - ;; Currently printing, just print reference to avoid endless - ;; recursion. - (princ "#" stream) - (princ (length (cdr already-printing)) stream)))) - (t (let ((cl-print--currently-printing - (cons object cl-print--currently-printing))) - (cl-call-next-method))))) + (let ((cl-print--depth (if cl-print--depth (1+ cl-print--depth) 1))) + (cond + (print-circle + (let ((n (gethash object cl-print--number-table))) + (if (not (numberp n)) + (cl-call-next-method) + (if (> n 0) + ;; Already printed. Just print a reference. + (progn (princ "#" stream) (princ n stream) (princ "#" stream)) + (puthash object (- n) cl-print--number-table) + (princ "#" stream) (princ (- n) stream) (princ "=" stream) + (cl-call-next-method))))) + ((let ((already-printing (memq object cl-print--currently-printing))) + (when already-printing + ;; Currently printing, just print reference to avoid endless + ;; recursion. + (princ "#" stream) + (princ (length (cdr already-printing)) stream)))) + (t (let ((cl-print--currently-printing + (cons object cl-print--currently-printing))) + (cl-call-next-method)))))) (defvar cl-print--number-index nil) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index d986c4015d..bfce4a16ce 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -47,6 +47,31 @@ "\\`(#1=#s(foo 1 2 3) #1#)\\'" (cl-prin1-to-string (list x x))))))) +(cl-defstruct (cl-print-tests-struct + (:constructor cl-print-tests-con)) + a b c d e) + +(ert-deftest cl-print-tests-3 () + "CL printing observes `print-length'." + (let ((long-list (make-list 5 'a)) + (long-vec (make-vector 5 'b)) + (long-struct (cl-print-tests-con)) + (print-length 4)) + (should (equal "(a a a a ...)" (cl-prin1-to-string long-list))) + (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec))) + (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" + (cl-prin1-to-string long-struct))))) + +(ert-deftest cl-print-tests-4 () + "CL printing observes `print-level'." + (let ((deep-list '(a (b (c (d (e)))))) + (deep-struct (cl-print-tests-con)) + (print-level 4)) + (setf (cl-print-tests-struct-a deep-struct) deep-list) + (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list))) + (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" + (cl-prin1-to-string deep-struct))))) + (ert-deftest cl-print-circle () (let ((x '(#1=(a . #1#) #1#))) (let ((print-circle nil)) commit 9a0b20d5b33e3e3282b597c3d0c836396071a547 Author: João Távora Date: Mon Jun 4 01:40:50 2018 +0100 Add proper Flymake support to cc-mode.el Except for the important detail that it doesn't make temporary files, the new flymake-cc backend doesn't yet behave much differently from the old flymake-proc-legacy-flymake, i.e. it still needs a special `check-syntax' Makefile target to provide the compiler and compilation flags. However, the new infrastructure created should allow less intrusive cleverer flag guessers (yet to be written) to replace that mechanism. * lisp/progmodes/cc-mode.el (c-mode, c++-mode): Add to flymake-diagnostic-functions. * lisp/progmodes/flymake-cc.el: New file. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 49c917160c..a1411ad5ea 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2039,6 +2039,7 @@ Key bindings: (c-common-init 'c-mode) (easy-menu-add c-c-menu) (cc-imenu-init cc-imenu-c-generic-expression) + (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) (defconst c-or-c++-mode--regexp @@ -2126,6 +2127,7 @@ Key bindings: (c-common-init 'c++-mode) (easy-menu-add c-c++-menu) (cc-imenu-init cc-imenu-c++-generic-expression) + (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el new file mode 100644 index 0000000000..ebcfd7d1f6 --- /dev/null +++ b/lisp/progmodes/flymake-cc.el @@ -0,0 +1,140 @@ +;;; flymake-cc.el --- Flymake support for GNU tools for C/C++ -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: João Távora +;; Keywords: languages, c + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Flymake support for C/C++. + +;;; Code: + +(require 'cl-lib) + +(defcustom flymake-cc-command 'flymake-cc-use-special-make-target + "Command used by the `flymake-cc' backend. +A list of strings, or a symbol naming a function that produces one +such list when called with no arguments in the buffer where the +variable `flymake-mode' is active. + +The command should invoke a GNU-style compiler that checks the +syntax of a (Obj)C(++) program passed to it via its standard +input and prints the result on its standard output." + :type '(choice + (symbol :tag "Function") + ((repeat :) string)) + :group 'flymake-cc) + +(defun flymake-cc--make-diagnostics (source) + "Parse GNU-compatible compilation messages in current buffer. +Return a list of Flymake diagnostic objects for the source buffer +SOURCE." + ;; TODO: if you can understand it, use `compilation-mode's regexps + ;; or even some of its machinery here. + ;; + ;; (set (make-local-variable 'compilation-locs) + ;; (make-hash-table :test 'equal :weakness 'value)) + ;; (compilation-parse-errors (point-min) (point-max) + ;; 'gnu 'gcc-include) + ;; (while (next-single-property-change 'compilation-message) + ;; ...) + ;; + ;; For now, this works minimally well. + (cl-loop + while + (search-forward-regexp + "^\\(In file included from \\)?:\\([0-9]+\\):\\([0-9]+\\):\n?\\(.*\\): \\(.*\\)$" + nil t) + for msg = (match-string 5) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 2)) + (string-to-number (match-string 3))) + for type = (if (match-string 1) + :error + (assoc-default + (match-string 4) + '(("error" . :error) + ("note" . :note) + ("warning" . :warning)) + #'string-match)) + collect (flymake-make-diagnostic source beg end type msg))) + +(defun flymake-cc-use-special-make-target () + "Command for checking a file via a CHK_SOURCES Make target." + (unless (executable-find "make") (error "Make not found")) + `("make" "check-syntax" "CHK_SOURCES=-x c -")) + +(defvar-local flymake-cc--proc nil "Internal variable for `flymake-gcc'") + +;; forward declare this to shoosh compiler (instead of requiring +;; flymake-proc) +;; +(defvar flymake-proc-allowed-file-name-masks) + +;;;###autoload +(defun flymake-cc (report-fn &rest _args) + "Flymake backend for GNU-style C compilers. +This backend uses `flymake-cc-command' (which see) to launch a +process that is passed the current buffer's contents via stdin. +REPORT-FN is Flymake's callback." + ;; HACK: XXX: Assuming this backend function is run before it in + ;; `flymake-diagnostic-functions', very hackingly convince the other + ;; backend `flymake-proc-legacy-backend', which is on by default, to + ;; disable itself. + ;; + (setq-local flymake-proc-allowed-file-name-masks nil) + (when (process-live-p flymake-cc--proc) + (kill-process flymake-cc--proc)) + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq + flymake-cc--proc + (make-process + :name "gcc-flymake" + :buffer (generate-new-buffer "*gcc-flymake*") + :command (if (symbolp flymake-cc-command) + (funcall flymake-cc-command) + flymake-cc-command) + :noquery t :connection-type 'pipe + :sentinel + (lambda (p _ev) + (when (eq 'exit (process-status p)) + (unwind-protect + (when (with-current-buffer source (eq p flymake-cc--proc)) + (with-current-buffer (process-buffer p) + (goto-char (point-min)) + (let ((diags + (flymake-cc--make-diagnostics source))) + (if (or diags (zerop (process-exit-status p))) + (funcall report-fn diags) + ;; non-zero exit with no diags is cause + ;; for alarm + (funcall report-fn + :panic :explanation + (buffer-substring + (point-min) (progn (goto-char (point-min)) + (line-end-position)))))))) + ;; (display-buffer (process-buffer p)) ; uncomment to debug + (kill-buffer (process-buffer p))))))) + (process-send-region flymake-cc--proc (point-min) (point-max)) + (process-send-eof flymake-cc--proc)))) + +(provide 'flymake-cc) +;;; flymake-cc.el ends here commit 03697e648c080f6b007b6ef8443fd4448bc52364 Author: Phil Sainty Date: Fri May 4 01:29:42 2018 +1200 Fix remote-host directory tracking for shells in `term' buffers * lisp/term.el (term-handle-ansi-terminal-messages): Use an explicit tramp method when constructing the tramp path for a non-local host, as this is now mandatory. "-" is a pseudo-method for the user's `tramp-default-method'. (Bug#31355) Specify the remote username explicitly in all cases, as `tramp-default-user' and `tramp-default-user-alist' could cause the previous logic to fail. Minor related improvements to the commentary. diff --git a/lisp/term.el b/lisp/term.el index 75c2779783..419ddb2db5 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -233,31 +233,33 @@ ;; ;; Notice: for directory/host/user tracking you need to have something ;; like this in your shell startup script (this is for a POSIXish shell -;; like Bash but should be quite easy to port to other shells) +;; like Bash but should be quite easy to port to other shells). +;; +;; For troubleshooting in Bash, you can check the definition of the +;; custom functions with the "type" command. e.g. "type cd". If you +;; do not see the expected definition from the config below, then the +;; directory tracking will not work. ;; ;; ---------------------------------------- ;; -;; # Set HOSTNAME if not already set. +;; # Set HOSTNAME if not already set. ;; : ${HOSTNAME=$(uname -n)} ;; -;; # su does not change this but I'd like it to -;; +;; # su does not change this but I'd like it to ;; USER=$(whoami) ;; -;; # ... +;; # ... ;; ;; case $TERM in ;; eterm*) ;; ;; printf '%s\n' \ ;; -------------------------------------------------------------- \ -;; "Hello $user" \ +;; "Hello $USER" \ ;; "Today is $(date)" \ ;; "We are on $HOSTNAME running $(uname) under Emacs term mode" \ ;; -------------------------------------------------------------- ;; -;; export EDITOR=emacsclient -;; ;; # The \033 stands for ESC. ;; # There is a space between "AnSiT?" and $whatever. ;; @@ -269,10 +271,11 @@ ;; printf '\033AnSiTh %s\n' "$HOSTNAME" ;; printf '\033AnSiTu %s\n' "$USER" ;; -;; eval $(dircolors $HOME/.emacs_dircolors) +;; # Use custom dircolors in term buffers. +;; # eval $(dircolors $HOME/.emacs_dircolors) ;; esac ;; -;; # ... +;; # ... ;; ;; @@ -2750,12 +2753,10 @@ See `term-prompt-regexp'." (setq default-directory (file-name-as-directory (if (and (string= term-ansi-at-host (system-name)) - (string= term-ansi-at-user (user-real-login-name))) + (string= term-ansi-at-user (user-real-login-name))) (expand-file-name term-ansi-at-dir) - (if (string= term-ansi-at-user (user-real-login-name)) - (concat "/" term-ansi-at-host ":" term-ansi-at-dir) - (concat "/" term-ansi-at-user "@" term-ansi-at-host ":" - term-ansi-at-dir))))) + (concat "/-:" term-ansi-at-user "@" term-ansi-at-host ":" + term-ansi-at-dir)))) ;; I'm not sure this is necessary, ;; but it's best to be on the safe side. commit fb8d2e064dff0dbbe71809b2ee4184fe44805258 Author: Alan Third Date: Thu May 31 21:28:09 2018 +0100 Add NS style text scale keybindings * lisp/term/ns-win.el: Add super-based keybindings for adjusting text zoom. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index eff8adcd3b..8b23cab010 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -141,6 +141,10 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [?\s-x] 'kill-region) (define-key global-map [?\s-y] 'ns-paste-secondary) (define-key global-map [?\s-z] 'undo) +(define-key global-map [?\s-+] 'text-scale-adjust) +(define-key global-map [?\s-=] 'text-scale-adjust) +(define-key global-map [?\s--] 'text-scale-adjust) +(define-key global-map [?\s-0] 'text-scale-adjust) (define-key global-map [?\s-|] 'shell-command-on-region) (define-key global-map [s-kp-bar] 'shell-command-on-region) (define-key global-map [?\C-\s- ] 'ns-do-show-character-palette) commit 16e8541b743a6beb1926fef53cf1bfaed9c346db Author: Eli Zaretskii Date: Sun Jun 3 20:20:52 2018 +0300 Update doc string of 'rx' * lisp/emacs-lisp/rx.el (rx): Update the description of some character classes. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 302ee23db6..30bb129e8f 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -976,12 +976,14 @@ CHAR matches whitespace and graphic characters. `alphanumeric', `alnum' - matches alphabetic characters and digits. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters and digits. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic or decimal number characters. `letter', `alphabetic', `alpha' - matches alphabetic characters. (For multibyte characters, - it matches according to Unicode character properties.) + matches alphabetic characters. For multibyte characters, + it matches characters whose Unicode `general-category' property + indicates they are alphabetic characters. `ascii' matches ASCII (unibyte) characters. @@ -990,10 +992,14 @@ CHAR matches non-ASCII (multibyte) characters. `lower', `lower-case' - matches anything lower-case. + matches anything lower-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + upper-case letter. `upper', `upper-case' - matches anything upper-case. + matches anything upper-case, as determined by the current case + table. If `case-fold-search' is non-nil, this also matches any + lower-case letter. `punctuation', `punct' matches punctuation. (But at present, for multibyte characters, commit 9a14b4d1ce84e5e0739572729670b8f10d234097 Merge: 5fa73a7d98 ed962f2b8a Author: Noam Postavsky Date: Sun Jun 3 12:55:37 2018 -0400 ; Merge: backports from master commit ed962f2b8a2f63c7dbf31ec5df3c915703dd571d Author: Stefan Monnier Date: Fri Mar 23 11:29:06 2018 -0400 Fix bug#30846, along with misc cleanups found along the way * test/src/data-tests.el (data-tests-kill-all-local-variables): New test. * src/buffer.c (swap_out_buffer_local_variables): Remove. Fuse the body of its loop into that of reset_buffer_local_variables. (Fkill_buffer, Fkill_all_local_variables): Don't call it any more. (reset_buffer_local_variables): Make sure the buffer's local binding is swapped out before removing it from the alist (bug#30846). Call watchers before actually killing the var. * src/data.c (Fmake_local_variable): Simplify. Use swap_in_global_binding to swap out any local binding, instead of a mix of find_symbol_value followed by messing with where&found. Don't call swap_in_symval_forwarding since the currently swapped binding is never one we've modified. (Fkill_local_variable): Use swap_in_global_binding rather than messing with where&found to try and trick find_symbol_value into doing the same. * src/alloc.c (mark_localized_symbol): 'where' can't be a frame any more. (cherry picked from commit 3ddff080341580eb6fc18d907181e9cc2301f62d) diff --git a/src/alloc.c b/src/alloc.c index 09d61b7e5f..7baaa512c2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6334,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); diff --git a/src/buffer.c b/src/buffer.c index 9b54e4b778..b0cee71703 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -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. diff --git a/src/data.c b/src/data.c index 45b2bf7302..4bee194e29 100644 --- a/src/data.c +++ b/src/data.c @@ -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; diff --git a/src/lisp.h b/src/lisp.h index cd6d07288e..56ad8b814b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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'. - - `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 + 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 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 diff --git a/test/src/data-tests.el b/test/src/data-tests.el index dda1278b6d..91463db113 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -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 commit 3ba5fc2bbec3f0f64c7afc1b05c9016710805463 Author: Jay Kamat Date: Tue May 8 12:04:00 2018 -0700 esh-opt.el: Fix improper parsing of first argument (Bug#28323) Examples of broken behavior: sudo -u root whoami Outputs: -u ls -I '*.txt' /dev/null Errors with: *.txt: No such file or directory * lisp/eshell/esh-opt.el (eshell--process-args): Refactor usage of args to eshell--args, as we rely on modifications from eshell--process-option and vice versa. These modifications were not being propogated in the (if (= ai 0)) case, since popping the first element of a list doesn't destructively modify the underlying list object. (cherry picked from commit 92a8230e49a65be48442ee95cf50c90514e48f99) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 3af8fd7cac..7d0b362b4c 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -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 commit 0ac98cc6edf45e5acdf5d1bf79764745ec444381 Author: Noam Postavsky Date: Fri Apr 27 07:27:59 2018 -0400 * lisp/epa.el (epa-decrypt-file): Apply epa-pinentry-mode (Bug#30363). (cherry picked from commit 217202c084232f36d4fa0fead0f3aca21396d074) diff --git a/lisp/epa.el b/lisp/epa.el index a84e4f2b85..f2989b314a 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -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) commit 9552485c4d471a02cd3973d4458d8513a81f9c85 Author: Noam Postavsky Date: Sat Apr 14 01:02:25 2018 -0400 Fix cl-print for circular sublists (Bug#31146) * lisp/emacs-lisp/cl-print.el (cl-print-object) : Push each element of list being printed onto cl-print--currently-printing. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle-2): New test. (cherry picked from commit b8aa7ecf54c9b164a59f1b0e9f9fe90531dadd20) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index de41d82671..7c0e81c934 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -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 diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 660d5c8069..d986c4015d 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -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. commit 4c6cdf6fc9ce8a3309948228995b0ea88704c274 Author: Lars Ingebrigtsen Date: Sun Apr 15 19:28:04 2018 +0200 Revert "Make mail-extract-address-components return the user name more" This reverts commit 8b50ae8b2284b5652c2843a9d0d076f4f657be28. According to tests in bug#27656 by OGAWA Hirofumi, this patch led to wrong results when binding (dolist (addr '("Rasmus " "Rasmus ")) (dolist (ignore-single '(t nil)) (dolist (ignore-same '(t nil)) (let ((mail-extr-ignore-single-names ignore-single) (mail-extr-ignore-realname-equals-mailbox-name ignore-same)) (message "%s" (mail-extract-address-components addr)))))) in combination. (cherry picked from commit a3a9d5434d56f8736cc47e379a1d011d4c779b7c) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 1e18c6d055..3e8a41fb24 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -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)) commit 51ee8bc4483d3608f4355777aeabbb31887326d9 Author: Paul Eggert Date: Fri Mar 30 14:23:55 2018 -0700 Centralize Bug#30931 fix * src/marker.c (detach_marker): New function. * src/editfns.c (save_restriction_restore): * src/insdel.c (signal_before_change): Use it. (cherry picked from commit 6f66a43d7ad6cada2b7dbb6d07efe36be1dc7ecb) diff --git a/src/editfns.c b/src/editfns.c index 1fcfc7aef6..b553a213e6 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3876,12 +3876,9 @@ save_restriction_restore (Lisp_Object data) buf->clip_changed = 1; /* Remember that the narrowing changed. */ } - /* This isn’t needed anymore, so don’t wait for GC. Do not call - free_marker on XCAR (data) or XCDR (data), though, since - record_marker_adjustments may have put them on the buffer’s - undo list (Bug#30931). Just detach them instead. */ - Fset_marker (XCAR (data), Qnil, Qnil); - Fset_marker (XCDR (data), Qnil, Qnil); + /* 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 diff --git a/src/insdel.c b/src/insdel.c index 697395c507..173c243834 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2148,13 +2148,10 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, FETCH_START, FETCH_END, Qnil); } - /* Detach the markers now that we're done with them. Don't directly - free them, since the change functions could have caused them to - be inserted into the undo list (Bug#30931). */ if (! NILP (start_marker)) - Fset_marker (start_marker, Qnil, Qnil); + detach_marker (start_marker); if (! NILP (end_marker)) - Fset_marker (end_marker, Qnil, Qnil); + detach_marker (end_marker); RESTORE_VALUE; unbind_to (count, Qnil); diff --git a/src/lisp.h b/src/lisp.h index 9320345bff..cd6d07288e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4018,7 +4018,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, diff --git a/src/marker.c b/src/marker.c index 7773c4fce0..432fdd4cbf 100644 --- a/src/marker.c +++ b/src/marker.c @@ -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 commit daa602338fd91aced720b5555c8b6ed389383831 Author: Noam Postavsky Date: Fri Mar 30 16:44:24 2018 -0400 Fix another case of freed markers in the undo-list (Bug#30931) * src/alloc.c (free_marker): Remove. * src/editfns.c (save_restriction_restore): * src/insdel.c (signal_before_change): Detach the markers from the buffer when we're done with them instead of calling free_marker on them. * test/src/editfns-tests.el (delete-region-undo-markers-1) (delete-region-undo-markers-2): New tests. (cherry picked from commit 96b8747d5c5d747af13fd84d8fe0308ef2a0ea7a) diff --git a/src/alloc.c b/src/alloc.c index c3f7920ed8..09d61b7e5f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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 diff --git a/src/editfns.c b/src/editfns.c index 3fc08f9d20..1fcfc7aef6 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3876,10 +3876,12 @@ save_restriction_restore (Lisp_Object data) buf->clip_changed = 1; /* Remember that the narrowing changed. */ } - /* This isn’t needed anymore, so don’t wait for GC. - Do not call free_marker on XCAR (data) or XCDR (data), - though, since record_marker_adjustments may have put - them on the buffer’s undo list (Bug#30931). */ + /* This isn’t needed anymore, so don’t wait for GC. Do not call + free_marker on XCAR (data) or XCDR (data), though, since + record_marker_adjustments may have put them on the buffer’s + undo list (Bug#30931). Just detach them instead. */ + Fset_marker (XCAR (data), Qnil, Qnil); + Fset_marker (XCDR (data), Qnil, Qnil); free_cons (XCONS (data)); } else diff --git a/src/insdel.c b/src/insdel.c index 02e3f41bc9..697395c507 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2148,10 +2148,13 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, FETCH_START, FETCH_END, Qnil); } + /* Detach the markers now that we're done with them. Don't directly + free them, since the change functions could have caused them to + be inserted into the undo list (Bug#30931). */ if (! NILP (start_marker)) - free_marker (start_marker); + Fset_marker (start_marker, Qnil, Qnil); if (! NILP (end_marker)) - free_marker (end_marker); + Fset_marker (end_marker, Qnil, Qnil); RESTORE_VALUE; unbind_to (count, Qnil); diff --git a/src/lisp.h b/src/lisp.h index a8963b7f3c..9320345bff 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3728,7 +3728,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); diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index b72f37d1f0..714e92e505 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -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) (# . -1) (# . 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) (# . -1) + ;; (# . -1) (# . -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 commit 7460840a6c9ab713e8ccc470011495fdb86a61d7 Author: Paul Eggert Date: Thu Mar 29 23:00:23 2018 -0700 Fix CHECK_ALLOCATED_AND_LIVE abort during GC * src/editfns.c (save_restriction_restore): Wait for the GC to free the temporary markers (Bug#30931). (cherry picked from commit 670f2ffae718046c0fb37313965a51c040ed096f) diff --git a/src/editfns.c b/src/editfns.c index d0ccdbddc2..3fc08f9d20 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3876,9 +3876,10 @@ 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)); + /* This isn’t needed anymore, so don’t wait for GC. + Do not call free_marker on XCAR (data) or XCDR (data), + though, since record_marker_adjustments may have put + them on the buffer’s undo list (Bug#30931). */ free_cons (XCONS (data)); } else commit 71192e0b7eabadf2eb1fdd7f11cb391bbc34c560 Author: Noam Postavsky Date: Thu Mar 29 19:11:47 2018 -0400 Don't wait for visible frames to become visible For discussion, see thread starting at https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00807.html. * src/xterm.c (x_make_frame_visible): Check FRAME_VISIBLE_P before calling x_wait_for_event. (cherry picked from commits 2a192e21cf3b04b7f830b4971c1508c611e13a3c and 00c1f771f2a51ffa675ec5a07ea330f2605cd302) diff --git a/src/xterm.c b/src/xterm.c index f6f2079ec6..496effaf42 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -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); } } commit 5fa73a7d98040f749f4cd45cfa40cf3c1c8cc2e3 Author: Tino Calancha Date: Sun Jun 3 23:28:30 2018 +0900 query-replace undo: Handle when user edits the replacement string * lisp/replace.el (perform-replace): Update the replacement string after the user edit it (Fix Bug#31538). * test/lisp/replace-tests.el (query-replace-undo-bug31538): New test. Backport: (cherry picked from commits ea133e04f49afa7928e49a3ac4a85b47f6f13f01 and 7dcfdf5b14325ae7996f272f14c72810d7c84944) diff --git a/lisp/replace.el b/lisp/replace.el index 88da7e26cb..940bf56650 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2721,7 +2721,8 @@ It must return a string." (replace-match-maybe-edit next-replacement nocasify literal noedit real-match-data backward) - replaced t)) + replaced t) + (setq next-replacement-replaced next-replacement)) (setq done t)) ((eq def 'delete-and-edit) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 40ee838e67..3fcdce6704 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(eval-when-compile (require 'subr-x)) (ert-deftest query-replace--split-string-tests () (let ((sep (propertize "\0" 'separator t))) @@ -358,23 +359,71 @@ Each element has the format: (dotimes (i (length replace-occur-tests)) (replace-occur-test-create i)) + +;;; Tests for `query-replace' undo feature. + +(defvar replace-tests-bind-read-string nil + "A string to bind `read-string' and avoid the prompt.") + +(defmacro replace-tests-with-undo (input from to char-nums def-chr &rest body) + "Helper to test `query-replace' undo feature. +INPUT is a string to insert in a temporary buffer. +FROM is the string to match and replace. +TO is the replacement string. +CHAR-NUMS is a list of elements (CHAR . NUMS), where CHAR is +one of the characters `,', `?\\s', `u', `U', `E' or `q' +and NUMS a list of integers. +DEF-CHAR is the character `?\\s' or `q'. +BODY is a list of forms to evaluate. + +Use CHAR-NUMS and DEF-CHAR to temporary bind the function value of +`read-event', thus avoiding the prompt. +For instance, if CHAR-NUMS is the lists ((?\\s . (1 2 3)) (?u . (4))), +then replace 3 matches of FROM with TO, and undo the last replacement. + +Return the last evalled form in BODY." + (declare (indent 5) (debug (stringp stringp stringp form characterp body))) + (let ((text (gensym "text")) + (count (gensym "count"))) + `(let* ((,text ,input) + (,count 0) + (inhibit-message t)) + (with-temp-buffer + (insert ,text) + (goto-char 1) + ;; Bind `read-event' to simulate user input. + ;; If `replace-tests-bind-read-string' is non-nil, then + ;; bind `read-string' as well. + (cl-letf (((symbol-function 'read-event) + (lambda (&rest args) + (cl-incf ,count) + (pcase ,count ; Build the clauses from CHAR-NUMS + ,@(append + (delq nil + (mapcar + (lambda (chr) + (when-let (it (alist-get chr char-nums)) + (if (cdr it) + `(,(cons 'or it) ,chr) + `(,(car it) ,chr)))) + '(?, ?\s ?u ?U ?E ?q))) + `((_ ,def-chr)))))) + ((symbol-function 'read-string) + (if replace-tests-bind-read-string + (lambda (&rest args) replace-tests-bind-read-string) + (symbol-function 'read-string)))) + (perform-replace ,from ,to t t nil)) + ,@body)))) + (defun replace-tests--query-replace-undo (&optional comma) - (with-temp-buffer - (insert "111") - (goto-char 1) - (let ((count 0)) - ;; Don't wait for user input. - (cl-letf (((symbol-function 'read-event) - (lambda (&rest args) - (cl-incf count) - (let ((val (pcase count - ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next - ('3 ?u) ; undo - ('4 ?q) ; exit - (_ ?\s)))) ; replace current and go next - val)))) - (perform-replace "1" "2" t nil nil))) - (buffer-string))) + (let ((input "111")) + (if comma + (should + (replace-tests-with-undo + input "1" "2" ((?, . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string))) + (should + (replace-tests-with-undo + input "1" "2" ((?\s . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string)))))) (ert-deftest query-replace--undo () (should (string= "211" (replace-tests--query-replace-undo))) @@ -382,42 +431,28 @@ Each element has the format: (ert-deftest query-replace-undo-bug31073 () "Test for https://debbugs.gnu.org/31073 ." - (let ((text "aaa aaa") - (count 0)) - (with-temp-buffer - (insert text) - (goto-char 1) - (cl-letf (((symbol-function 'read-event) - (lambda (&rest args) - (cl-incf count) - (let ((val (pcase count - ((or 1 2 3) ?\s) ; replace current and go next - (4 ?U) ; undo-all - (_ ?q)))) ; exit - val)))) - (perform-replace "a" "B" t nil nil)) - ;; After undo text must be the same. - (should (string= text (buffer-string)))))) + (let ((input "aaa aaa")) + (should + (replace-tests-with-undo + input "a" "B" ((?\s . (1 2 3)) (?U . (4))) ?q + (string= input (buffer-string)))))) (ert-deftest query-replace-undo-bug31492 () "Test for https://debbugs.gnu.org/31492 ." - (let ((text "a\nb\nc\n") - (count 0) - (inhibit-message t)) - (with-temp-buffer - (insert text) - (goto-char 1) - (cl-letf (((symbol-function 'read-event) - (lambda (&rest args) - (cl-incf count) - (let ((val (pcase count - ((or 1 2) ?\s) ; replace current and go next - (3 ?U) ; undo-all - (_ ?q)))) ; exit - val)))) - (perform-replace "^\\|\b\\|$" "foo" t t nil)) - ;; After undo text must be the same. - (should (string= text (buffer-string)))))) + (let ((input "a\nb\nc\n")) + (should + (replace-tests-with-undo + input "^\\|\b\\|$" "foo" ((?\s . (1 2)) (?U . (3))) ?q + (string= input (buffer-string)))))) + +(ert-deftest query-replace-undo-bug31538 () + "Test for https://debbugs.gnu.org/31538 ." + (let ((input "aaa aaa") + (replace-tests-bind-read-string "Bfoo")) + (should + (replace-tests-with-undo + input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q + (string= input (buffer-string)))))) ;;; replace-tests.el ends here commit 031004e81b1507c4594ae253faaafcda31f253c8 Author: Tino Calancha Date: Sun Jun 3 23:28:24 2018 +0900 Backport: Fix corner case in query-replace-regexp undo This commit fixes Bug#31492. * lisp/replace.el (replace-match-maybe-edit): Preserve match data. * test/lisp/replace-tests.el (query-replace-undo-bug31492): Add test. (cherry picked from commit bab73230d1be1fe394b7269c1365ef6fb1a5d9b3) diff --git a/lisp/replace.el b/lisp/replace.el index d1eabb035d..88da7e26cb 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2147,6 +2147,10 @@ passed in. If LITERAL is set, no checking is done, anyway." noedit nil))) (set-match-data match-data) (replace-match newtext fixedcase literal) + ;; `query-replace' undo feature needs the beginning of the match position, + ;; but `replace-match' may change it, for instance, with a regexp like "^". + ;; Ensure that this function preserves the match data (Bug#31492). + (set-match-data match-data) ;; `replace-match' leaves point at the end of the replacement text, ;; so move point to the beginning when replacing backward. (when backward (goto-char (nth 0 match-data))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 40a1a31cf7..40ee838e67 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -399,5 +399,25 @@ Each element has the format: ;; After undo text must be the same. (should (string= text (buffer-string)))))) +(ert-deftest query-replace-undo-bug31492 () + "Test for https://debbugs.gnu.org/31492 ." + (let ((text "a\nb\nc\n") + (count 0) + (inhibit-message t)) + (with-temp-buffer + (insert text) + (goto-char 1) + (cl-letf (((symbol-function 'read-event) + (lambda (&rest args) + (cl-incf count) + (let ((val (pcase count + ((or 1 2) ?\s) ; replace current and go next + (3 ?U) ; undo-all + (_ ?q)))) ; exit + val)))) + (perform-replace "^\\|\b\\|$" "foo" t t nil)) + ;; After undo text must be the same. + (should (string= text (buffer-string)))))) + ;;; replace-tests.el ends here commit 50c0624b2aecb9668505eb2cea3f30aecbf6d1ec Author: Tino Calancha Date: Sun Jun 3 23:28:14 2018 +0900 Backport: Preserve case in query-replace undo If the user query and replaces 'foo' with 'BAR', then undo must comeback to 'foo', not to 'FOO' (Bug#31073). * lisp/replace.el (perform-replace): Bind nocasify to non-nil value during undo/undo-all actions. * test/lisp/replace-tests.el (query-replace-undo-bug31073): Add test. (cherry picked from commit 32dc0cb1b5ae895d237c7118ccaeb084715934fd) diff --git a/lisp/replace.el b/lisp/replace.el index 6cee225374..d1eabb035d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2576,6 +2576,7 @@ It must return a string." (let ((stack-idx 0) (stack-len (length stack)) (num-replacements 0) + (nocasify t) ; Undo must preserve case (Bug#31073). search-string next-replacement) (while (and (< stack-idx stack-len) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 66c6842660..40a1a31cf7 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -380,4 +380,24 @@ Each element has the format: (should (string= "211" (replace-tests--query-replace-undo))) (should (string= "211" (replace-tests--query-replace-undo 'comma)))) +(ert-deftest query-replace-undo-bug31073 () + "Test for https://debbugs.gnu.org/31073 ." + (let ((text "aaa aaa") + (count 0)) + (with-temp-buffer + (insert text) + (goto-char 1) + (cl-letf (((symbol-function 'read-event) + (lambda (&rest args) + (cl-incf count) + (let ((val (pcase count + ((or 1 2 3) ?\s) ; replace current and go next + (4 ?U) ; undo-all + (_ ?q)))) ; exit + val)))) + (perform-replace "a" "B" t nil nil)) + ;; After undo text must be the same. + (should (string= text (buffer-string)))))) + + ;;; replace-tests.el ends here commit e75c57f10ee9418599398361b0676f48d265fb12 Author: Michael Albinus Date: Sun Jun 3 14:30:41 2018 +0200 Extend file-name-non-special * lisp/files.el (insert-file-contents-literally): Bind `inhibit-file-name-handlers' the default way. (file-name-non-special): Rework, mainly for operations with two file name arguments. (file-name-unquote-non-special): New defsubst. (file-name-unquote): Use it. * test/lisp/files-tests.el (files-test-bug-18141): Skip if needed. (files-tests--with-temp-non-special): Add docstring. Delete also `non-special-name' if the file/directory exists. (files-tests--special-file-name-extension) (files-tests--special-file-name-regexp): New defconst. (files-tests--special-file-name-handler, files-tests--new-name): New defuns. (files-tests--with-temp-non-special-and-file-name-handler): New macro. (files-tests-file-name-non-special-access-file) (files-tests-file-name-non-special-add-name-to-file) (files-tests-file-name-non-special-byte-compiler-base-file-name) (files-tests-file-name-non-special-copy-directory) (files-tests-file-name-non-special-copy-file) (files-tests-file-name-non-special-delete-directory) (files-tests-file-name-non-special-delete-file) (files-tests-file-name-non-special-diff-latest-backup-file) (files-tests-file-name-non-special-directory-file-name) (files-tests-file-name-non-special-directory-files) (files-tests-file-name-non-special-directory-files-and-attributes) (files-tests-file-name-non-special-dired-compress-handler) (files-tests-file-name-non-special-dired-uncache) (files-tests-file-name-non-special-expand-file-name) (files-tests-file-name-non-special-file-accessible-directory-p) (files-tests-file-name-non-special-file-acl) (files-tests-file-name-non-special-file-attributes) (files-tests-file-name-non-special-file-directory-p) (files-tests-file-name-non-special-file-equal-p) (files-tests-file-name-non-special-file-executable-p) (files-tests-file-name-non-special-file-exists-p) (files-tests-file-name-non-special-file-in-directory-p) (files-tests-file-name-non-special-file-local-copy) (files-tests-file-name-non-special-file-modes) (files-tests-file-name-non-special-file-name-all-completions) (files-tests-file-name-non-special-file-name-as-directory) (files-tests-file-name-non-special-file-name-case-insensitive-p) (files-tests-file-name-non-special-file-name-completion) (files-tests-file-name-non-special-file-name-directory) (files-tests-file-name-non-special-file-name-nondirectory) (files-tests-file-name-non-special-file-name-sans-versions) (files-tests-file-name-non-special-file-newer-than-file-p) (files-tests-file-name-non-special-notify-handlers) (files-tests-file-name-non-special-file-ownership-preserved-p) (files-tests-file-name-non-special-file-readable-p) (files-tests-file-name-non-special-file-regular-p) (files-tests-file-name-non-special-file-remote-p) (files-tests-file-name-non-special-file-selinux-context) (files-tests-file-name-non-special-file-symlink-p) (files-tests-file-name-non-special-file-truename) (files-tests-file-name-non-special-file-writable-p) (files-tests-file-name-non-special-find-backup-file-name) (files-tests-file-name-non-special-get-file-buffer) (files-tests-file-name-non-special-insert-directory) (files-tests-file-name-non-special-insert-file-contents) (files-tests-file-name-non-special-load) (files-tests-file-name-non-special-make-auto-save-file-name) (files-tests-file-name-non-special-make-directory) (files-tests-file-name-non-special-make-directory-internal) (files-tests-file-name-non-special-make-symbolic-link) (files-tests-file-name-non-special-rename-file) (files-tests-file-name-non-special-set-file-acl) (files-tests-file-name-non-special-set-file-modes) (files-tests-file-name-non-special-set-file-selinux-context) (files-tests-file-name-non-special-set-file-times) (files-tests-file-name-non-special-set-visited-file-modtime) (files-tests-file-name-non-special-shell-command) (files-tests-file-name-non-special-start-file-process) (files-tests-file-name-non-special-substitute-in-file-name) (files-tests-file-name-non-special-temporary-file-directory) (files-tests-file-name-non-special-unhandled-file-name-directory) (files-tests-file-name-non-special-vc-registered) (files-tests-file-name-non-special-write-region): Extends tests to quoted file names, which would require a file name handler if unquoted. (files-test-no-file-write-contents): Make test more robust. * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Adapt test. (tramp--test-emacs25-p): New defun. (tramp-test34-vc-registered): Use it. diff --git a/lisp/files.el b/lisp/files.el index d98d09bb1e..68423f87bb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2309,7 +2309,8 @@ This function ensures that none of these modifications will take place." ;; FIXME: Yuck!! We should turn insert-file-contents-literally ;; into a file operation instead! (append '(jka-compr-handler image-file-handler epa-file-handler) - inhibit-file-name-handlers)) + (and (eq inhibit-file-name-operation 'insert-file-contents) + inhibit-file-name-handlers))) (inhibit-file-name-operation 'insert-file-contents)) (insert-file-contents filename visit beg end replace))) @@ -6992,99 +6993,100 @@ only these files will be asked to be saved." ;; operations, which return a file name. See Bug#29579. (defun file-name-non-special (operation &rest arguments) - (let* ((op-returns-file-name-list - '(expand-file-name file-name-directory file-name-as-directory - directory-file-name file-name-sans-versions - find-backup-file-name file-remote-p)) - (file-name-handler-alist - (and - (not (memq operation op-returns-file-name-list)) - file-name-handler-alist)) - (default-directory - ;; Some operations respect file name handlers in - ;; `default-directory'. Because core function like - ;; `call-process' don't care about file name handlers in - ;; `default-directory', we here have to resolve the - ;; directory into a local one. For `process-file', - ;; `start-file-process', and `shell-command', this fixes - ;; Bug#25949. - (if (memq operation - '(insert-directory process-file start-file-process - shell-command temporary-file-directory)) - (directory-file-name - (expand-file-name - (unhandled-file-name-directory default-directory))) - default-directory)) - ;; Get a list of the indices of the args which are file names. - (file-arg-indices - (cdr (or (assq operation - ;; The first seven are special because they - ;; return a file name. We want to include the /: - ;; in the return value. - ;; So just avoid stripping it in the first place. - (append - (mapcar 'list op-returns-file-name-list) - '(;; `identity' means just return the first arg - ;; not stripped of its quoting. - (substitute-in-file-name identity) - ;; `add' means add "/:" to the result. - (file-truename add 0) - (insert-file-contents insert-file-contents 0) - ;; `unquote-then-quote' means set buffer-file-name - ;; temporarily to unquoted filename. - (verify-visited-file-modtime unquote-then-quote) - ;; List the arguments which are filenames. - (file-name-completion 0 1) - (file-name-all-completions 0 1) - (file-equal-p 0 1) - (file-newer-than-file-p 0 1) - (write-region 2 5) - (rename-file 0 1) - (copy-file 0 1) - (copy-directory 0 1) - (file-in-directory-p 0 1) - (make-symbolic-link 0 1) - (add-name-to-file 0 1) - (make-auto-save-file-name buffer-file-name) - (set-visited-file-modtime buffer-file-name) - ;; These file-notify-* operations take a - ;; descriptor. - (file-notify-rm-watch . nil) - (file-notify-valid-p . nil)))) - ;; For all other operations, treat the first argument only - ;; as the file name. - '(nil 0)))) - method - ;; Copy ARGUMENTS so we can replace elements in it. - (arguments (copy-sequence arguments))) + (let (;; In general, we don't want any file name handler. For some + ;; few cases, operations with two file name arguments which + ;; might be bound to different file name handlers, we still + ;; need this. + (saved-file-name-handler-alist file-name-handler-alist) + file-name-handler-alist + ;; Some operations respect file name handlers in + ;; `default-directory'. Because core function like + ;; `call-process' don't care about file name handlers in + ;; `default-directory', we here have to resolve the directory + ;; into a local one. For `process-file', + ;; `start-file-process', and `shell-command', this fixes + ;; Bug#25949. + (default-directory + (if (memq operation + '(insert-directory process-file start-file-process + shell-command temporary-file-directory)) + (directory-file-name + (expand-file-name + (unhandled-file-name-directory default-directory))) + default-directory)) + ;; Get a list of the indices of the args which are file names. + (file-arg-indices + (cdr (or (assq operation + '(;; The first seven are special because they + ;; return a file name. We want to include + ;; the /: in the return value. So just + ;; avoid stripping it in the first place. + (directory-file-name) + (expand-file-name) + (file-name-as-directory) + (file-name-directory) + (file-name-sans-versions) + (file-remote-p) + (find-backup-file-name) + ;; `identity' means just return the first + ;; arg not stripped of its quoting. + (substitute-in-file-name identity) + ;; `add' means add "/:" to the result. + (file-truename add 0) + ;;`insert-file-contents' needs special handling. + (insert-file-contents insert-file-contents 0) + ;; `unquote-then-quote' means set buffer-file-name + ;; temporarily to unquoted filename. + (verify-visited-file-modtime unquote-then-quote) + ;; Unquote `buffer-file-name' temporarily. + (make-auto-save-file-name buffer-file-name) + (set-visited-file-modtime buffer-file-name) + ;; Use a temporary local copy. + (copy-file local-copy) + (rename-file local-copy) + ;;`copy-directory' needs special handling. + (copy-directory copy-directory) + ;; List the arguments which are filenames. + (file-name-completion 0 1) + (file-name-all-completions 0 1) + (file-equal-p 0 1) + (file-newer-than-file-p 0 1) + (write-region 2 5) + (file-in-directory-p 0 1) + (make-symbolic-link 0 1) + (add-name-to-file 0 1) + ;; These file-notify-* operations take a + ;; descriptor. + (file-notify-rm-watch) + (file-notify-valid-p))) + ;; For all other operations, treat the first + ;; argument only as the file name. + '(nil 0)))) + method + ;; Copy ARGUMENTS so we can replace elements in it. + (arguments (copy-sequence arguments))) (if (symbolp (car file-arg-indices)) (setq method (pop file-arg-indices))) ;; Strip off the /: from the file names that have it. (save-match-data (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) - (and (car pair) - (string-match "\\`/:" (car pair)) - (setcar pair - (if (= (length (car pair)) 2) - "/" - (substring (car pair) 2))))) + (when (car pair) + (setcar pair (file-name-unquote-non-special (car pair))))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) (`add (file-name-quote (apply operation arguments))) (`buffer-file-name (let ((buffer-file-name - (if (string-match "\\`/:" buffer-file-name) - (substring buffer-file-name (match-end 0)) - buffer-file-name))) + (file-name-unquote-non-special buffer-file-name))) (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect (apply operation arguments) (when (and visit buffer-file-name) - (setq buffer-file-name (concat "/:" buffer-file-name)))))) + (setq buffer-file-name (file-name-quote buffer-file-name)))))) (`unquote-then-quote ;; We can't use `cl-letf' with `(buffer-local-value)' here ;; because it wouldn't work during bootstrapping. @@ -7093,11 +7095,44 @@ only these files will be asked to be saved." ;; `verify-visited-file-modtime' action, which takes a buffer ;; as only optional argument. (with-current-buffer (or (car arguments) buffer) - (let ((buffer-file-name (substring buffer-file-name 2))) + (let ((buffer-file-name + (file-name-unquote-non-special buffer-file-name))) ;; Make sure to hide the temporary buffer change from the ;; underlying operation. (with-current-buffer buffer (apply operation arguments)))))) + (`local-copy + (let* ((file-name-handler-alist saved-file-name-handler-alist) + (source (car arguments)) + (target (car (cdr arguments))) + (tmpfile (file-local-copy source))) + (let ((handler (find-file-name-handler target 'copy-file))) + (unless (and handler (not (eq handler 'file-name-non-special))) + (setq target (file-name-unquote-non-special target)))) + (setcar arguments (or tmpfile (file-name-unquote-non-special source))) + (setcar (cdr arguments) target) + (apply operation arguments) + (when (and tmpfile (file-exists-p tmpfile)) (delete-file tmpfile)))) + (`copy-directory + (let* ((file-name-handler-alist saved-file-name-handler-alist) + (source (car arguments)) + (target (car (cdr arguments))) + tmpdir) + (let ((handler (find-file-name-handler source 'copy-directory))) + (if (and handler (not (eq handler 'file-name-non-special))) + (progn + (setq tmpdir (make-temp-name temporary-file-directory)) + (setcar (cdr arguments) tmpdir) + (apply operation arguments) + (setq source tmpdir)) + (setq source (file-name-unquote-non-special source)))) + (let ((handler (find-file-name-handler target 'copy-directory))) + (unless (and handler (not (eq handler 'file-name-non-special))) + (setq target (file-name-unquote-non-special target)))) + (setcar arguments source) + (setcar (cdr arguments) target) + (apply operation arguments) + (when tmpdir (delete-directory tmpdir 'recursive)))) (_ (apply operation arguments))))) @@ -7114,14 +7149,18 @@ If NAME is already a quoted file name, NAME is returned unchanged." name (concat (file-remote-p name) "/:" (file-local-name name)))) +(defsubst file-name-unquote-non-special (name) + "Remove quotation prefix \"/:\" from file NAME, if any." + (let (file-name-handler-alist) + (if (file-name-quoted-p name) + (if (= (length name) 2) "/" (substring name 2)) + name))) + (defsubst file-name-unquote (name) "Remove quotation prefix \"/:\" from file NAME, if any. If NAME is a remote file name, the local part of NAME is unquoted." - (let ((localname (file-local-name name))) - (when (file-name-quoted-p localname) - (setq - localname (if (= (length localname) 2) "/" (substring localname 2)))) - (concat (file-remote-p name) localname))) + (concat + (file-remote-p name) (file-name-unquote-non-special (file-local-name name)))) ;; Symbolic modes and read-file-modes. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 1e6cd5eaba..30a09c796e 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -157,6 +157,9 @@ form.") (ert-deftest files-test-bug-18141 () "Test for https://debbugs.gnu.org/18141 ." (skip-unless (executable-find "gzip")) + ;; If called interactively, environment variable + ;; $EMACS_TEST_DIRECTORY does not exist. + (skip-unless (file-exists-p files-test-bug-18141-file)) (let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz"))) (unwind-protect (progn @@ -348,6 +351,12 @@ be invoked with the right arguments." (cl-defmacro files-tests--with-temp-non-special ((name non-special-name &optional dir-flag) &rest body) + "Run tests with quoted file name. +NAME is the symbol which contains the name of a created temporary +file. NON-SPECIAL-NAME is another symbol, which contains the +temporary file name with quoted file name syntax. If DIR-FLAG is +non-nil, a temporary directory is created instead. +After evaluating BODY, the temporary file or directory is deleted." (declare (indent 1) (debug ((symbolp symbolp &optional form) body))) (cl-check-type name symbol) (cl-check-type non-special-name symbol) @@ -358,64 +367,183 @@ be invoked with the right arguments." (progn ,@body) (when (file-exists-p ,name) (if ,dir-flag (delete-directory ,name t) - (delete-file ,name)))))) + (delete-file ,name))) + (when (file-exists-p ,non-special-name) + (if ,dir-flag (delete-directory ,non-special-name t) + (delete-file ,non-special-name)))))) + +(defconst files-tests--special-file-name-extension ".special" + "Trailing string for test file name handler.") + +(defconst files-tests--special-file-name-regexp + (concat (regexp-quote files-tests--special-file-name-extension) "\\'") + "Regular expression for test file name handler.") + +(defun files-tests--special-file-name-handler (operation &rest args) + "File name handler for files with extension \".special\"." + (let ((arg args) + ;; Avoid cyclic call. + (file-name-handler-alist + (delete + (rassoc + 'files-tests--special-file-name-handler file-name-handler-alist) + file-name-handler-alist))) + ;; Remove trailing "\\.special\\'" from arguments, if they are not quoted. + (while arg + (when (and (stringp (car arg)) + (not (file-name-quoted-p (car arg))) + (string-match files-tests--special-file-name-regexp (car arg))) + (setcar arg (replace-match "" nil nil (car arg)))) + (setq arg (cdr arg))) + ;; Call it. + (apply operation args))) + +(cl-defmacro files-tests--with-temp-non-special-and-file-name-handler + ((name non-special-name &optional dir-flag) &rest body) + "Run tests with quoted file name, see `files-tests--with-temp-non-special'. +Both file names in NAME and NON-SPECIAL-NAME have the extension +\".special\". The created temporary file or directory does not have +that extension. +A file name handler is added which is activated for files with +that extension. It simply removes the extension from file names. +It is expected, that this file name handler works only for +unquoted file names." + (declare (indent 1) (debug ((symbolp symbolp &optional form) body))) + (cl-check-type name symbol) + (cl-check-type non-special-name symbol) + `(let* ((temporary-file-directory (file-truename temporary-file-directory)) + (file-name-handler-alist + `((,files-tests--special-file-name-regexp + . files-tests--special-file-name-handler) + . ,file-name-handler-alist)) + (,name (concat + (make-temp-file "files-tests" ,dir-flag) + files-tests--special-file-name-extension)) + (,non-special-name (file-name-quote ,name))) + (unwind-protect + (progn ,@body) + (when (file-exists-p ,name) + (if ,dir-flag (delete-directory ,name t) + (delete-file ,name))) + (when (file-exists-p ,non-special-name) + (if ,dir-flag (delete-directory ,non-special-name t) + (delete-file ,non-special-name)))))) + +(defun files-tests--new-name (name part) + (let (file-name-handler-alist) + (concat (file-name-sans-extension name) part (file-name-extension name t)))) (ert-deftest files-tests-file-name-non-special-access-file () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (null (access-file nospecial "test"))))) + ;; Both versions of the file name work. + (should-not (access-file tmpfile "test")) + (should-not (access-file nospecial "test"))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (access-file tmpfile "test")) + ;; The quoted file name does not work. + (should-error (access-file nospecial "test")))) (ert-deftest files-tests-file-name-non-special-add-name-to-file () (files-tests--with-temp-non-special (tmpfile nospecial) - (let ((newname (concat nospecial "add-name"))) + (let ((newname (files-tests--new-name nospecial "add-name"))) + ;; Both versions work. + (add-name-to-file tmpfile newname) + (should (file-exists-p newname)) + (delete-file newname) (add-name-to-file nospecial newname) (should (file-exists-p newname)) - (delete-file newname)))) + (delete-file newname))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let ((newname (files-tests--new-name tmpfile "add-name"))) + ;; Using an unquoted file name works. + (add-name-to-file tmpfile newname) + (should (file-exists-p newname)) + (delete-file newname)) + (let ((newname (files-tests--new-name nospecial "add-name"))) + (add-name-to-file tmpfile newname) + (should (file-exists-p newname)) + (delete-file newname) + ;; The quoted special file name does not work. + (should-error (add-name-to-file nospecial newname))))) (ert-deftest files-tests-file-name-non-special-byte-compiler-base-file-name () (files-tests--with-temp-non-special (tmpfile nospecial) (should (equal (byte-compiler-base-file-name nospecial) - (byte-compiler-base-file-name tmpfile))))) + (byte-compiler-base-file-name tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should (equal (byte-compiler-base-file-name nospecial) tmpfile)) + (should-not (equal (byte-compiler-base-file-name tmpfile) tmpfile)))) (ert-deftest files-tests-file-name-non-special-copy-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) - (let ((newname (concat (directory-file-name nospecial-dir) - "copy-dir"))) + (let ((newname (files-tests--new-name + (directory-file-name nospecial-dir) "copy-dir"))) (copy-directory nospecial-dir newname) (should (file-directory-p newname)) (delete-directory newname) - (should-not (file-directory-p newname))))) + (should-not (file-directory-p newname)))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (let ((newname (files-tests--new-name + (directory-file-name nospecial-dir) "copy-dir"))) + (should-error (copy-directory nospecial-dir newname)) + (delete-directory newname)))) (ert-deftest files-tests-file-name-non-special-copy-file () (files-tests--with-temp-non-special (tmpfile nospecial) - (let ((newname (concat (directory-file-name nospecial) - "copy-file"))) + (let ((newname + (files-tests--new-name (directory-file-name nospecial) "copy-file"))) (copy-file nospecial newname) (should (file-exists-p newname)) (delete-file newname) - (should-not (file-exists-p newname))))) + (should-not (file-exists-p newname)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let ((newname + (files-tests--new-name (directory-file-name nospecial) "copy-file"))) + (should-error (copy-file nospecial newname))))) (ert-deftest files-tests-file-name-non-special-delete-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) - (delete-directory nospecial-dir))) + (delete-directory nospecial-dir)) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-error (delete-directory nospecial-dir)))) (ert-deftest files-tests-file-name-non-special-delete-file () (files-tests--with-temp-non-special (tmpfile nospecial) - (delete-file nospecial))) + (delete-file nospecial)) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (delete-file nospecial) + (should (file-exists-p tmpfile)))) (ert-deftest files-tests-file-name-non-special-diff-latest-backup-file () (files-tests--with-temp-non-special (tmpfile nospecial) + (write-region "foo" nil (make-backup-file-name tmpfile)) (should (equal (diff-latest-backup-file nospecial) - (diff-latest-backup-file tmpfile))))) + (diff-latest-backup-file tmpfile))) + (delete-file (diff-latest-backup-file nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (write-region "foo" nil (make-backup-file-name tmpfile)) + (should-not (equal (diff-latest-backup-file nospecial) + (diff-latest-backup-file tmpfile))) + (delete-file (diff-latest-backup-file nospecial)))) (ert-deftest files-tests-file-name-non-special-directory-file-name () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (should (equal (directory-file-name nospecial-dir) - (file-name-quote (directory-file-name tmpdir)))))) + (file-name-quote (directory-file-name tmpdir))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-not (equal (directory-file-name nospecial-dir) + (file-name-quote (directory-file-name tmpdir)))))) (ert-deftest files-tests-file-name-non-special-directory-files () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (should (equal (directory-files nospecial-dir) - (directory-files tmpdir))))) + (directory-files tmpdir)))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-error (directory-files nospecial-dir)))) (defun files-tests-file-attributes-equal (attr1 attr2) ;; Element 4 is access time, which may be changed by the act of @@ -433,7 +561,10 @@ be invoked with the right arguments." for (file2 . attr2) in (directory-files-and-attributes tmpdir) do (should (equal file1 file2)) - (should (files-tests-file-attributes-equal attr1 attr2))))) + (should (files-tests-file-attributes-equal attr1 attr2)))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-error (directory-files-and-attributes nospecial-dir)))) (ert-deftest files-tests-file-name-non-special-dired-compress-handler () ;; `dired-compress-file' can get confused by filenames with ":" in @@ -444,49 +575,86 @@ be invoked with the right arguments." (let ((compressed (dired-compress-file nospecial))) (when compressed ;; FIXME: Should it return a still-quoted name? - (should (file-equal-p nospecial (dired-compress-file compressed))))))) + (should (file-equal-p nospecial (dired-compress-file compressed)))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (dired-compress-file nospecial)))) (ert-deftest files-tests-file-name-non-special-dired-uncache () + ;; FIXME: This is not a real test. We need cached values, and check + ;; whether they disappear. (files-tests--with-temp-non-special (tmpdir nospecial-dir t) + (dired-uncache nospecial-dir)) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) (dired-uncache nospecial-dir))) (ert-deftest files-tests-file-name-non-special-expand-file-name () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (expand-file-name nospecial) nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (expand-file-name nospecial) nospecial)))) (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) - (should (file-accessible-directory-p nospecial-dir)))) + (should (file-accessible-directory-p nospecial-dir))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-not (file-accessible-directory-p nospecial-dir)))) (ert-deftest files-tests-file-name-non-special-file-acl () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (equal (file-acl nospecial) (file-acl tmpfile))))) + (should (equal (file-acl nospecial) (file-acl tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (file-acl nospecial)))) (ert-deftest files-tests-file-name-non-special-file-attributes () (files-tests--with-temp-non-special (tmpfile nospecial) (should (files-tests-file-attributes-equal - (file-attributes nospecial) (file-attributes tmpfile))))) + (file-attributes nospecial) (file-attributes tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (file-attributes nospecial)))) (ert-deftest files-tests-file-name-non-special-file-directory-p () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) - (should (file-directory-p nospecial-dir)))) + (should (file-directory-p nospecial-dir))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-not (file-directory-p nospecial-dir)))) (ert-deftest files-tests-file-name-non-special-file-equal-p () (files-tests--with-temp-non-special (tmpfile nospecial) (should (file-equal-p nospecial tmpfile)) (should (file-equal-p tmpfile nospecial)) + (should (file-equal-p nospecial nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should (file-equal-p (file-name-unquote nospecial) tmpfile)) + (should (file-equal-p tmpfile (file-name-unquote nospecial))) + ;; File `nospecial' does not exist, so it cannot be compared. + (should-not (file-equal-p nospecial nospecial)) + (write-region "foo" nil nospecial) (should (file-equal-p nospecial nospecial)))) (ert-deftest files-tests-file-name-non-special-file-executable-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should-not (file-executable-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should-not (file-executable-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-exists-p () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (file-exists-p nospecial)))) + (should (file-exists-p tmpfile)) + (should (file-exists-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should (file-exists-p tmpfile)) + (should-not (file-exists-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-in-directory-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (let ((nospecial-tempdir (file-name-quote temporary-file-directory))) + (should (file-in-directory-p nospecial temporary-file-directory)) + (should (file-in-directory-p tmpfile nospecial-tempdir)) + (should (file-in-directory-p nospecial nospecial-tempdir)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (let ((nospecial-tempdir (file-name-quote temporary-file-directory))) (should (file-in-directory-p nospecial temporary-file-directory)) (should (file-in-directory-p tmpfile nospecial-tempdir)) @@ -494,67 +662,127 @@ be invoked with the right arguments." (ert-deftest files-tests-file-name-non-special-file-local-copy () (files-tests--with-temp-non-special (tmpfile nospecial) + (should-not (file-local-copy nospecial))) ; Already local. + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should-not (file-local-copy nospecial)))) ; Already local. (ert-deftest files-tests-file-name-non-special-file-modes () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (equal (file-modes nospecial) (file-modes tmpfile))))) + (should (equal (file-modes nospecial) (file-modes tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (equal (file-modes nospecial) (file-modes tmpfile))))) (ert-deftest files-tests-file-name-non-special-file-name-all-completions () (files-tests--with-temp-non-special (tmpfile nospecial) (let ((nospecial-tempdir (file-name-quote temporary-file-directory)) - (tmpdir temporary-file-directory)) - (should (equal (file-name-all-completions nospecial nospecial-tempdir) - (file-name-all-completions tmpfile tmpdir))) - (should (equal (file-name-all-completions tmpfile nospecial-tempdir) - (file-name-all-completions tmpfile tmpdir))) - (should (equal (file-name-all-completions nospecial tmpdir) - (file-name-all-completions tmpfile tmpdir)))))) + (tmpdir temporary-file-directory) + (file (file-name-nondirectory tmpfile)) + (nospecial-file (file-name-nondirectory nospecial))) + (should (string-equal file nospecial-file)) + (should (equal (file-name-all-completions + nospecial-file nospecial-tempdir) + (file-name-all-completions file tmpdir))) + (should (equal (file-name-all-completions file nospecial-tempdir) + (file-name-all-completions file tmpdir))) + (should (equal (file-name-all-completions nospecial-file tmpdir) + (file-name-all-completions file tmpdir))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let ((nospecial-tempdir (file-name-quote temporary-file-directory)) + (tmpdir temporary-file-directory) + (file (file-name-nondirectory tmpfile)) + (nospecial-file (file-name-nondirectory nospecial))) + (should-not (string-equal file nospecial-file)) + (should-not (equal (file-name-all-completions + nospecial-file nospecial-tempdir) + (file-name-all-completions file tmpdir))) + (should (equal (file-name-all-completions file nospecial-tempdir) + (file-name-all-completions file tmpdir))) + (should (equal (file-name-all-completions nospecial-file tmpdir) + (file-name-all-completions file tmpdir)))))) (ert-deftest files-tests-file-name-non-special-file-name-as-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (should (equal (file-name-as-directory nospecial-dir) + (file-name-quote (file-name-as-directory tmpdir))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-not (equal (file-name-as-directory nospecial-dir) (file-name-quote (file-name-as-directory tmpdir)))))) (ert-deftest files-tests-file-name-non-special-file-name-case-insensitive-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (file-name-case-insensitive-p nospecial) + (file-name-case-insensitive-p tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (file-name-case-insensitive-p nospecial) (file-name-case-insensitive-p tmpfile))))) (ert-deftest files-tests-file-name-non-special-file-name-completion () (files-tests--with-temp-non-special (tmpfile nospecial) (let ((nospecial-tempdir (file-name-quote temporary-file-directory)) - (tmpdir temporary-file-directory)) - (should (equal (file-name-completion nospecial nospecial-tempdir) - (file-name-completion tmpfile tmpdir))) - (should (equal (file-name-completion tmpfile nospecial-tempdir) - (file-name-completion tmpfile tmpdir))) - (should (equal (file-name-completion nospecial tmpdir) - (file-name-completion tmpfile tmpdir)))))) + (tmpdir temporary-file-directory) + (file (file-name-nondirectory tmpfile)) + (nospecial-file (file-name-nondirectory nospecial))) + (should (string-equal file nospecial-file)) + (should (equal (file-name-completion nospecial-file nospecial-tempdir) + (file-name-completion file tmpdir))) + (should (equal (file-name-completion file nospecial-tempdir) + (file-name-completion file tmpdir))) + (should (equal (file-name-completion nospecial-file tmpdir) + (file-name-completion file tmpdir))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let ((nospecial-tempdir (file-name-quote temporary-file-directory)) + (tmpdir temporary-file-directory) + (file (file-name-nondirectory tmpfile)) + (nospecial-file (file-name-nondirectory nospecial))) + (should-not (string-equal file nospecial-file)) + (should-not (equal (file-name-completion nospecial-file nospecial-tempdir) + (file-name-completion file tmpdir))) + (should (equal (file-name-completion file nospecial-tempdir) + (file-name-completion file tmpdir))) + (should (equal (file-name-completion nospecial-file tmpdir) + (file-name-completion file tmpdir)))))) (ert-deftest files-tests-file-name-non-special-file-name-directory () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (file-name-directory nospecial) + (file-name-quote temporary-file-directory)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (file-name-directory nospecial) (file-name-quote temporary-file-directory))))) (ert-deftest files-tests-file-name-non-special-file-name-nondirectory () (files-tests--with-temp-non-special (tmpfile nospecial) (should (equal (file-name-nondirectory nospecial) - (file-name-nondirectory tmpfile))))) + (file-name-nondirectory tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (equal (file-name-nondirectory nospecial) + (file-name-nondirectory tmpfile))))) (ert-deftest files-tests-file-name-non-special-file-name-sans-versions () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (file-name-sans-versions nospecial) nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (file-name-sans-versions nospecial) nospecial)))) (ert-deftest files-tests-file-name-non-special-file-newer-than-file-p () (files-tests--with-temp-non-special (tmpfile nospecial) (should-not (file-newer-than-file-p nospecial tmpfile)) (should-not (file-newer-than-file-p tmpfile nospecial)) + (should-not (file-newer-than-file-p nospecial nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (file-newer-than-file-p nospecial tmpfile)) + (should (file-newer-than-file-p tmpfile nospecial)) (should-not (file-newer-than-file-p nospecial nospecial)))) -(ert-deftest files-file-name-non-special-notify-handlers () +(ert-deftest files-tests-file-name-non-special-notify-handlers () (skip-unless file-notify--library) (files-tests--with-temp-non-special (tmpfile nospecial) + (let ((watch (file-notify-add-watch nospecial '(change) #'ignore))) + (should (file-notify-valid-p watch)) + (file-notify-rm-watch watch) + (should-not (file-notify-valid-p watch)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (let ((watch (file-notify-add-watch nospecial '(change) #'ignore))) (should (file-notify-valid-p watch)) (file-notify-rm-watch watch) @@ -562,46 +790,76 @@ be invoked with the right arguments." (ert-deftest files-tests-file-name-non-special-file-ownership-preserved-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (file-ownership-preserved-p nospecial) + (file-ownership-preserved-p tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (file-ownership-preserved-p nospecial) (file-ownership-preserved-p tmpfile))))) (ert-deftest files-tests-file-name-non-special-file-readable-p () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (file-readable-p nospecial)))) + (should (file-readable-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (file-readable-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-regular-p () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (file-regular-p nospecial)))) + (should (file-regular-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-not (file-regular-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-remote-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should-not (file-remote-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should-not (file-remote-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-selinux-context () (files-tests--with-temp-non-special (tmpfile nospecial) - (should (equal (file-selinux-context nospecial) - (file-selinux-context tmpfile))))) + (unless (equal (file-selinux-context tmpfile) '(nil nil nil nil)) + (should (equal (file-selinux-context nospecial) + (file-selinux-context tmpfile))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (unless (equal (file-selinux-context tmpfile) '(nil nil nil nil)) + (should-not (equal (file-selinux-context nospecial) + (file-selinux-context tmpfile)))))) (ert-deftest files-tests-file-name-non-special-file-symlink-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should-not (file-symlink-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should-not (file-symlink-p nospecial)))) (ert-deftest files-tests-file-name-non-special-file-truename () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal nospecial (file-truename nospecial)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal nospecial (file-truename nospecial))))) (ert-deftest files-tests-file-name-non-special-file-writable-p () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (file-writable-p nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (file-writable-p nospecial)))) (ert-deftest files-tests-file-name-non-special-find-backup-file-name () - (files-tests--with-temp-non-special (tmpfile nospecial) - (should (equal (find-backup-file-name nospecial) - (mapcar #'file-name-quote - (find-backup-file-name tmpfile)))))) + (let (version-control delete-old-versions + (kept-old-versions (default-toplevel-value 'kept-old-versions)) + (kept-new-versions (default-toplevel-value 'kept-new-versions))) + (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (find-backup-file-name nospecial) + (mapcar #'file-name-quote + (find-backup-file-name tmpfile))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpfile nospecial) + (should-not (equal (find-backup-file-name nospecial) + (mapcar #'file-name-quote + (find-backup-file-name tmpfile))))))) (ert-deftest files-tests-file-name-non-special-get-file-buffer () (files-tests--with-temp-non-special (tmpfile nospecial) + (should-not (get-file-buffer nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should-not (get-file-buffer nospecial)))) (ert-deftest files-tests-file-name-non-special-insert-directory () @@ -611,16 +869,23 @@ be invoked with the right arguments." (buffer-string)) (with-temp-buffer (insert-directory tmpdir "") - (buffer-string)))))) + (buffer-string))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (should-error (with-temp-buffer (insert-directory nospecial-dir ""))))) (ert-deftest files-tests-file-name-non-special-insert-file-contents () (files-tests--with-temp-non-special (tmpfile nospecial) (with-temp-buffer (insert-file-contents nospecial) - (should (zerop (buffer-size)))))) + (should (zerop (buffer-size))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-error (with-temp-buffer (insert-file-contents nospecial))))) (ert-deftest files-tests-file-name-non-special-load () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (load nospecial nil t))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (load nospecial nil t)))) (ert-deftest files-tests-file-name-non-special-make-auto-save-file-name () @@ -631,21 +896,37 @@ be invoked with the right arguments." (kill-buffer)) (prog2 (set-buffer (find-file-noselect tmpfile)) (make-auto-save-file-name) - (kill-buffer))))))) + (kill-buffer)))))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (save-current-buffer + (should-not (equal (prog2 (set-buffer (find-file-noselect nospecial)) + (make-auto-save-file-name) + (kill-buffer)) + (prog2 (set-buffer (find-file-noselect tmpfile)) + (make-auto-save-file-name) + (kill-buffer))))))) (ert-deftest files-tests-file-name-non-special-make-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (let ((default-directory nospecial-dir)) (make-directory "dir") (should (file-directory-p "dir")) - (delete-directory "dir")))) + (delete-directory "dir"))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (let ((default-directory nospecial-dir)) + (should-error (make-directory "dir"))))) (ert-deftest files-tests-file-name-non-special-make-directory-internal () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) (let ((default-directory nospecial-dir)) (make-directory-internal "dir") (should (file-directory-p "dir")) - (delete-directory "dir")))) + (delete-directory "dir"))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (let ((default-directory nospecial-dir)) + (should-error (make-directory-internal "dir"))))) (ert-deftest files-tests-file-name-non-special-make-nearby-temp-file () (let* ((default-directory (file-name-quote temporary-file-directory)) @@ -655,7 +936,7 @@ be invoked with the right arguments." (ert-deftest files-tests-file-name-non-special-make-symbolic-link () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) - (files-tests--with-temp-non-special (tmpfile _nospecial) + (files-tests--with-temp-non-special (tmpfile nospecial) (let* ((linkname (expand-file-name "link" tmpdir)) (may-symlink (ignore-errors (make-symbolic-link tmpfile linkname) t))) @@ -665,38 +946,73 @@ be invoked with the right arguments." (let ((linkname (expand-file-name "link" nospecial-dir))) (make-symbolic-link tmpfile linkname) (should (file-symlink-p linkname)) - (delete-file linkname))))))) + (delete-file linkname)))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpfile nospecial) + (let* ((linkname (expand-file-name "link" tmpdir)) + (may-symlink (ignore-errors (make-symbolic-link tmpfile linkname) + t))) + (when may-symlink + (should (file-symlink-p linkname)) + (delete-file linkname) + (let ((linkname (expand-file-name "link" nospecial-dir))) + (should-error (make-symbolic-link tmpfile linkname)))))))) ;; See `files-tests--file-name-non-special--subprocess'. ;; (ert-deftest files-tests-file-name-non-special-process-file ()) (ert-deftest files-tests-file-name-non-special-rename-file () (files-tests--with-temp-non-special (tmpfile nospecial) - (rename-file nospecial (concat nospecial "x")) - (rename-file (concat nospecial "x") nospecial) - (rename-file tmpfile (concat nospecial "x")) - (rename-file (concat nospecial "x") nospecial) - (rename-file nospecial (concat tmpfile "x")) - (rename-file (concat nospecial "x") nospecial))) + (rename-file nospecial (files-tests--new-name nospecial "x")) + (rename-file (files-tests--new-name nospecial "x") nospecial) + (rename-file tmpfile (files-tests--new-name nospecial "x")) + (rename-file (files-tests--new-name nospecial "x") nospecial) + (rename-file nospecial (files-tests--new-name tmpfile "x")) + (rename-file (files-tests--new-name nospecial "x") nospecial)) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-error (rename-file nospecial (files-tests--new-name nospecial "x"))) + (rename-file tmpfile (files-tests--new-name nospecial "x")) + (rename-file (files-tests--new-name nospecial "x") nospecial) + (rename-file nospecial (files-tests--new-name tmpfile "x")) + (should-error (rename-file (files-tests--new-name nospecial "x") nospecial)) + (delete-file (files-tests--new-name tmpfile "x")) + (delete-file (files-tests--new-name nospecial "x")))) (ert-deftest files-tests-file-name-non-special-set-file-acl () (files-tests--with-temp-non-special (tmpfile nospecial) + (set-file-acl nospecial (file-acl nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (set-file-acl nospecial (file-acl nospecial)))) (ert-deftest files-tests-file-name-non-special-set-file-modes () (files-tests--with-temp-non-special (tmpfile nospecial) - (set-file-modes nospecial (file-modes nospecial)))) + (set-file-modes nospecial (file-modes nospecial))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-error (set-file-modes nospecial (file-modes nospecial))))) (ert-deftest files-tests-file-name-non-special-set-file-selinux-context () (files-tests--with-temp-non-special (tmpfile nospecial) - (set-file-selinux-context nospecial (file-selinux-context nospecial)))) + (unless (equal (file-selinux-context tmpfile) '(nil nil nil nil)) + (set-file-selinux-context nospecial (file-selinux-context nospecial)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (unless (equal (file-selinux-context tmpfile) '(nil nil nil nil)) + (set-file-selinux-context nospecial (file-selinux-context nospecial))))) (ert-deftest files-tests-file-name-non-special-set-file-times () (files-tests--with-temp-non-special (tmpfile nospecial) - (set-file-times nospecial))) + (set-file-times nospecial)) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (should-error (set-file-times nospecial)))) (ert-deftest files-tests-file-name-non-special-set-visited-file-modtime () (files-tests--with-temp-non-special (tmpfile nospecial) + (save-current-buffer + (set-buffer (find-file-noselect nospecial)) + (set-visited-file-modtime) + (kill-buffer))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (save-current-buffer (set-buffer (find-file-noselect nospecial)) (set-visited-file-modtime) @@ -711,7 +1027,16 @@ be invoked with the right arguments." " --version") (current-buffer)) (goto-char (point-min)) - (should (search-forward emacs-version nil t)))))) + (should (search-forward emacs-version nil t))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (with-temp-buffer + (let ((default-directory nospecial-dir)) + (should-error + (shell-command (concat (shell-quote-argument + (concat invocation-directory invocation-name)) + " --version") + (current-buffer))))))) (ert-deftest files-tests-file-name-non-special-start-file-process () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) @@ -726,26 +1051,50 @@ be invoked with the right arguments." (should (search-forward emacs-version nil t)) ;; Don't stop the test run with a query, as the subprocess ;; may or may not be dead by the time we reach here. - (set-process-query-on-exit-flag proc nil)))))) + (set-process-query-on-exit-flag proc nil))))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) + (with-temp-buffer + (let ((default-directory nospecial-dir)) + (should-error (start-file-process + "emacs" (current-buffer) + (concat invocation-directory invocation-name) + "--version")))))) (ert-deftest files-tests-file-name-non-special-substitute-in-file-name () (files-tests--with-temp-non-special (tmpfile nospecial) (let ((process-environment (cons "FOO=foo" process-environment)) - (nospecial-foo (concat nospecial "$FOO"))) + (nospecial-foo (files-tests--new-name nospecial "$FOO"))) + ;; The "/:" prevents substitution. + (equal (substitute-in-file-name nospecial-foo) nospecial-foo))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) + (let ((process-environment (cons "FOO=foo" process-environment)) + (nospecial-foo (files-tests--new-name nospecial "$FOO"))) ;; The "/:" prevents substitution. (equal (substitute-in-file-name nospecial-foo) nospecial-foo)))) + (ert-deftest files-tests-file-name-non-special-temporary-file-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) + (let ((default-directory nospecial-dir)) + (equal (temporary-file-directory) temporary-file-directory))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) (let ((default-directory nospecial-dir)) (equal (temporary-file-directory) temporary-file-directory)))) (ert-deftest files-tests-file-name-non-special-unhandled-file-name-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) + (equal (unhandled-file-name-directory nospecial-dir) + (file-name-as-directory tmpdir))) + (files-tests--with-temp-non-special-and-file-name-handler + (tmpdir nospecial-dir t) (equal (unhandled-file-name-directory nospecial-dir) (file-name-as-directory tmpdir)))) (ert-deftest files-tests-file-name-non-special-vc-registered () (files-tests--with-temp-non-special (tmpfile nospecial) + (should (equal (vc-registered nospecial) (vc-registered tmpfile)))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (should (equal (vc-registered nospecial) (vc-registered tmpfile))))) ;; See test `files-tests--file-name-non-special--buffers'. @@ -753,6 +1102,9 @@ be invoked with the right arguments." (ert-deftest files-tests-file-name-non-special-write-region () (files-tests--with-temp-non-special (tmpfile nospecial) + (with-temp-buffer + (write-region nil nil nospecial nil :visit))) + (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (with-temp-buffer (write-region nil nil nospecial nil :visit)))) @@ -804,7 +1156,8 @@ consider the buffer saved, without prompting for a file name (Bug#28412)." (let ((read-file-name-function (lambda (&rest _ignore) - (error "Prompting for file name")))) + (error "Prompting for file name"))) + require-final-newline) ;; With contents function, and no file. (with-temp-buffer (setq write-contents-functions (lambda () t)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 09e9bac9e5..c5cb4cb43e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3125,10 +3125,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; We must unquote it. (should (string-equal - (funcall - (if (tramp--test-emacs27-p) - 'tramp-compat-file-name-unquote 'identity) - (file-truename tmp-name1)) + (file-truename tmp-name1) (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) ;; Cleanup. @@ -4085,7 +4082,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (list (file-name-nondirectory tmp-name2)))) ;; `vc-register' has changed its arguments in Emacs ;; 25.1. Let's skip it for older Emacsen. - (error (skip-unless (>= emacs-major-version 25)))) + (error (skip-unless (tramp--test-emacs25-p)))) ;; vc-git uses an own process sentinel, Tramp's sentinel ;; for flushing the cache isn't used. (dired-uncache (concat (file-remote-p default-directory) "/")) @@ -4332,6 +4329,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) +(defun tramp--test-emacs25-p () + "Check for Emacs version >= 25.1. +Some semantics has been changed for there, w/o new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 25)) + (defun tramp--test-emacs26-p () "Check for Emacs version >= 26.1. Some semantics has been changed for there, w/o new functions or commit defd53a56c709b8b8c736f0ab3b594490216d300 Author: Alan Third Date: Sun May 13 11:02:00 2018 +0100 Set accessibility subroles for child frame (bug#31324) ; Depends on patch in bug#31440. * src/nsterm.m (x_set_parent_frame): Set subrole depending on whether frame is a child or not. diff --git a/src/nsterm.m b/src/nsterm.m index df883346de..e4a9b014f4 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1962,7 +1962,15 @@ so some key presses (TAB) are swallowed by the system. */ child = [FRAME_NS_VIEW (f) window]; if ([child parentWindow] != nil) - [[child parentWindow] removeChildWindow:child]; + { + [[child parentWindow] removeChildWindow:child]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 + if ([child respondsToSelector:@selector(setAccessibilitySubrole:)] +#endif + [child setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole]; +#endif + } if (!NILP (new_value)) { @@ -1970,6 +1978,12 @@ so some key presses (TAB) are swallowed by the system. */ [parent addChildWindow: child ordered: NSWindowAbove]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 + if ([child respondsToSelector:@selector(setAccessibilitySubrole:)] +#endif + [child setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole]; +#endif } unblock_input (); commit de6a876373fde7f44f44fb46a29fcdda1d0793ba Author: Alan Third Date: Sun May 13 10:33:44 2018 +0100 Fix redefinition of child frames on NS * src/nsterm.m (x_set_parent_frame): If the NSWindow has an existing parent frame, remove it. diff --git a/src/nsterm.m b/src/nsterm.m index c8ae31abc0..df883346de 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1958,12 +1958,20 @@ so some key presses (TAB) are swallowed by the system. */ if (p != FRAME_PARENT_FRAME (f)) { - parent = [FRAME_NS_VIEW (p) window]; + block_input (); child = [FRAME_NS_VIEW (f) window]; - block_input (); - [parent addChildWindow: child - ordered: NSWindowAbove]; + if ([child parentWindow] != nil) + [[child parentWindow] removeChildWindow:child]; + + if (!NILP (new_value)) + { + parent = [FRAME_NS_VIEW (p) window]; + + [parent addChildWindow: child + ordered: NSWindowAbove]; + } + unblock_input (); fset_parent_frame (f, new_value);