From 04c2d26df4f73be675cc9ea6aa2ce10a474ecd18 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 24 Jan 2020 05:12:20 +0100 Subject: [PATCH] Load desktop without prompting if process is dead * lisp/desktop.el (desktop-load-locked-desktop): Add new value 'check' to load desktop file without prompting if locking Emacs process does not exist on the local machine. (Bug#1474) (desktop-read): Extract function from here... (desktop--load-locked-desktop-p): ...to here. New function handles the semantics of 'desktop-load-locked-desktop', including above new value 'check'. (desktop--emacs-pid-running-p): New function. * test/lisp/desktop-tests.el: New file with tests for the above. * doc/emacs/misc.texi (Saving Emacs Sessions): Document the new 'check' value. * etc/NEWS: Announce the change. --- doc/emacs/misc.texi | 7 +++++- etc/NEWS | 9 +++++++ lisp/desktop.el | 48 +++++++++++++++++++++++++++--------- test/lisp/desktop-tests.el | 50 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 102 insertions(+), 12 deletions(-) create mode 100644 test/lisp/desktop-tests.el diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 6b95b12a84..bedbfb7abe 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2653,7 +2653,12 @@ Saving Emacs Sessions can avoid the question by customizing the variable @code{desktop-load-locked-desktop} to either @code{nil}, which means never load the desktop in this case, or @code{t}, which means load the -desktop without asking. +desktop without asking. Finally, the @code{check} value means to load +the file if the Emacs process that has locked the desktop is not +running on the local machine. This should not be used in +circumstances where the locking Emacs might still be running on +another machine. This could be the case in multi-user environments +where your home directory is mounted remotely using NFS or similar. @cindex desktop restore in daemon mode When Emacs starts in daemon mode, it cannot ask you any questions, diff --git a/etc/NEWS b/etc/NEWS index 11ef31b2c8..de39912e90 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,6 +90,15 @@ supplied error message. *** New connection method "media", which allows accessing media devices like cell phones, tablets or cameras. +** Emacs Sessions (Desktop) + ++++ +*** New option to load if locking Emacs not running locally. +The option 'desktop-load-locked-desktop' can now be set to value +'check', which means to load the desktop only if the locking Emacs +process is not running on the local machine. See the "(emacs) Saving +Emacs Sessions" node in the Emacs manual for details. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/desktop.el b/lisp/desktop.el index 9538bb4a34..27f6c80531 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -230,16 +230,25 @@ desktop-auto-save-timeout (defcustom desktop-load-locked-desktop 'ask "Specifies whether the desktop should be loaded if locked. Possible values are: - t -- load anyway. - nil -- don't load. - ask -- ask the user. -If the value is nil, or `ask' and the user chooses not to load the desktop, -the normal hook `desktop-not-loaded-hook' is run." + t -- load anyway. + nil -- don't load. + ask -- ask the user. + check -- load if locking Emacs process is missing locally. + +If the value is nil, or `ask' and the user chooses not to load +the desktop, the normal hook `desktop-not-loaded-hook' is run. + +If the value is `check', load the desktop if the Emacs process +that has locked it is not running on the local machine. This +should not be used in circumstances where the locking Emacs might +still be running on another machine. That could be the case if +you have remotely mounted (NFS) paths in `desktop-dirname'." :type '(choice (const :tag "Load anyway" t) (const :tag "Don't load" nil) - (const :tag "Ask the user" ask)) + (const :tag "Ask the user" ask) + (const :tag "Load if no local process" check)) :group 'desktop :version "22.2") @@ -662,6 +671,27 @@ desktop-owner (integerp owner))) owner))) +(defun desktop--emacs-pid-running-p (pid) + "Return t if an Emacs process with PID exists." + (when-let ((attr (process-attributes pid))) + (string-match "^emacs$" (alist-get 'comm attr)))) + +(defun desktop--load-locked-desktop-p (owner) + "Return t if a locked desktop should be loaded. +OWNER is the pid in the lock file. +The return value of this function depends on the value of +`desktop-load-locked-desktop'." + (pcase desktop-load-locked-desktop + ('ask + (unless (daemonp) + (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ +Using it may cause conflicts. Use it anyway? " owner)))) + ('check + (or (eq (emacs-pid) owner) + (not (desktop--emacs-pid-running-p owner)))) + ('nil nil) + (_ t))) + (defun desktop-claim-lock (&optional dirname) "Record this Emacs process as the owner of the desktop file in DIRNAME. DIRNAME omitted or nil means use `desktop-dirname'." @@ -1238,11 +1268,7 @@ desktop-read (desktop-save nil) (desktop-autosave-was-enabled)) (if (and owner - (memq desktop-load-locked-desktop '(nil ask)) - (or (null desktop-load-locked-desktop) - (daemonp) - (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ -Using it may cause conflicts. Use it anyway? " owner))))) + (not (desktop--load-locked-desktop-p owner))) (let ((default-directory desktop-dirname)) (setq desktop-dirname nil) (run-hooks 'desktop-not-loaded-hook) diff --git a/test/lisp/desktop-tests.el b/test/lisp/desktop-tests.el new file mode 100644 index 0000000000..7483bb8adb --- /dev/null +++ b/test/lisp/desktop-tests.el @@ -0,0 +1,50 @@ +;;; desktop-tests.el --- Tests for desktop.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'desktop) + +(ert-deftest desktop-tests--emacs-pid-running-p () + (should (desktop--emacs-pid-running-p (emacs-pid))) + (should-not (desktop--emacs-pid-running-p 1))) + +(ert-deftest desktop-tests--load-locked-desktop-p () + (let ((desktop-load-locked-desktop t)) + (should (desktop--load-locked-desktop-p (emacs-pid))))) + +(ert-deftest desktop-tests--load-locked-desktop-p-nil () + (let ((desktop-load-locked-desktop nil)) + (should-not (desktop--load-locked-desktop-p (emacs-pid))))) + +(ert-deftest desktop-tests--load-locked-desktop-p-ask () + (let ((desktop-load-locked-desktop 'ask)) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))) + (should (desktop--load-locked-desktop-p (emacs-pid)))) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil))) + (should-not (desktop--load-locked-desktop-p (emacs-pid)))))) + +(ert-deftest desktop-tests--load-locked-desktop-p-check () + (let ((desktop-load-locked-desktop 'check)) + (desktop--load-locked-desktop-p (emacs-pid)))) + +(provide 'desktop-tests) -- 2.20.1