commit 28b7745c677c394b21a663e5b7cdef2eb7329fde (HEAD, refs/remotes/origin/master) Merge: 82875b15750 be437883c6d Author: Stefan Monnier Date: Tue Jun 27 16:14:43 2023 -0400 Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs commit 82875b15750401daa358c1bebaba5969b96f0d88 Author: Stefan Monnier Date: Tue Jun 27 16:14:32 2023 -0400 cl-macs-tests.el (cl-&key-arguments): Fix regression * lisp/emacs-lisp/bytecomp.el (byte-compile-form): Turn "cannot use lexical var" errors into warnings. Make the obey `with-suppressed-warnings`. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-&key-arguments): Suppress warnings. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 659d698b603..99202185d8d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3473,8 +3473,9 @@ byte-compile-form run-hook-with-args-until-failure)) (pcase (cdr form) (`(',var . ,_) - (when (memq var byte-compile-lexical-variables) - (byte-compile-report-error + (when (and (memq var byte-compile-lexical-variables) + (byte-compile-warning-enabled-p 'lexical var)) + (byte-compile-warn (format-message "%s cannot use lexical var `%s'" fn var)))))) ;; Warn about using obsolete hooks. (if (memq fn '(add-hook remove-hook)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 01ca56386e3..983cbfc8bc7 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -812,8 +812,10 @@ cl-&key-arguments ;; In ELisp function arguments are always statically scoped (bug#47552). (let ((cl--test-a 'dyn) ;; FIXME: How do we silence the "Lexical argument shadows" warning? - (f (cl-function (lambda (&key cl--test-a b) - (list cl--test-a (symbol-value 'cl--test-a) b))))) + (f + (with-suppressed-warnings ((lexical cl--test-a)) + (cl-function (lambda (&key cl--test-a b) + (list cl--test-a (symbol-value 'cl--test-a) b)))))) (should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2))))) (cl-defstruct cl--test-s commit be437883c6d85f3ff2eddd4359bbfb9230c92910 Author: Alan Mackenzie Date: Tue Jun 27 20:11:48 2023 +0000 Amend the handling of c-laomib-cache. There was unstable syntactic analysis of lines which were brace lists. This fixes bug#64133. * lisp/progmodes/cc-engine.el (c-laomib-cache): Allow several entries with the same LIM element corresponding to distinct scanning regions. (c-laomib-get-cache): Add new parameter START. Adjust to be able to have entries with the same LIM element and handle them correctly. (c-laomib-put-cache): Amend the handling of cache entries with the same LIM element. (c-looking-at-or-maybe-in-bracelist): Supply the needed new argument to c-laomib-get-cache. Add in a new call to c-laomib-put-cache. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c4ae8aadd65..721daf9d53f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12997,11 +12997,19 @@ c-laomib-loop (defvar c-laomib-cache nil) (make-variable-buffer-local 'c-laomib-cache) -(defun c-laomib-get-cache (containing-sexp) - ;; Get an element from `c-laomib-cache' matching CONTAINING-SEXP. +(defun c-laomib-get-cache (containing-sexp start) + ;; Get an element from `c-laomib-cache' matching CONTAINING-SEXP, and which + ;; is suitable for start postiion START. ;; Return that element or nil if one wasn't found. - (let ((elt (assq containing-sexp c-laomib-cache))) - (when elt + (let ((ptr c-laomib-cache) + elt) + (while + (and ptr + (setq elt (car ptr)) + (or (not (eq (car elt) containing-sexp)) + (< start (car (cddr elt))))) + (setq ptr (cdr ptr))) + (when ptr ;; Move the fetched `elt' to the front of the cache. (setq c-laomib-cache (delq elt c-laomib-cache)) (push elt c-laomib-cache) @@ -13013,18 +13021,26 @@ c-laomib-put-cache ;; the components of the new element (see comment for `c-laomib-cache'). ;; The return value is of no significance. (when lim - (let ((old-elt (assq lim c-laomib-cache)) - ;; (elt (cons containing-sexp (cons start nil))) + (let (old-elt (new-elt (list lim start end result)) big-ptr (cur-ptr c-laomib-cache) - togo (size 0) cur-size - ) - (if old-elt (setq c-laomib-cache (delq old-elt c-laomib-cache))) + togo (size 0) cur-size) + + ;; If there is an elt which overlaps with the new element, remove it. + (while + (and cur-ptr + (setq old-elt (car cur-ptr)) + (or (not (eq (car old-elt) lim)) + (not (and (> start (car (cddr old-elt))) + (<= start (cadr old-elt)))))) + (setq cur-ptr (cdr cur-ptr))) + (when (and cur-ptr old-elt) + (setq c-laomib-cache (delq old-elt c-laomib-cache))) (while (>= (length c-laomib-cache) 4) ;; We delete the least recently used elt which doesn't enclose START, - ;; or.. + ;; or ... (dolist (elt c-laomib-cache) (if (or (<= start (cadr elt)) (> start (car (cddr elt)))) @@ -13032,8 +13048,10 @@ c-laomib-put-cache ;; ... delete the least recently used elt which isn't the biggest. (when (not togo) + (setq cur-ptr c-laomib-cache) (while (cdr cur-ptr) - (setq cur-size (- (nth 2 (cadr cur-ptr)) (car (cadr cur-ptr)))) + (setq cur-size (- (cadr (cadr cur-ptr)) + (car (cddr (cadr cur-ptr))))) (when (> cur-size size) (setq size cur-size big-ptr cur-ptr)) @@ -13225,7 +13243,7 @@ c-looking-at-or-maybe-in-bracelist (goto-char pos) (when (eq braceassignp 'dontknow) (let* ((cache-entry (and containing-sexp - (c-laomib-get-cache containing-sexp))) + (c-laomib-get-cache containing-sexp pos))) (lim2 (or (cadr cache-entry) lim)) sub-bassign-p) (if cache-entry @@ -13247,6 +13265,8 @@ c-looking-at-or-maybe-in-bracelist ) (setq braceassignp (nth 3 cache-entry)) (goto-char (nth 2 cache-entry))) + (c-laomib-put-cache containing-sexp + start (point) sub-bassign-p) (setq braceassignp sub-bassign-p))) (t)) commit cf4ccc58284de50959ea66b1cd2655ab2fa4d15b Author: Mattias Engdegård Date: Tue Jun 27 17:00:11 2023 +0200 Speed up duplicate-line by a factor of 2 * lisp/misc.el (duplicate-line): Add the newline to the string to be inserted instead of inserting it separately. This makes duplicate-line as fast as duplicate-dwim with a contiguous region. Both could easily be made faster yet by making the code more complex. diff --git a/lisp/misc.el b/lisp/misc.el index 81769696f95..de82b97fa6f 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -71,13 +71,15 @@ duplicate-line (interactive "p") (unless n (setq n 1)) - (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) + (let ((line (concat (buffer-substring (line-beginning-position) + (line-end-position)) + "\n"))) (save-excursion (forward-line 1) (unless (bolp) (insert "\n")) (dotimes (_ n) - (insert line "\n"))))) + (insert line))))) (declare-function rectangle--duplicate-right "rect" (n)) commit eca7394bdf2f57632238b2cf66c996b43cca2aef Author: Michael Albinus Date: Tue Jun 27 12:46:49 2023 +0200 Fix dired-insert-directory wrt remote directories * lisp/dired.el (dired-insert-directory): Respect remote directories consequently. diff --git a/lisp/dired.el b/lisp/dired.el index 914d0a0e783..b4cfaa1842f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1632,6 +1632,7 @@ dired-insert-directory If HDR is non-nil, insert a header line with the directory name." (let ((opoint (point)) (process-environment (copy-sequence process-environment)) + (remotep (file-remote-p dir)) end) (if (and ;; Don't try to invoke `ls' if we are on DOS/Windows where @@ -1641,7 +1642,7 @@ dired-insert-directory (null ls-lisp-use-insert-directory-program))) ;; FIXME: Big ugly hack for Eshell's eshell-ls-use-in-dired. (not (bound-and-true-p eshell-ls-use-in-dired)) - (or (file-remote-p dir) + (or remotep (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and ;; save the answer in `dired-use-ls-dired'. @@ -1656,19 +1657,14 @@ dired-insert-directory ;; Use -N with --dired, to countermand possible non-default ;; quoting style, in particular via the environment variable ;; QUOTING_STYLE. - (setq switches (concat "--dired -N " switches))) + (unless remotep + (setq switches (concat "--dired -N " switches)))) ;; Expand directory wildcards and fill file-list. (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) (cond (dir-wildcard (setq switches (concat "-d " switches)) - ;; We don't know whether the remote ls supports - ;; "--dired", so we cannot add it to the `process-file' - ;; call for wildcards. - (when (file-remote-p dir) - (setq switches (string-replace "--dired -N" "" switches))) (let* ((default-directory (car dir-wildcard)) (script (format "ls %s %s" switches (cdr dir-wildcard))) - (remotep (file-remote-p dir)) (sh (or (and remotep "/bin/sh") (executable-find shell-file-name) (executable-find "sh"))) commit 3a50773ab0071addba98249d26c309f5fb78bd74 Author: Stefan Monnier Date: Mon Jun 26 11:25:14 2023 -0400 startup.el: Don't override init.el custom of `debug-ignored-errors` * lisp/startup.el (startup--load-user-init-file): Undo commit 4302bc9b0f12. Mimic the code we use for `debug-on-error` instead. diff --git a/lisp/startup.el b/lisp/startup.el index 484c8f57a9f..5a389294e78 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1025,13 +1025,21 @@ startup--load-user-init-file (debug-on-error-should-be-set nil) (debug-on-error-initial (if (eq init-file-debug t) - 'startup + 'startup--witness ;Dummy but recognizable non-nil value. init-file-debug)) + (d-i-e-from-init-file nil) + (d-i-e-initial + ;; Use (startup--witness) instead of nil, so we can detect when the + ;; init files set `debug-ignored-errors' to nil. + (if init-file-debug '(startup--witness) debug-ignored-errors)) ;; The init file might contain byte-code with embedded NULs, ;; which can cause problems when read back, so disable nul ;; byte detection. (Bug#52554) (inhibit-null-byte-detection t)) - (let ((debug-on-error debug-on-error-initial)) + (let ((debug-on-error debug-on-error-initial) + ;; If they specified --debug-init, enter the debugger + ;; on any error whatsoever. + (debug-ignored-errors d-i-e-initial)) (condition-case-unless-debug error (when init-file-user (let ((init-file-name (funcall filename-function))) @@ -1041,17 +1049,11 @@ startup--load-user-init-file ;; `user-init-file'. (setq user-init-file t) (when init-file-name - ;; If they specified --debug-init, enter the debugger - ;; on any error whatsoever. - (let ((debug-ignored-errors - (if (and init-file-debug (not noninteractive)) - nil - debug-ignored-errors))) - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage))) + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) (when (and (eq user-init-file t) alternate-filename-function) (let ((alt-file (funcall alternate-filename-function))) @@ -1059,11 +1061,7 @@ startup--load-user-init-file (setq init-file-name alt-file)) (and (equal (file-name-extension alt-file) "el") (setq alt-file (file-name-sans-extension alt-file))) - (let ((debug-ignored-errors - (if (and init-file-debug (not noninteractive)) - nil - debug-ignored-errors))) - (load alt-file 'noerror 'nomessage)))) + (load alt-file 'noerror 'nomessage))) ;; If we did not find the user's init file, set ;; user-init-file conclusively. Don't let it be @@ -1102,11 +1100,7 @@ startup--load-user-init-file (not inhibit-default-init)) ;; Prevent default.el from changing the value of ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil) - (debug-ignored-errors - (if (and init-file-debug (not noninteractive)) - nil - debug-ignored-errors))) + (let ((inhibit-startup-screen nil)) (load "default" 'noerror 'nomessage)))) (error (display-warning @@ -1126,10 +1120,14 @@ startup--load-user-init-file ;; If we can tell that the init file altered debug-on-error, ;; arrange to preserve the value that it set up. + (or (eq debug-ignored-errors d-i-e-initial) + (setq d-i-e-from-init-file (list debug-ignored-errors))) (or (eq debug-on-error debug-on-error-initial) (setq debug-on-error-should-be-set t debug-on-error-from-init-file debug-on-error))) + (when d-i-e-from-init-file + (setq debug-ignored-errors (car d-i-e-from-init-file))) (when debug-on-error-should-be-set (setq debug-on-error debug-on-error-from-init-file)))) commit 748b1f1f48e28339e5f479a9aaba5eadd9c69ab2 Author: Michael Albinus Date: Mon Jun 26 15:48:48 2023 +0200 Fix Tramp mount-spec * lisp/net/tramp-fuse.el (tramp-fuse-mounted-p): The mount-spec could contain an optional trailing slash. (Bug#64278) * lisp/net/tramp-rclone.el (tramp-rclone-handle-file-system-info): Check return code of command. diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 99360c2c28e..aadc64666a5 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -174,12 +174,21 @@ tramp-fuse-mounted-p (or (tramp-get-file-property vec "/" "mounted") (let* ((default-directory tramp-compat-temporary-file-directory) (command (format "mount -t fuse.%s" (tramp-file-name-method vec))) - (mount (shell-command-to-string command))) + (mount (shell-command-to-string command)) + (mount-spec (split-string (tramp-fuse-mount-spec vec) ":" 'omit))) (tramp-message vec 6 "%s\n%s" command mount) + ;; The mount-spec contains a trailing local file name part, + ;; which might not be visible, for example with rclone + ;; mounts of type "memory" or "gdrive". Make it optional. + (setq mount-spec + (if (cdr mount-spec) + (rx (literal (car mount-spec)) + ":" (? (literal (cadr mount-spec)))) + (car mount-spec))) (tramp-set-file-property vec "/" "mounted" (when (string-match - (rx bol (group (literal (tramp-fuse-mount-spec vec))) + (rx bol (group (regexp mount-spec)) " on " (group (+ (not blank))) blank) mount) (tramp-set-file-property diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 02e96e10438..f71e4f732e2 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -300,25 +300,25 @@ tramp-rclone-handle-file-system-info (setq filename (file-name-directory filename))) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-message v 5 "file system info: %s" localname) - (tramp-rclone-send-command v "about" (concat host ":")) - (with-current-buffer (tramp-get-connection-buffer v) - (let (total used free) - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) - (setq total (string-to-number (match-string 1)))) - (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) - (setq used (string-to-number (match-string 1)))) - (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) - (setq free (string-to-number (match-string 1)))) - (forward-line)) - (when used - ;; The used number of bytes is not part of the result. As - ;; side effect, we store it as file property. - (tramp-set-file-property v localname "used-bytes" used)) - ;; Result. - (when (and total free) - (list total free (- total free)))))))) + (when (zerop (tramp-rclone-send-command v "about" (concat host ":"))) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total used free) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) + (setq total (string-to-number (match-string 1)))) + (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) + (setq used (string-to-number (match-string 1)))) + (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) + (setq free (string-to-number (match-string 1)))) + (forward-line)) + (when used + ;; The used number of bytes is not part of the result. + ;; As side effect, we store it as file property. + (tramp-set-file-property v localname "used-bytes" used)) + ;; Result. + (when (and total free) + (list total free (- total free))))))))) (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) commit fc6bcb89803a37e106f302282bff162e5d90bc40 Author: Alan Mackenzie Date: Mon Jun 26 13:25:45 2023 +0000 CC Mode: Fix parenthesis bug in XEmacs part of macro * lisp/progmodes/cc-defs.el (c-looking-at-non-alphnumspace): Correct confused parentheses. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f9b63cbeed6..1d7f90ed428 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1870,9 +1870,9 @@ c-looking-at-non-alphnumspace '(looking-at "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)") '(or (looking-at - "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)" + "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)") (let ((prop (c-get-char-property (point) 'syntax-table))) - (equal prop '(14))))))) ; '(14) is generic comment delimiter. + (equal prop '(14)))))) ; '(14) is generic comment delimiter. (defsubst c-intersect-lists (list alist)