From 3ccf917bab849e438998d4717176efec46df6b98 Mon Sep 17 00:00:00 2001 From: Wolfgang Scherer 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