From: Wolfgang Scherer <Wolfgang.Scherer@gmx.de>
To: 39502@debbugs.gnu.org
Subject: bug#39502: Acknowledgement ([PATCH] Use one src status -a call for vc-src-dir-status-files)
Date: Sat, 8 Feb 2020 06:35:01 +0100 [thread overview]
Message-ID: <f7e4b0c8-e66e-1024-dca2-b88e34ee275d@gmx.de> (raw)
In-Reply-To: <handler.39502.B.158111597418374.ack@debbugs.gnu.org>
[-- Attachment #1: Type: text/plain, Size: 43 bytes --]
Additional recursion into sub-directories.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-one-src-status-a-call-for-vc-src-dir-status-file.patch --]
[-- Type: text/x-patch; name="0001-Use-one-src-status-a-call-for-vc-src-dir-status-file.patch", Size: 4719 bytes --]
From 3ccf917bab849e438998d4717176efec46df6b98 Mon Sep 17 00:00:00 2001
From: Wolfgang Scherer <wolfgang.scherer@gmx.de>
Date: Sat, 8 Feb 2020 06:15:10 +0100
Subject: [PATCH] Use one src status -a call for vc-src-dir-status-files
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
lisp/vc/vc-src.el: (vc-src--parse-state) new function.
(vc-src-state) use vc-src--parse-state.
(vc-src-dir-status-files) use recursive calls to ‘src status -a’.
---
lisp/vc/vc-src.el | 90 +++++++++++++++++++++++++++++++++++--------------------
1 file changed, 58 insertions(+), 32 deletions(-)
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee..ca1b7d6 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -146,49 +146,75 @@ For a description of possible values, see `vc-check-master-templates'."
(progn
(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src--parse-state (out)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about L code?
+ ((eq state ?.) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ (t 'up-to-date)))))
+
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
(let*
((status nil)
(default-directory (file-name-directory file))
(out
- (with-output-to-string
- (with-current-buffer
- standard-output
- (setq status
- ;; Ignore all errors.
- (condition-case nil
- (process-file
- vc-src-program nil t nil
- "status" "-a" (file-relative-name file))
- (error nil)))))))
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (setq status
+ ;; Ignore all errors.
+ (condition-case nil
+ (process-file
+ vc-src-program nil t nil
+ "status" "-a" (file-relative-name file))
+ (error nil)))))))
(when (eq 0 status)
- (when (null (string-match "does not exist or is unreadable" out))
- (let ((state (aref out 0)))
- (cond
- ;; FIXME: What to do about A and L codes?
- ((eq state ?.) 'up-to-date)
- ((eq state ?A) 'added)
- ((eq state ?M) 'edited)
- ((eq state ?I) 'ignored)
- ((eq state ?R) 'removed)
- ((eq state ?!) 'missing)
- ((eq state ??) 'unregistered)
- (t 'up-to-date)))))))
+ (vc-src--parse-state out))))
(autoload 'vc-expand-dirs "vc")
(defun vc-src-dir-status-files (dir files update-function)
- ;; FIXME: Use one src status -a call for this
- (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC)))
- (let ((result nil))
- (dolist (file files)
- (let ((state (vc-state file))
- (frel (file-relative-name file)))
- (when (and (eq (vc-backend file) 'SRC)
- (not (eq state 'up-to-date)))
- (push (list frel state) result))))
- (funcall update-function result)))
+ (let*
+ ((result nil)
+ (status nil)
+ (default-directory (or dir default-directory))
+ (out
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (setq status
+ ;; Ignore all errors.
+ (condition-case nil
+ (apply
+ #'process-file vc-src-program nil t nil
+ "status" "-a"
+ (mapcar (lambda (f) (file-relative-name f)) files))
+ (error nil))))))
+ dlist)
+ (when (eq 0 status)
+ (dolist (line (split-string out "[\n\r]" t))
+ (let* ((pair (split-string line "[\t]" t))
+ (state (vc-src--parse-state (car pair)))
+ (frel (cadr pair)))
+ (if (file-directory-p frel)
+ (push frel dlist)
+ (when (not (eq state 'up-to-date))
+ (push (list frel state) result)))
+ ))
+ (dolist (drel dlist)
+ (let* ((dresult (vc-src-dir-status-files (expand-file-name drel) nil #'identity)))
+ (dolist (dres dresult)
+ (push (list (concat (file-name-as-directory drel) (car dres)) (cadr dres)) result)))
+ )
+ (funcall update-function result))))
(defun vc-src-command (buffer file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-src.el.
--
2.7.4
next prev parent reply other threads:[~2020-02-08 5:35 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-02-07 22:52 bug#39502: [PATCH] Use one src status -a call for vc-src-dir-status-files Wolfgang Scherer
[not found] ` <handler.39502.B.158111597418374.ack@debbugs.gnu.org>
2020-02-08 5:35 ` Wolfgang Scherer [this message]
2020-02-08 9:39 ` Dmitry Gutov
2020-02-10 0:47 ` Wolfgang Scherer
2020-02-10 4:29 ` Dmitry Gutov
2020-02-11 2:54 ` Wolfgang Scherer
2020-02-11 7:46 ` Dmitry Gutov
2020-02-14 10:05 ` Eli Zaretskii
2020-02-15 2:44 ` Wolfgang Scherer
2020-08-09 11:31 ` Lars Ingebrigtsen
2020-08-09 14:13 ` Eli Zaretskii
2020-08-09 17:42 ` Dmitry Gutov
2020-08-09 19:50 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=f7e4b0c8-e66e-1024-dca2-b88e34ee275d@gmx.de \
--to=wolfgang.scherer@gmx.de \
--cc=39502@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).