bug#57407: [PATCH] Handle error of ’vc-registered’

[Simon Tournier <zimon.toutoune@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 5522 bytes --]

Hi,

Submission (Bug#18481) [0] merged on 2020-08-13 with commit
991e145450ec8b02865597bc80fd797e39e81f07 [1] aims to:

“Notify the user if we errors when querying for registered git files“

However, the replacement of ’ignore-errors’ by ’with-demoted-errors’
introduces spurious messages.  This patch proposes to handle the errors
in a way that:

 1. the user is still informed (avoid silent error)
 2. improve the messages trying to be more accurate
 3. do it for all the VC backends

0: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18481
1: https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=991e145450ec8b02865597bc80fd797e39e81f07



First, let compare the previous situation with the patched one.  If the
user runs ’find-file’ in a Git repository without having installed the
Git binary, then Emacs complains and the error is misleading.
Reproducer:

--8<---------------cut here---------------start------------->8---
$  which git
which: no git in …
$ mkdir -p /tmp/Git/.git
$ emacs -q --batch --eval="(find-file \"/tmp/Git/foo\")"
Error: (file-missing "Searching for program" "No such file or directory" "git")
Package vc-mtn is deprecated
--8<---------------cut here---------------end--------------->8---

Not having a working Git installation is not an error for opening one
file belonging to a folder containing a ’.git’ subdirectory.  For
instance, if an user processes many files reporting many messages, then
it seems hard to locate the real error, if any.


Moreover, the messages are inconsistent depending on the VC backend;
from nothing reported to a backtrace.

--8<---------------cut here---------------start------------->8---
$ mkdir -p /tmp/Bzr/.bzr
$ emacs -q --batch --eval="(find-file \"/tmp/Bzr/foo\")"
Error: (file-missing "Searching for program" "No such file or directory" "bzr")
Error: (file-missing "Searching for program" "No such file or directory" "bzr")

Error: file-missing ("Searching for program" "No such file or directory" "bzr")

[...]

Searching for program: No such file or directory, bzr
--8<---------------cut here---------------end--------------->8---

Considering the patch, it would become:

--8<---------------cut here---------------start------------->8---
$ emacs -q --batch --eval="(find-file \"/tmp/Git/foo\")"
Warning: (vc-not-supported "Searching for program" "No such file or directory" "git")

$ emacs -q --batch --eval="(find-file \"/tmp/Bzr/foo\")"
Falling back on "slow" status detection ((error . "VC: Bzr dirstate is not flat format 3"))
Warning: (vc-not-supported "Searching for program" "No such file or directory" "bzr")
--8<---------------cut here---------------end--------------->8---

and all the VC backends report similarly when something fails.


Second, I have tested various configurations using Guix (65cabb0) and
also the Emacs test suite is passing.  However, note that a) I barely
use VC so b) I am lacking imagination for testing scenarii where the
bubble error could wrongly propagate and thus would provide an
unexpected behavior.  Especially with remote as Tramp allows.


Third, I do not know if it is the correct way for catching the errors.
The core of the change is:

