From befbe14487c1ba4ee2a98edb8dc6ef1f111d9fbd Mon Sep 17 00:00:00 2001 From: Simon Tournier 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:: - ;; | : - ;; | - ;; 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:: + ;; | : + ;; | + ;; 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