master b4f504a0ea: Load desktop without prompting if process is dead

[Lars Ingebrigtsen]

branch: master
commit b4f504a0ea90eb7fed2f3c0291d0eab43ef483d6
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Load desktop without prompting if process is dead
    
    * doc/emacs/misc.texi (Saving Emacs Sessions): Document the new
    'check' value.
    * etc/NEWS: Announce the change (bug#1474).
    * 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        |  7 ++++++-
 etc/NEWS                   |  9 +++++++++
 lisp/desktop.el            | 50 ++++++++++++++++++++++++++++++++++++----------
 test/lisp/desktop-tests.el | 50 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 104 insertions(+), 12 deletions(-)

diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 4710c05b62..a0d79711f1 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2770,7 +2770,12 @@ will by default ask you whether to use the locked 
desktop file.  You
 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-pid} 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 ad0f7f1c05..5ca1df4542 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -83,6 +83,15 @@ input of sequences such as 'C-;' and 'C-S-u'.
 Instead, they're fetched as needed from the corresponding ".elc" file,
 as was already the case for all the non-preloaded files.
 
+** 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-pid', 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.
+
 
 * Startup Changes in Emacs 29.1
 
diff --git a/lisp/desktop.el b/lisp/desktop.el
index e7a368e21f..773f0f050f 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -230,16 +230,26 @@ Zero or nil means disable auto-saving due to idleness."
 (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-pid  -- 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-pid', 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-pid))
   :group 'desktop
   :version "22.2")
 
@@ -662,6 +672,28 @@ DIRNAME omitted or nil means use `desktop-dirname'."
             (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)))
+    (equal (alist-get 'comm attr)
+           (file-name-nondirectory (car command-line-args)))))
+
+(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-pid
+     (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'."
@@ -1263,11 +1295,7 @@ It returns t if a desktop file was loaded, nil otherwise.
              (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..d52fe39ed9
--- /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 <https://www.gnu.org/licenses/>.
+
+;;; 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-pid))
+    (desktop--load-locked-desktop-p (emacs-pid))))
+
+(provide 'desktop-tests)