--8<---------------cut here---------------start------------->8---
lisp/vc/vc-dispatcher.el (vc-do-command):

              (condition-case err
	          (setq status (apply #'process-file command nil t nil squeezed))
                (error
                 (pcase (car err)
                   ('file-missing
                    (if (string= (cadr err) "Searching for program")
                        ;; The most probable is the lack of the backend binary.
                        (signal 'vc-not-supported (cdr err))
                      (signal (car err) (cdr err))))
                   (_
                    (signal (car err) (cdr err))))))

lisp/vc/vc-hooks.el (vc-refresh-state):

                      (condition-case err
                          (vc-backend buffer-file-name)
                        (error
                         (pcase (car err)
                           ('vc-not-supported
                            (message "Warning: %S" err))
                           (_
                            (message "VC refresh error: %S" err)))
                         nil))
--8<---------------cut here---------------end--------------->8---

and the rest of the change is just bubble error propagation from this
’vc-do-command’ to this ’vc-refresh-state’.

It is probably an abuse of ’pcase’.  Is ’cond’ better here?  Last,
I have not found in the documentation how to differentiate what it is
raised depending on the error type, hence the ’pcase’.


I hope all this is helpful and going in the right direction for
improving the reported messages.  If not, let me know what could be
better.

Cheers,
simon


PS: If this patch makes sense for inclusion, then let me know and I will
complete the Copyright Assignment process.

Simon Tournier (1):
  Handle error of 'vc-registered'

 lisp/vc/vc-bzr.el        | 82 ++++++++++++++++++++--------------------
 lisp/vc/vc-dispatcher.el | 12 +++++-
 lisp/vc/vc-git.el        | 24 +++++++-----
 lisp/vc/vc-hg.el         | 13 +++----
 lisp/vc/vc-hooks.el      | 11 +++++-
 lisp/vc/vc-svn.el        |  5 +--
 6 files changed, 84 insertions(+), 63 deletions(-)


base-commit: 1007800a5994ac49b6bc9cd7528edb2d709d2031
-- 
2.36.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the.patch --]
[-- Type: text/x-diff, Size: 13847 bytes --]

From befbe14487c1ba4ee2a98edb8dc6ef1f111d9fbd Mon Sep 17 00:00:00 2001
From: Simon Tournier <zimon.toutoune@gmail.com>
Date: Thu, 25 Aug 2022 02:47:03 +0200
Subject: [PATCH 1/1] Handle error of 'vc-registered'

This follows up commit 991e145450ec8b02865597bc80fd797e39e81f07:

2020-08-13 "Notify the user if we errors when querying for registered
git files"

closing Bug#18481.

* lisp/vc/vc-bzr.el (vc-bzr-state-heuristic): Raise an error for
unknown Bazaar dirstate format.
(vc-bzr-registered): Catch the error.
(vc-bzr-status): Tweak error catch.

* lisp/vc/vc-dispatcher.el (vc-do-command): Catch errors of command
run synchronously.

* lisp/vc/vc-git.el (vc-git-registered): Raise the errors reported by
'vc-git-command'.

* lisp/vc/vc-hg.el (vc-hg-registered): Avoid unnecessary calls by
directly call specialized 'vc-hg-state', replace generic
'process-file' by specialized 'vc-hg-command', do not ignore errors.

* lisp/vc/vc-hooks.el (vc-refresh-state): Notify accordindly to the
failure.

* lisp/vc/vc-svn.el (vc-svn-registered): Raise the errors.
---
 lisp/vc/vc-bzr.el        | 82 ++++++++++++++++++++--------------------
 lisp/vc/vc-dispatcher.el | 12 +++++-
 lisp/vc/vc-git.el        | 24 +++++++-----
 lisp/vc/vc-hg.el         | 13 +++----
 lisp/vc/vc-hooks.el      | 11 +++++-
 lisp/vc/vc-svn.el        |  5 +--
 6 files changed, 84 insertions(+), 63 deletions(-)

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index f6b17d4ce0..7bfb3d0ed3 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -226,7 +226,7 @@ vc-bzr-state-heuristic
             (insert-file-contents dirstate)
             (goto-char (point-min))
             (if (not (looking-at "#bazaar dirstate flat format 3"))
-                (vc-bzr-state file)     ; Some other unknown format?
+                (signal 'error "VC: Bzr dirstate is not flat format 3")
               (let* ((relfile (file-relative-name file root))
                      (reldir (file-name-directory relfile)))
                 (cond
@@ -314,7 +314,9 @@ vc-bzr-state-heuristic
 
 (defun vc-bzr-registered (file)
   "Return non-nil if FILE is registered with bzr."
-  (let ((state (vc-bzr-state-heuristic file)))
+  (let ((state (condition-case err
+                   (vc-bzr-state-heuristic file)
+                 (error (signal (car err) (cdr err))))))
     (not (memq state '(nil unregistered ignored)))))
 
 (defconst vc-bzr-state-words
@@ -445,45 +447,45 @@ vc-bzr-status
 ;; (unchanged . WARNING).  FIXME unchanged is not the best status to
 ;; return in case of error.
   (with-temp-buffer
-    ;; This is with-demoted-errors without the condition-case-unless-debug
-    ;; annoyance, which makes it fail during ert testing.
-    (condition-case err (vc-bzr-command "status" t 0 file)
-      (error (message "Error: %S" err) nil))
     (let ((status 'unchanged))
-      ;; the only secure status indication in `bzr status' output
-      ;; is a couple of lines following the pattern::
-      ;;   | <status>:
-      ;;   |   <file name>
-      ;; if the file is up-to-date, we get no status report from `bzr',
-      ;; so if the regexp search for the above pattern fails, we consider
-      ;; the file to be up-to-date.
-      (goto-char (point-min))
-      (when (re-search-forward
-             ;; bzr prints paths relative to the repository root.
-             (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
-                     (regexp-quote (vc-bzr-file-name-relative file))
-                     ;; Bzr appends a '/' to directory names and
-                     ;; '*' to executable files
-                     (if (file-directory-p file) "/?" "\\*?")
-                     "[ \t\n]*$")
-             nil t)
-        (let ((statusword (match-string 1)))
-          ;; Erase the status text that matched.
-          (delete-region (match-beginning 0) (match-end 0))
-          (setq status
-                (intern (string-replace " " "" statusword)))))
-      (when status
-        (goto-char (point-min))
-        (skip-chars-forward " \n\t") ;Throw away spaces.
-        (cons status
-              ;; "bzr" will output warnings and informational messages to
-              ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
-              ;; `start-process' itself) limitations, we cannot catch stderr
-              ;; and stdout into different buffers.  So, if there's anything
-              ;; left in the buffer after removing the above status
-              ;; keywords, let us just presume that any other message from
-              ;; "bzr" is a user warning, and display it.
-              (unless (eobp) (buffer-substring (point) (point-max))))))))
+      (condition-case err
+          (progn
+            (vc-bzr-command "status" t 0 file)
+            ;; the only secure status indication in `bzr status' output
+            ;; is a couple of lines following the pattern::
+            ;;   | <status>:
+            ;;   |   <file name>
+            ;; if the file is up-to-date, we get no status report from `bzr',
+            ;; so if the regexp search for the above pattern fails, we consider
+            ;; the file to be up-to-date.
+            (goto-char (point-min))
+            (when (re-search-forward
+                   ;; bzr prints paths relative to the repository root.
+                   (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
+                           (regexp-quote (vc-bzr-file-name-relative file))
+                           ;; Bzr appends a '/' to directory names and
+                           ;; '*' to executable files
+                           (if (file-directory-p file) "/?" "\\*?")
+                           "[ \t\n]*$")
+                   nil t)
+              (let ((statusword (match-string 1)))
+                ;; Erase the status text that matched.
+                (delete-region (match-beginning 0) (match-end 0))
+                (setq status
+                      (intern (string-replace " " "" statusword)))))
+            (when status
+              (goto-char (point-min))
+              (skip-chars-forward " \n\t") ;Throw away spaces.
+              (cons status
+                    ;; "bzr" will output warnings and informational messages to
+                    ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
+                    ;; `start-process' itself) limitations, we cannot catch stderr
+                    ;; and stdout into different buffers.  So, if there's anything
+                    ;; left in the buffer after removing the above status
+                    ;; keywords, let us just presume that any other message from
+                    ;; "bzr" is a user warning, and display it.
+                    (unless (eobp) (buffer-substring (point) (point-max))))))
+        (error (signal (car err) (cdr err)))))))
 
 (defun vc-bzr-state (file)
   (let ((result (vc-bzr-status file)))
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index e2a490092b..778d1139fc 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -359,7 +359,17 @@ vc-do-command
 	      (let ((inhibit-message vc-inhibit-message))
 		(message "Running in foreground: %s" full-command)))
 	    (let ((buffer-undo-list t))
-	      (setq status (apply #'process-file command nil t nil squeezed)))
+              (condition-case err
+	          (setq status (apply #'process-file command nil t nil squeezed))
+                (error
+                 (pcase (car err)
+                   ('file-missing
+                    (if (string= (cadr err) "Searching for program")
+                        ;; The most probable is the lack of the backend binary.
+                        (signal 'vc-not-supported (cdr err))
+                      (signal (car err) (cdr err))))
+                   (_
+                    (signal (car err) (cdr err)))))))
 	    (when (and (not (eq t okstatus))
 		       (or (not (integerp status))
 			   (and okstatus (< okstatus status))))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 46a486a46c..dda00a8089 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -259,15 +259,18 @@ vc-git-registered
                ;; path specs.
                ;; See also: https://marc.info/?l=git&m=125787684318129&w=2
                (name (file-relative-name file dir))
-               (str (with-demoted-errors "Error: %S"
-                      (cd dir)
-                      (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
-                      ;; If result is empty, use ls-tree to check for deleted
-                      ;; file.
-                      (when (eq (point-min) (point-max))
-                        (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
-                                        "--" name))
-                      (buffer-string))))
+               (str (condition-case err
+                        (progn
+                          (cd dir)
+                          (vc-git-command (current-buffer) nil
+                                          name "ls-files" "-c" "-z" "--")
+                          ;; If result is empty, use ls-tree to check for deleted
+                          ;; file.
+                          (when (eq (point-min) (point-max))
+                            (vc-git-command (current-buffer) nil
+                                            name "ls-tree" "--name-only" "-z" "HEAD" "--"))
+                          (buffer-string))
+                      (error (signal (car err) (cdr err))))))
           (and str
                (> (length str) (length name))
                (string= (substring str 0 (1+ (length name)))
@@ -1775,7 +1778,8 @@ vc-git-command
   "A wrapper around `vc-do-command' for use in vc-git.el.
 The difference to vc-do-command is that this function always invokes
 `vc-git-program'."
-  (let ((coding-system-for-read
+  (let ((inhibit-null-byte-detection t)
+        (coding-system-for-read
          (or coding-system-for-read vc-git-log-output-coding-system))
 	(coding-system-for-write
          (or coding-system-for-write vc-git-commits-coding-system))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f4a44df3c2..713f0abd19 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -206,7 +206,7 @@ vc-hg-update-on-retrieve-tag
 (defun vc-hg-registered (file)
   "Return non-nil if FILE is registered with hg."
   (when (vc-hg-root file)           ; short cut
-    (let ((state (vc-state file 'Hg)))  ; expensive
+    (let ((state (vc-hg-state file)))
       (if (memq state '(ignored unregistered nil))
           ;; Clear the cache for proper fallback to another backend.
           (ignore (vc-file-setprop file 'vc-state nil))
@@ -228,23 +228,22 @@ vc-hg-state-slow
           (with-current-buffer
               standard-output
             (setq status
-                  (condition-case nil
-                      ;; Ignore all errors.
+                  (condition-case err
 		      (let ((process-environment
 			     ;; Avoid localization of messages so we
 			     ;; can parse the output.  Disable pager.
 			     (append
 			      (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
 			      process-environment)))
-			(process-file
-			 vc-hg-program nil t nil
+			(vc-hg-command (current-buffer) nil
+                         (file-relative-name file)
                          "--config" "ui.report_untrusted=0"
 			 "--config" "alias.status=status"
 			 "--config" "defaults.status="
-			 "status" "-A" (file-relative-name file)))
+			 "status" "-A"))
                     ;; Some problem happened.  E.g. We can't find an `hg'
                     ;; executable.
-                    (error nil)))))))
+                    (error (signal (car err) (cdr err)))))))))
     (when (and (eq 0 status)
 	       (> (length out) 0)
 	       (null (string-match ".*: No such file or directory$" out)))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 1f0eeb7e18..bd9acfc958 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -791,8 +791,15 @@ vc-refresh-state
     (add-hook 'vc-mode-line-hook #'vc-mode-line nil t)
     (let (backend)
       (cond
-       ((setq backend (with-demoted-errors "VC refresh error: %S"
-                        (vc-backend buffer-file-name)))
+       ((setq backend (condition-case err
+                          (vc-backend buffer-file-name)
+                        (error
+                         (pcase (car err)
+                           ('vc-not-supported
+                            (message "Warning: %S" err))
+                           (_
+                            (message "VC refresh error: %S" err)))
+                         nil)))
         ;; Let the backend setup any buffer-local things he needs.
         (vc-call-backend backend 'find-file-hook)
 	;; Compute the state and put it in the mode line.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 08b53a7169..7eb529a5d9 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -148,15 +148,14 @@ vc-svn-registered
       (cd (file-name-directory file))
       (let* (process-file-side-effects
 	     (status
-             (condition-case nil
-                 ;; Ignore all errors.
+             (condition-case err
                  (vc-svn-command t t file "status" "-v")
                ;; Some problem happened.  E.g. We can't find an `svn'
                ;; executable.  We used to only catch `file-error' but when
                ;; the process is run on a remote host via Tramp, the error
                ;; is only reported via the exit status which is turned into
                ;; an `error' by vc-do-command.
-               (error nil))))
+               (error (signal (car err) (cdr err))))))
         (when (eq 0 status)
 	  (let ((parsed (vc-svn-parse-status file)))
 	    (and parsed (not (memq parsed '(ignored unregistered))))))))))
-- 
2.36.0