master c4ab173 2/2: File unlock errors now issue warnings (Bug#46397)

[Eli Zaretskii]

branch: master
commit c4ab173df3ea4c37165c011c515928da1783a9ae
Author: Matt Armstrong <matt@rfc20.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    File unlock errors now issue warnings (Bug#46397)
    
    The primary idea is to allow `kill-buffer' and `kill-emacs' to
    complete even if Emacs has trouble unlocking the buffer's file.
    
    * lisp/userlock.el (userlock--handle-unlock-error): New function, call
    `display-error'.
    * src/filelock.c (unlock_file_body): New function, do what
    'unlock_file' used to.
    (unlock_file_handle_error): New function, call
    `userlock--handle-unlock-error' with the captured error.
    (unlock_file): Handle `file-error' conditions by calling the handler
    defined above.
    * test/src/filelock-tests.el (filelock-tests-kill-buffer-spoiled):
    (filelock-tests-unlock-spoiled): Modify to test new behavior.
---
 doc/lispref/files.texi     |  2 ++
 etc/NEWS                   |  6 ++++++
 lisp/userlock.el           | 10 ++++++++++
 src/filelock.c             | 26 +++++++++++++++++++++++---
 test/src/filelock-tests.el | 34 ++++++++++++++++++++++------------
 5 files changed, 63 insertions(+), 15 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 2828b50..a8b921e 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -764,6 +764,8 @@ This function unlocks the file being visited in the current 
buffer,
 if the buffer is modified.  If the buffer is not modified, then
 the file should not be locked, so this function does nothing.  It also
 does nothing if the current buffer is not visiting a file, or is not locked.
+This function handles file system errors by calling @code{display-warning}
+and otherwise ignores the error.
 @end defun
 
 @defopt create-lockfiles
diff --git a/etc/NEWS b/etc/NEWS
index 68812c6..2d66a93 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2502,6 +2502,12 @@ back in Emacs 23.1.  The affected functions are: 
'make-obsolete',
 * Lisp Changes in Emacs 28.1
 
 +++
+** 'unlock-buffer' displays warnings instead of signaling.
+Instead of signaling 'file-error' conditions for file system level
+errors, the function now calls 'display-warning' and continues as if
+the error did not occur.
+
++++
 ** New function 'always'.
 This is identical to 'ignore', but returns t instead.
 
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 57311ac..4a75815 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -224,4 +224,14 @@ to get the latest version of the file, then make the 
change again."
           revert-buffer-binding))
         (help-mode)))))
 
+;;;###autoload
+(defun userlock--handle-unlock-error (error)
+  "Report an ERROR that occurred while unlocking a file."
+  (display-warning
+   '(unlock-file)
+   ;; There is no need to explain that this is an unlock error because
+   ;; ERR is a `file-error' condition, which explains this.
+   (message "%s, ignored" (error-message-string error))
+   :warning))
+
 ;;; userlock.el ends here
diff --git a/src/filelock.c b/src/filelock.c
index 373fc00..446a262 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -719,8 +719,8 @@ lock_file (Lisp_Object fn)
     }
 }
 
-void
-unlock_file (Lisp_Object fn)
+static Lisp_Object
+unlock_file_body (Lisp_Object fn)
 {
   char *lfname;
   USE_SAFE_ALLOCA;
@@ -737,6 +737,23 @@ unlock_file (Lisp_Object fn)
     report_file_errno ("Unlocking file", filename, err);
 
   SAFE_FREE ();
+  return Qnil;
+}
+
+static Lisp_Object
+unlock_file_handle_error (Lisp_Object err)
+{
+  call1 (intern ("userlock--handle-unlock-error"), err);
+  return Qnil;
+}
+
+void
+unlock_file (Lisp_Object fn)
+{
+  internal_condition_case_1 (unlock_file_body,
+                            fn,
+                            list1(Qfile_error),
+                            unlock_file_handle_error);
 }
 
 #else  /* MSDOS */
@@ -790,7 +807,10 @@ DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
        0, 0, 0,
        doc: /* Unlock the file visited in the current buffer.
 If the buffer is not modified, this does nothing because the file
-should not be locked in that case.  */)
+should not be locked in that case.  It also does nothing if the
+current buffer is not visiting a file, or is not locked.  Handles file
+system errors by calling `display-warning' and continuing as if the
+error did not occur.  */)
   (void)
 {
   if (SAVE_MODIFF < MODIFF
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
index c6f55ef..a96d6d6 100644
--- a/test/src/filelock-tests.el
+++ b/test/src/filelock-tests.el
@@ -138,11 +138,16 @@ the case)."
      (should-not (file-locked-p buffer-file-truename))
      (filelock-tests--spoil-lock-file buffer-file-truename)
 
-     ;; FIXME: Unlocking buffers should not signal errors related to
-     ;; their lock files (bug#46397).
-     (let ((err (should-error (unlock-buffer))))
-       (should (equal (cl-subseq err 0 2)
-                      '(file-error "Unlocking file")))))))
+     ;; Errors from `unlock-buffer' should call
+     ;; `userlock--handle-unlock-error' (bug#46397).
+     (let (errors)
+       (cl-letf (((symbol-function 'userlock--handle-unlock-error)
+                  (lambda (err) (push err errors))))
+         (unlock-buffer))
+       (should (consp errors))
+       (should (equal '(file-error "Unlocking file")
+                      (seq-subseq (car errors) 0 2)))
+       (should (equal (length errors) 1))))))
 
 (ert-deftest filelock-tests-kill-buffer-spoiled ()
   "Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
@@ -161,13 +166,18 @@ the case)."
      ;; a function that fakes a "yes" answer for the "Buffer modified;
      ;; kill anyway?" prompt.
      ;;
-     ;; FIXME: Killing buffers should not signal errors related to
-     ;; their lock files (bug#46397).
-     (let* ((err (cl-letf (((symbol-function 'yes-or-no-p)
-                            (lambda (&rest _) t)))
-                   (should-error (kill-buffer)))))
-       (should (equal (seq-subseq err 0 2)
-                      '(file-error "Unlocking file")))))))
+     ;; File errors from unlocking files should call
+     ;; `userlock--handle-unlock-error' (bug#46397).
+     (let (errors)
+       (cl-letf (((symbol-function 'yes-or-no-p)
+                  (lambda (&rest _) t))
+                 ((symbol-function 'userlock--handle-unlock-error)
+                  (lambda (err) (push err errors))))
+         (kill-buffer))
+       (should (consp errors))
+       (should (equal '(file-error "Unlocking file")
+                      (seq-subseq (car errors) 0 2)))
+       (should (equal (length errors) 1))))))
 
 (provide 'filelock-tests)
 ;;; filelock-tests.el ends here