commit 57f66bfa6c6a498a5efd60b26bdd531d555c5052 Author: Michael Albinus Date: Wed Dec 17 07:36:49 2025 +0100 ; Fix last change in tramp-tests.el * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Adapt tests. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d109f1e6cae..708615fc9f6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5568,7 +5568,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." proc (apply #'start-file-process "test3" (current-buffer) command)) (should (processp proc)) - (should (equal (process-status proc) 'run)) + ;(should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) (set-process-filter proc @@ -5783,7 +5783,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (rx bol "foo" eol) "foobar" s)))) :file-handler t)) (should (processp proc)) - (should (equal (process-status proc) 'run)) + ;(should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) commit 26dcbd06eda1f6124874754ba8c8083c47fe281b Author: Sean Whitton Date: Tue Dec 16 21:52:05 2025 +0000 Fix outgoing diff commands including uncommitted changes * lisp/vc/vc-hooks.el (vc-symbolic-working-revision): Don't return nil when passed a directory if also passed a backend. * lisp/vc/vc.el (vc-diff-outgoing): Pass backend to vc-symbolic-working-revision. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index d4d8ef816a0..ddc5af317bb 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -579,7 +579,9 @@ underlying VCS that FILE is unregistered; this is in contrast to (defun vc-symbolic-working-revision (file &optional backend) "Return BACKEND's symbolic name for FILE's working revision. -If FILE is not registered according to cached information, return nil. +If FILE names an existing directory, the BACKEND argument is mandatory. +If FILE is not registered according to cached information or names an +existing directory and BACKEND is nil, return nil. If BACKEND does not have a symbolic name for the working revision or Emacs doesn't know what it is, call `vc-working-revision' instead. @@ -596,11 +598,17 @@ will do, for it avoids a call out to the underlying VCS." ;; BACKEND implements `working-revision-symbol' (because we would be ;; sensitive to whether FILE is registered if and only if we defer to ;; `vc-working-revision'), which would be a strange interdependence.) - (and-let* ((cached-backend (vc-backend file))) - (let* ((backend (or backend cached-backend)) - (fn (vc-find-backend-function backend - 'working-revision-symbol))) - (if fn (funcall fn) (vc-working-revision file backend))))) + ;; + ;; Similarly, for consistency with `vc-working-revision', + ;; return nil for directories unless BACKEND is specified + ;; (`vc-backend' always returns nil for directories). + (let (cached-backend) + (and (or (and (file-directory-p file) backend) + (setq cached-backend (vc-backend file))) + (let* ((backend (or backend cached-backend)) + (fn (vc-find-backend-function backend + 'working-revision-symbol))) + (if fn (funcall fn) (vc-working-revision file backend)))))) (defvar vc-use-short-revision nil "If non-nil, VC backend functions should return short revisions if possible. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index c65088b994d..cd61f433e26 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3099,8 +3099,9 @@ global binding." ;; 'revision-granularity) ;; 'repository) ;; (ignore-errors - ;; (vc-symbolic-working-revision (caadr fileset))) - (vc-symbolic-working-revision (caadr fileset)) + ;; (vc-symbolic-working-revision (caadr fileset) + ;; backend))) + (vc-symbolic-working-revision (caadr fileset) backend) (called-interactively-p 'interactive)))) ;; For the following two commands, the default meaning for commit 2b942c929edb3e602ad4f6f9a7fc6044dfc737cb Author: João Távora Date: Tue Dec 16 21:04:52 2025 +0000 Eglot: fix last change about relativePatternSupport (bug#79809) According to the spec, glob patterns are matched against relative paths when server provides a RelativePattern baseUri. Else match the glob against the absolute path as usual. * lisp/progmodes/eglot.el (eglot--watch-glob): Tweak diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5c65115ceb2..4f7ef6b57ac 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4342,7 +4342,10 @@ Returns success status for SERVER and registration ID." (cond ((and (memq action '(created changed deleted)) (> (logand kind action-bit) 0) - (funcall compiled file)) + (funcall compiled + (if base-path + (file-relative-name file base-path) + file))) (jsonrpc-notify server :workspace/didChangeWatchedFiles `(:changes ,(vector `(:uri ,(eglot-path-to-uri file) commit 06f31dc2d6305191bd35ad3e6017ba6e81a8b84d Author: João Távora Date: Tue Dec 16 17:45:36 2025 +0000 Eglot: support relativePatternSupport for file watching (bug#79809) Announce relativePatternSupport capability. Parse RelativePattern objects with baseUri and pattern fields. Add defvar eglot-watch-files-outside-project-root to control filtering. Rewrote file watching implementation. Key by registration ID instead of directory. Each LSP watchers item spawns directory watchers indenpendently that will look for the associated pattern only. This change needs (or at least is known to work more efficiently) with the latest project.el, so we should bump it. * lisp/progmodes/eglot.el (eglot-client-capabilities): Announce relativePatternSupport for didChangeWatchedFiles. (eglot-lsp-server): Change file-watches slot to ID-keyed structure. (eglot-watch-files-outside-project-root): New defvar. (eglot--watch-glob): New function. (eglot-register-capability): Rewrite. (eglot-unregister-capability): Simplified for ID-keyed structure. (eglot--on-shutdown): Update watch cleanup. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index aec949fc5b1..5c65115ceb2 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1062,7 +1062,8 @@ object." :workspaceEdit `(:documentChanges t) :didChangeWatchedFiles `(:dynamicRegistration - ,(if (eglot--trampish-p s) :json-false t)) + ,(if (eglot--trampish-p s) :json-false t) + :relativePatternSupport t) :symbol `(:dynamicRegistration :json-false) :semanticTokens '(:refreshSupport t) :configuration t @@ -1197,7 +1198,7 @@ object." :documentation "Generalized boolean inhibiting auto-reconnection if true." :accessor eglot--inhibit-autoreconnect) (file-watches - :documentation "Map (DIR -> (WATCH ID1 ID2...)) for `didChangeWatchedFiles'." + :documentation "Map (ID -> (watch-descriptor ...)) for `didChangeWatchedFiles'." :initform (make-hash-table :test #'equal) :accessor eglot--file-watches) (managed-buffers :initform nil @@ -1357,8 +1358,9 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see." (eglot-autoshutdown nil)) (eglot--when-live-buffer buffer (eglot--managed-mode-off)))) ;; Kill any expensive watches - (maphash (lambda (_dir watch-and-ids) - (file-notify-rm-watch (car watch-and-ids))) + (maphash (lambda (_id watch-descriptors) + (dolist (watch-desc watch-descriptors) + (file-notify-rm-watch watch-desc))) (eglot--file-watches server)) ;; Sever the project/server relationship for `server' (setf (gethash (eglot--project server) eglot--servers-by-project) @@ -4313,25 +4315,23 @@ at point. With prefix argument, prompt for ACTION-KIND." (and use-text-p t)))) -;;; Dynamic registration +;;; File watchers (aka didChangeWatchedFiles) ;;; -(cl-defmethod eglot-register-capability - (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers) - "Handle dynamic registration of workspace/didChangeWatchedFiles." - (eglot-unregister-capability server method id) - (let* (success - (globs (mapcar - (eglot--lambda ((FileSystemWatcher) globPattern kind) - (cons (eglot--glob-compile globPattern t t) - ;; the default "7" means bitwise OR of - ;; WatchKind.Create (1), WatchKind.Change - ;; (2), WatchKind.Delete (4) - (or kind 7))) - watchers)) - (dirs-to-watch - (delete-dups (mapcar #'file-name-directory - (project-files - (eglot--project server)))))) +(defvar eglot-watch-files-outside-project-root t + "If non-nil, allow watching files outside project root") + +(defun eglot--watch-glob (server id pat kind &optional base-path) + "Set up file watching for files matching PAT under BASEPATH. +PAT is a glob pattern, KIND is a bitmask of change types, +BASEPATH is the directory to watch (nil means entire project). +Returns success status for SERVER and registration ID." + (let* ((project (eglot--project server)) + (dirs (delete-dups + (mapcar #'file-name-directory + (project-files project (and base-path + (list base-path)))))) + (success nil) + (compiled (eglot--glob-compile pat t t))) (cl-labels ((handle-event (event) (pcase-let* ((`(,desc ,action ,file ,file1) event) @@ -4341,46 +4341,65 @@ at point. With prefix argument, prompt for ACTION-KIND." (ash 1 (1- action-type))))) (cond ((and (memq action '(created changed deleted)) - (cl-loop for (glob . kind-bitmask) in globs - thereis (and (> (logand kind-bitmask action-bit) 0) - (funcall glob file)))) + (> (logand kind action-bit) 0) + (funcall compiled file)) (jsonrpc-notify server :workspace/didChangeWatchedFiles `(:changes ,(vector `(:uri ,(eglot-path-to-uri file) :type ,action-type)))) (when (and (eq action 'created) (file-directory-p file)) - (watch-dir file))) + (add-watch file))) ((eq action 'renamed) - (handle-event `(,desc 'deleted ,file)) - (handle-event `(,desc 'created ,file1)))))) - (watch-dir (dir) - (when-let* ((probe - (and (file-readable-p dir) - (or (gethash dir (eglot--file-watches server)) - (puthash dir (list (file-notify-add-watch - dir '(change) #'handle-event)) - (eglot--file-watches server)))))) - (push id (cdr probe))))) + (handle-event `(,desc deleted ,file)) + (handle-event `(,desc created ,file1)))))) + (add-watch (dir) + (when (file-readable-p dir) + (push (file-notify-add-watch dir '(change) #'handle-event) + (gethash id (eglot--file-watches server)))))) (unwind-protect - (progn - (mapc #'watch-dir dirs-to-watch) - (setq - success - `(:message ,(format "OK, watching %s directories in %s watchers" - (length dirs-to-watch) (length watchers))))) + (dolist (d dirs) + (add-watch d) + (setq success t)) (unless success - (eglot-unregister-capability server method id)))))) + (eglot-unregister-capability server 'workspace/didChangeWatchedFiles id)))) + success)) + +(cl-defmethod eglot-register-capability + (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers + &aux (root (project-root (eglot--project server)))) + "Handle dynamic registration of workspace/didChangeWatchedFiles." + (eglot-unregister-capability server method id) + (mapc + (eglot--lambda ((FileSystemWatcher) ((:globPattern pat)) kind) + (pcase-let* + ((`(,pat ,base-uri) + (if (consp pat) + (list (plist-get pat :pattern) + (plist-get pat :baseUri)) + (list pat nil))) + (base-path + (when base-uri + (if (stringp base-uri) + (eglot-uri-to-path base-uri) + (eglot-uri-to-path (plist-get base-uri :uri)))))) + (when (or eglot-watch-files-outside-project-root + (null base-path) + (file-in-directory-p base-path root)) + (eglot--watch-glob server id pat + ;; the default "7" means bitwise OR of + ;; WatchKind.Create (1), WatchKind.Change + ;; (2), WatchKind.Delete (4) + (or kind 7) + base-path)))) + watchers)) (cl-defmethod eglot-unregister-capability (server (_method (eql workspace/didChangeWatchedFiles)) id) "Handle dynamic unregistration of workspace/didChangeWatchedFiles." - (maphash (lambda (dir watch-and-ids) - (setcdr watch-and-ids (delete id (cdr watch-and-ids))) - (when (null (cdr watch-and-ids)) - (file-notify-rm-watch (car watch-and-ids)) - (remhash dir (eglot--file-watches server)))) - (eglot--file-watches server)) + (dolist (watch-desc (gethash id (eglot--file-watches server))) + (file-notify-rm-watch watch-desc)) + (remhash id (eglot--file-watches server)) (list t "OK")) commit 645a6ba08108af15e89dd527bc3ea37f6c8f07eb Author: Michael Albinus Date: Tue Dec 16 18:33:56 2025 +0100 Document and test process filters in tramp-smb.el * doc/misc/tramp.texi (Remote processes): Provide more details in "Running remote processes on MS Windows hosts". * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Adapt tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1f5b790016f..7976b1e7cd8 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4501,21 +4501,6 @@ remote MS Windows host, and @value{tramp} uses it for @code{make-process}, @code{process-file} and @code{start-file-process}. It does not work for remote Samba servers. -Redirection from stdin and process filters are not supported (yet). - -Check, that the default remote temporary file directory is usable. -Otherwise, change it, for example (with adapted @t{"user"} and -@t{"host"}): - -@lisp -(add-to-list 'tramp-connection-properties - (list (regexp-quote "host") - "tmpdir" "/Users/user/AppData/Local/Temp")) -@end lisp - -@noindent -@xref{Predefined connection information}. - @c FIXME: Verify powershell version. @vindex tramp-smb-winexe-program @code{tramp-smb-winexe-program} specifies the local @command{winexe} @@ -4533,6 +4518,26 @@ achieved by creating the @samp{HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\ LocalAccountTokenFilterPolicy} parameter in the MS Windows registry as DWORD (32-bit) with the value 1. +Check, that the default remote temporary file directory is usable. +Otherwise, change it, for example (with adapted @t{"user"} and +@t{"host"}): + +@lisp +(add-to-list 'tramp-connection-properties + (list (regexp-quote "host") + "tmpdir" "/Users/user/AppData/Local/Temp")) +@end lisp + +@noindent +@xref{Predefined connection information}. + +Redirection from stdin is not supported. + +@vindex auto-revert-remote-files +If you use a remote asynchronous process with a separate error buffer, +you must ensure that remote files can be auto-reverted. Set user +option @code{auto-revert-remote-files} to a non-@code{nil} value. + @vindex tramp-smb-connection-local-powershell-profile @vindex tramp-smb-prompt @cindex @file{.emacs_powershell} file diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 65f0f15e8d5..d109f1e6cae 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5512,6 +5512,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." kill-buffer-query-functions command proc) ;; Simple process. + ;; The "smb" method does not support stdin redirection. (unless (tramp--test-smb-p) (unwind-protect (with-temp-buffer @@ -5561,11 +5562,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-file tmp-name))) ;; Process filter. - ;; FIXME: tramp-smb.el should implement this. - (unless (tramp--test-smb-p) (unwind-protect (with-temp-buffer - (setq command '("cat") + (setq command '("echo" "foo") proc (apply #'start-file-process "test3" (current-buffer) command)) (should (processp proc)) @@ -5573,17 +5572,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (equal (process-get proc 'remote-command) command)) (set-process-filter proc - (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo\n") - (process-send-eof proc) + (lambda (p s) + (with-current-buffer + (process-buffer p) + (insert + (replace-regexp-in-string (rx bol "foo" eol) "foobar" s))))) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) (length "foo")) + (while (not (string-match-p "foobar" (buffer-string))) (while (accept-process-output proc 0 nil t)))) - (should (string-match-p "foo" (buffer-string)))) + (should (string-match-p "foobar" (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-process proc)))) + (ignore-errors (delete-process proc))) ;; Disabled process filter. It doesn't work reliable. (unless t @@ -5709,10 +5710,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((default-directory ert-remote-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) + (inhibit-message (not (ignore-errors (edebug-mode)))) kill-buffer-query-functions command proc) (should-not (apply #'make-process nil)) ; Use `apply' to avoid warnings. ;; Simple process. + ;; The "smb" method does not support stdin redirection. (unless (tramp--test-smb-p) (unwind-protect (with-temp-buffer @@ -5765,31 +5768,31 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-file tmp-name))) ;; Process filter. - ;; FIXME: tramp-smb.el should implement this. - (unless (tramp--test-smb-p) (unwind-protect (with-temp-buffer - (setq command '("cat") + (setq command '("echo" "foo") proc (make-process :name "test3" :buffer (current-buffer) :command command :filter (lambda (p s) - (with-current-buffer (process-buffer p) (insert s))) + (with-current-buffer + (process-buffer p) + (insert + (replace-regexp-in-string + (rx bol "foo" eol) "foobar" s)))) :file-handler t)) (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) - (process-send-string proc "foo\n") - (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) - (while (not (string-match-p "foo" (buffer-string))) + (while (not (string-match-p "foobar" (buffer-string))) (while (accept-process-output proc 0 nil t)))) - (should (string-match-p "foo" (buffer-string)))) + (should (string-match-p "foobar" (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-process proc)))) + (ignore-errors (delete-process proc))) ;; Disabled process filter. It doesn't work reliable. (unless t @@ -9016,11 +9019,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Implement `tramp-test31-interrupt-process' and ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; async processes. Check, why they don't run stable. -;; * Fix the limitations for "smb" in `tramp-test28-process-file', -;; `tramp-test29-start-file-process', `tramp-test30-make-process', -;; `tramp-test32-shell-command', -;; `tramp-test34-explicit-shell-file-name' and -;; `tramp--test-check-files'. +;; * Fix the limitations for "smb" in `tramp--test-check-files'. ;; * Check, why `tramp-test45-asynchronous-requests' often fails. The ;; famous reentrant error? ;; * Check, why direct async processes do not work for commit 62ce890c9f80d01fa572698be0a30fd3f4ce6c2c Author: Przemysław Kryger Date: Tue Dec 16 15:32:01 2025 +0000 Mark less important package-vc-tests as expensive * test/lisp/emacs-lisp/package-vc-tests.el (package-vc-test-deftest): Add support for `:tags' keyword. (upgrade, upgrade-all, upgrade-all-after-require, rebuild) (prepare-patch, log-incoming, pkg-spec-info-manual): Mark as `:expensive-test'. diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 820ea0ce213..3a6145f39fb 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -666,7 +666,8 @@ Return nil on timeout or the value of last form in BODY." "For each package under test define a test with NAME. Use function `package-vc-tests-packages' to obtain packages under test. Execute BODY as a test body with a package under test installed. Bind -car of ARGS (a symbol) to name of the package." +car of ARGS (a symbol) to name of the package. When plist cdr ARGS +contains key `:tags' use its value as tests tags." (declare (debug (&define [&name "test@" symbolp] sexp def-body)) @@ -676,7 +677,8 @@ car of ARGS (a symbol) to name of the package." (unless (symbolp (car-safe args)) (error "`package-vc' tests first argument has to be a symbol")) (let ((file (or (macroexp-file-name) buffer-file-name)) - (tests '()) (fn (gensym))) + (tests '()) (fn (gensym)) + (tags (plist-get (cdr-safe args) :tags))) (dolist (pkg (package-vc-tests-packages)) (let ((name (intern (format "package-vc-tests-%s/%s" name pkg)))) (push @@ -684,7 +686,7 @@ car of ARGS (a symbol) to name of the package." ',name (make-ert-test :name ',name - :tags '(package-vc) + :tags (cons 'package-vc ',tags) :file-name ,file :body (lambda () @@ -741,7 +743,7 @@ car of ARGS (a symbol) to name of the package." pkg :main-compiled)))) (should (< main-compiled-pos install-end)))) -(package-vc-test-deftest upgrade (pkg) +(package-vc-test-deftest upgrade (pkg :tags (:expensive-test)) (let ((head (package-vc-tests-package-head pkg))) (package-vc-tests-reset-head^ pkg) (push (list (package-vc-tests-load-history-marker @@ -824,7 +826,7 @@ car of ARGS (a symbol) to name of the package." (package-vc-tests-assert-elc pkg) (package-vc-tests-assert-package-alist pkg '(0 2))) -(package-vc-test-deftest upgrade-all (pkg) +(package-vc-test-deftest upgrade-all (pkg :tags (:expensive-test)) (let ((head (package-vc-tests-package-head pkg))) (package-vc-tests-reset-head^ pkg) (push (list (package-vc-tests-load-history-marker @@ -863,7 +865,7 @@ car of ARGS (a symbol) to name of the package." (package-vc-tests-assert-elc pkg) (package-vc-tests-assert-package-alist pkg '(0 2))) -(package-vc-test-deftest upgrade-all-after-require (pkg) +(package-vc-test-deftest upgrade-all-after-require (pkg :tags (:expensive-test)) (should (require pkg)) (let ((head (package-vc-tests-package-head pkg))) (package-vc-tests-reset-head^ pkg) @@ -907,7 +909,7 @@ car of ARGS (a symbol) to name of the package." (package-vc-tests-assert-elc pkg) (package-vc-tests-assert-package-alist pkg '(0 2))) -(package-vc-test-deftest rebuild (pkg) +(package-vc-test-deftest rebuild (pkg :tags (:expensive-test)) (package-vc-tests-reset-head^ pkg) (let ((head (package-vc-tests-package-head pkg))) (package-vc-rebuild @@ -948,7 +950,7 @@ car of ARGS (a symbol) to name of the package." (package-vc-tests-assert-elc pkg) (package-vc-tests-assert-package-alist pkg '(0 1))) -(package-vc-test-deftest prepare-patch (pkg) +(package-vc-test-deftest prepare-patch (pkg :tags (:expensive-test)) ;; Ensure `vc-prepare-patch' respects subject from function argument (let ((message-auto-save-directory package-vc-tests-dir) (vc-prepare-patches-separately nil)) @@ -977,7 +979,7 @@ car of ARGS (a symbol) to name of the package." (set-buffer-modified-p nil)) (kill-buffer message-buffer))))) -(package-vc-test-deftest log-incoming (pkg) +(package-vc-test-deftest log-incoming (pkg :tags (:expensive-test)) (package-vc-tests-reset-head^ pkg) (should (package-vc-tests-package-vc-async-wait @@ -1018,7 +1020,7 @@ car of ARGS (a symbol) to name of the package." (format "%s.cmd-build" pkg) checkout-dir))))) -(package-vc-test-deftest pkg-spec-info-manual (pkg) +(package-vc-test-deftest pkg-spec-info-manual (pkg :tags (:expensive-test)) ;; Only `package-vc-install' builds info manuals, but only when ;; executable install-info is available. (skip-unless (and (executable-find "install-info") commit 60c8f3e8ad30547935a2a2c2e07f159087706d42 Author: Przemysław Kryger Date: Tue Dec 16 13:53:21 2025 +0000 Fix package-vc-tests failing when no install-info is available * test/lisp/emacs-lisp/package-vc-tests.el (pkg-spec-make-shell-command): Rename from `pkg-spec-doc-make-shell-command'. Remove assertions related to info manual installation. (pkg-spec-info-manual): Add tests for info manual installation. diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 27faf4acaba..820ea0ce213 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -1002,7 +1002,7 @@ car of ARGS (a symbol) to name of the package." (let (kill-buffer-query-functions) (kill-buffer incoming-buffer)))) -(package-vc-test-deftest pkg-spec-doc-make-shell-command (pkg) +(package-vc-test-deftest pkg-spec-make-shell-command (pkg) ;; Only `package-vc-install' runs make and shell command (skip-unless (memq (caddr (alist-get pkg package-vc-tests-packages)) '(package-vc-tests-install-from-elpa @@ -1016,7 +1016,15 @@ car of ARGS (a symbol) to name of the package." (should (file-exists-p (expand-file-name (format "%s.cmd-build" pkg) - checkout-dir)))) + checkout-dir))))) + +(package-vc-test-deftest pkg-spec-info-manual (pkg) + ;; Only `package-vc-install' builds info manuals, but only when + ;; executable install-info is available. + (skip-unless (and (executable-find "install-info") + (memq (caddr (alist-get pkg package-vc-tests-packages)) + '(package-vc-tests-install-from-elpa + package-vc-tests-install-from-spec)))) (should-not (package-vc-tests-log-buffer-exists 'doc pkg)) (should (cl-member-if (lambda (dir) commit d22dd26fc7937cf9032e025cacf119d970718685 Author: Liu Hui Date: Sat Dec 13 21:11:54 2025 +0800 Improve support for non-default calendar buffer (bug#79994) * lisp/calendar/calendar.el (calendar-get-buffer): New function. (calendar-mode-line-format): Support displaying non-default calendar buffer name. (calendar-exit): Handle non-default calendar buffer separately. (calendar-generate-window): Update mode-line after cursor motion (bug#79994). (calendar-redraw, calendar-update-mode-line, calendar-unmark) (calendar-mark-visible-date): * lisp/calendar/cal-hebrew.el (calendar-hebrew-mark-date-pattern) (calendar-hebrew-list-yahrzeits): * lisp/calendar/diary-lib.el (diary-mark-sexp-entries) (calendar-mark-days-named, calendar-mark-date-pattern) (calendar-mark-1): Replace 'calendar-buffer' with the new function or current calendar buffer. (diary-mark-entries): Record current calendar buffer (bug#79994). diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 870186861ef..180441867e5 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -614,7 +614,7 @@ A value of 0 in any position is a wildcard. Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." ;; FIXME not the same as the Bahá’í and Islamic cases, so can't use ;; calendar-mark-1. - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (if (and (not (zerop month)) (not (zerop day))) (if (not (zerop year)) ;; Fully specified Hebrew date. @@ -679,7 +679,7 @@ When called interactively from the calendar window, the date of death is taken from the cursor position." (interactive (let* ((death-date - (if (equal (current-buffer) (get-buffer calendar-buffer)) + (if (derived-mode-p 'calendar-mode) (calendar-cursor-to-date t) (let* ((today (calendar-current-date)) (year (calendar-read-sexp diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 04a42fcd38a..43a159782ec 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1102,6 +1102,12 @@ Otherwise, use symbolic time zones like \"CET\"." (defconst calendar-buffer "*Calendar*" "Name of the buffer used for the calendar.") +(defun calendar-get-buffer () + "Return current usable calendar buffer." + (if (derived-mode-p 'calendar-mode) + (current-buffer) + (get-buffer calendar-buffer))) + (defconst holiday-buffer "*Holidays*" "Name of the buffer used for the displaying the holidays.") @@ -1426,12 +1432,12 @@ Optional integers MON and YR are used instead of today's date." (year (calendar-extract-year today)) (today-visible (or (not mon) (<= (abs (calendar-interval mon yr month year)) 1))) - (in-calendar-window (eq (window-buffer) - (get-buffer calendar-buffer)))) + (in-calendar-window (with-current-buffer (window-buffer) + (derived-mode-p 'calendar-mode)))) (calendar-generate (or mon month) (or yr year)) - (calendar-update-mode-line) (calendar-cursor-to-visible-date (if today-visible today (list displayed-month 1 displayed-year))) + (calendar-update-mode-line) (set-buffer-modified-p nil) ;; Don't do any window-related stuff if we weren't called from a ;; window displaying the calendar. @@ -1567,8 +1573,8 @@ first INDENT characters on the line." (defun calendar-redraw () "Redraw the calendar display, if `calendar-buffer' is live." (interactive) - (when (get-buffer calendar-buffer) - (with-current-buffer calendar-buffer + (when-let* ((buf (calendar-get-buffer))) + (with-current-buffer buf (let ((cursor-date (calendar-cursor-to-nearest-date))) (calendar-generate-window displayed-month displayed-year) (calendar-cursor-to-visible-date cursor-date)) @@ -1774,7 +1780,7 @@ is COMMAND's keybinding, STRING describes the binding." (defcustom calendar-mode-line-format (list (calendar-mode-line-entry 'calendar-scroll-right "previous month" "<") - "Calendar" + '(string-trim (buffer-name) "*" "*") (concat (calendar-mode-line-entry 'calendar-goto-info-node "read Info on Calendar" nil "info") @@ -1876,9 +1882,9 @@ concatenated and the result truncated." (defun calendar-update-mode-line () "Update the calendar mode line with the current date and date style." - (if (and calendar-mode-line-format - (bufferp (get-buffer calendar-buffer))) - (with-current-buffer calendar-buffer + (if-let* ((calendar-mode-line-format) + (buf (calendar-get-buffer))) + (with-current-buffer buf (let ((start (- calendar-left-margin 2))) (calendar-dlet ((date (condition-case nil (calendar-cursor-to-nearest-date) @@ -1909,29 +1915,34 @@ concatenated and the result truncated." If KILL (interactively, the prefix), kill the buffers instead of hiding them." (interactive "P") - (let ((diary-buffer (get-file-buffer diary-file)) - (calendar-buffers (calendar-buffer-list))) - (when (or (not diary-buffer) - (not (buffer-modified-p diary-buffer)) - (yes-or-no-p - "Diary modified; do you really want to exit the calendar? ")) - (if (and calendar-setup (display-multi-frame-p)) - ;; FIXME: replace this cruft with the `quit-restore' window property - (dolist (w (window-list-1 nil nil t)) - (if (and (memq (window-buffer w) calendar-buffers) - (window-dedicated-p w)) - (if (eq (window-deletable-p w) 'frame) - (if calendar-remove-frame-by-deleting - (delete-frame (window-frame w)) - (iconify-frame (window-frame w))) - (quit-window kill w)))) - (dolist (b calendar-buffers) - (quit-windows-on b kill))) - ;; Finally, kill non-displayed buffers (if requested). - (when kill - (dolist (b calendar-buffers) - (when (buffer-live-p b) - (kill-buffer b))))))) + ;; Don't handle other buffers when exiting a non-default calendar + ;; buffer. + (if (and (derived-mode-p 'calendar-mode) + (not (equal (current-buffer) (get-buffer calendar-buffer)))) + (quit-windows-on nil kill) + (let ((diary-buffer (get-file-buffer diary-file)) + (calendar-buffers (calendar-buffer-list))) + (when (or (not diary-buffer) + (not (buffer-modified-p diary-buffer)) + (yes-or-no-p + "Diary modified; do you really want to exit the calendar? ")) + (if (and calendar-setup (display-multi-frame-p)) + ;; FIXME: replace this cruft with the `quit-restore' window property + (dolist (w (window-list-1 nil nil t)) + (if (and (memq (window-buffer w) calendar-buffers) + (window-dedicated-p w)) + (if (eq (window-deletable-p w) 'frame) + (if calendar-remove-frame-by-deleting + (delete-frame (window-frame w)) + (iconify-frame (window-frame w))) + (quit-window kill w)))) + (dolist (b calendar-buffers) + (quit-windows-on b kill))) + ;; Finally, kill non-displayed buffers (if requested). + (when kill + (dolist (b calendar-buffers) + (when (buffer-live-p b) + (kill-buffer b)))))))) (defun calendar-current-date (&optional offset) "Return the current date in a list (month day year). @@ -2442,7 +2453,7 @@ interpreted as BC; -1 being 1 BC, and so on." (interactive) (setq calendar-mark-holidays nil calendar-mark-diary-entries nil) - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (mapc #'delete-overlay (overlays-in (point-min) (point-max))))) (defun calendar-date-is-visible-p (date) @@ -2559,7 +2570,7 @@ ATTRLIST is a list with elements of the form :face face :foreground color." MARK is a single-character string, a list of face attributes/values, or a face. MARK defaults to `diary-entry-marker'." (if (calendar-date-is-valid-p date) - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (save-excursion (calendar-cursor-to-visible-date date) (setq mark diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 056360bbede..418dede88d2 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1400,6 +1400,9 @@ marks. This is intended to deal with deleted diary entries." (calendar-redraw)) (let ((diary-marking-entries-flag t) (diary-buffer (find-buffer-visiting diary-file)) + ;; Record current calendar buffer in case this function is + ;; called in a non-default calendar buffer. + (calendar-buffer (calendar-get-buffer)) ;; Dynamically bound in diary-include-files. (d-incp (and (boundp 'diary-including) diary-including)) file-glob-attrs temp-buff) @@ -1470,7 +1473,7 @@ is marked. See the documentation for the function `diary-list-sexp-entries'." (file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) m y first-date last-date date mark file-glob-attrs sexp-start sexp entry entry-start) - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (setq m displayed-month y displayed-year)) (calendar-increment-month m y -1) @@ -1522,7 +1525,7 @@ See also `diary-include-other-diary-files'." "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on. Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (let ((prev-month displayed-month) (prev-year displayed-year) (succ-month displayed-month) @@ -1557,7 +1560,7 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard. Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (let ((m displayed-month) (y displayed-year)) (calendar-increment-month m y -1) @@ -1601,7 +1604,7 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." The function FROMABS converts absolute dates to the appropriate date system. The function TOABS carries out the inverse operation. Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." - (with-current-buffer calendar-buffer + (with-current-buffer (calendar-get-buffer) (if (and (not (zerop month)) (not (zerop day))) (if (not (zerop year)) ;; Fully specified date.