Mercurial > emacs
changeset 94003:2ecb2ea8d5b5
Change `dir-status' to not take (and pass) status-buffer.
(vc-status-create-fileinfo): Make `extra' optional.
(vc-status-busy): New fun.
(vc-status-menu-map): Use it.
(vc-status-crt-marked): Remove.
(vc-status-update): Rename from vc-status-add-entries.
Add argument so as to prevent addition of entries. Rewrite.
(vc-update-vc-status-buffer): Remove.
(vc-status-refresh): Don't remove old entries, set them to
up-to-date instead. Also do it after the update is complete.
(vc-status-marked-files): ¦Ç-reduce.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 11 Apr 2008 15:17:59 +0000 |
| parents | bae1479690d4 |
| children | 0ab0b9641d80 |
| files | lisp/ChangeLog lisp/vc-bzr.el lisp/vc-cvs.el lisp/vc-git.el lisp/vc-hg.el lisp/vc-rcs.el lisp/vc-sccs.el lisp/vc-svn.el lisp/vc.el |
| diffstat | 9 files changed, 130 insertions(+), 126 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/ChangeLog Fri Apr 11 15:17:59 2008 +0000 @@ -1,5 +1,17 @@ 2008-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + * vc.el: Change `dir-status' to not take (and pass) status-buffer. + (vc-status-create-fileinfo): Make `extra' optional. + (vc-status-busy): New fun. + (vc-status-menu-map): Use it. + (vc-status-crt-marked): Remove. + (vc-status-update): Rename from vc-status-add-entries. + Add argument so as to prevent addition of entries. Rewrite. + (vc-update-vc-status-buffer): Remove. + (vc-status-refresh): Don't remove old entries, set them to + up-to-date instead. Also do it after the update is complete. + (vc-status-marked-files): η-reduce. + * dired.el (dired-read-dir-and-switches): Use read-directory-name even for non-dialogs.
--- a/lisp/vc-bzr.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-bzr.el Fri Apr 11 15:17:59 2008 +0000 @@ -658,7 +658,7 @@ (vc-default-dired-state-info 'Bzr file))) ;; XXX: this needs testing, it's probably incomplete. -(defun vc-bzr-after-dir-status (update-function status-buffer) +(defun vc-bzr-after-dir-status (update-function) (let ((status-str nil) (file nil) (translation '(("+N" . added) @@ -693,16 +693,16 @@ (line-end-position)) translated) result)) (forward-line)) - (funcall update-function result status-buffer))) + (funcall update-function result))) ;; XXX Experimental function for the vc-dired replacement. ;; XXX This probably needs some further refinement and testing. -(defun vc-bzr-dir-status (dir update-function status-buffer) +(defun vc-bzr-dir-status (dir update-function) "Return a list of conses (file . state) for DIR." ;; XXX: Is this the right command to use? (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S") (vc-exec-after - `(vc-bzr-after-dir-status (quote ,update-function) ,status-buffer))) + `(vc-bzr-after-dir-status (quote ,update-function)))) ;;; Revision completion
--- a/lisp/vc-cvs.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-cvs.el Fri Apr 11 15:17:59 2008 +0000 @@ -855,7 +855,7 @@ (forward-line 1)))) ;; XXX Experimental function for the vc-dired replacement. -(defun vc-cvs-after-dir-status (update-function status-buffer) +(defun vc-cvs-after-dir-status (update-function) ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack. ;; It needs a lot of testing. (let ((status nil) @@ -909,14 +909,14 @@ (push (list file status) result)))))) (goto-char (point-max)) (widen)) - (funcall update-function result status-buffer))) + (funcall update-function result))) ;; XXX Experimental function for the vc-dired replacement. -(defun vc-cvs-dir-status (dir update-function status-buffer) +(defun vc-cvs-dir-status (dir update-function) "Create a list of conses (file . state) for DIR." (vc-cvs-command (current-buffer) 'async dir "status") (vc-exec-after - `(vc-cvs-after-dir-status (quote ,update-function) ,status-buffer))) + `(vc-cvs-after-dir-status (quote ,update-function)))) (defun vc-cvs-get-entries (dir) "Insert the CVS/Entries file from below DIR into the current buffer.
--- a/lisp/vc-git.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-git.el Fri Apr 11 15:17:59 2008 +0000 @@ -313,13 +313,13 @@ ;; Variable used to keep the intermediate results for vc-git-status. (defvar vc-git-status-result nil) -(defun vc-git-after-dir-status-stage2 (update-function status-buffer) +(defun vc-git-after-dir-status-stage2 (update-function) (goto-char (point-min)) (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) vc-git-status-result)) - (funcall update-function (nreverse vc-git-status-result) status-buffer)) + (funcall update-function (nreverse vc-git-status-result))) -(defun vc-git-after-dir-status-stage1 (update-function status-buffer) +(defun vc-git-after-dir-status-stage1 (update-function) (goto-char (point-min)) (while (re-search-forward ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" @@ -339,9 +339,9 @@ (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o" "--directory" "--no-empty-directory" "--exclude-standard") (vc-exec-after - `(vc-git-after-dir-status-stage2 (quote ,update-function) ,status-buffer))) + `(vc-git-after-dir-status-stage2 (quote ,update-function)))) -(defun vc-git-after-dir-status-stage1-empty-db (update-function status-buffer) +(defun vc-git-after-dir-status-stage1-empty-db (update-function) (goto-char (point-min)) (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) (let ((new-perm (string-to-number (match-string 1) 8)) @@ -351,9 +351,9 @@ (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o" "--directory" "--no-empty-directory" "--exclude-standard") (vc-exec-after - `(vc-git-after-dir-status-stage2 (quote ,update-function) ,status-buffer))) + `(vc-git-after-dir-status-stage2 (quote ,update-function)))) -(defun vc-git-dir-status (dir update-function status-buffer) +(defun vc-git-dir-status (dir update-function) "Return a list of conses (file . state) for DIR." ;; Further things that would have to be fixed later: ;; - how to handle unregistered directories @@ -364,10 +364,10 @@ (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-c" "-s") (vc-exec-after `(vc-git-after-dir-status-stage1-empty-db - (quote ,update-function) ,status-buffer))) + (quote ,update-function)))) (vc-git-command (current-buffer) 'async nil "diff-index" "-z" "-M" "HEAD") (vc-exec-after - `(vc-git-after-dir-status-stage1 (quote ,update-function) ,status-buffer)))) + `(vc-git-after-dir-status-stage1 (quote ,update-function))))) (defun vc-git-status-extra-headers (dir) (let ((str (with-output-to-string
--- a/lisp/vc-hg.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-hg.el Fri Apr 11 15:17:59 2008 +0000 @@ -475,7 +475,7 @@ (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") ;; XXX Experimental function for the vc-dired replacement. -(defun vc-hg-after-dir-status (update-function status-buffer) +(defun vc-hg-after-dir-status (update-function) (let ((status-char nil) (file nil) (translation '((?= . up-to-date) @@ -498,13 +498,13 @@ (when (and translated (not (eq (cdr translated) 'up-to-date))) (push (list file (cdr translated)) result)) (forward-line)) - (funcall update-function result status-buffer))) + (funcall update-function result))) ;; XXX Experimental function for the vc-dired replacement. -(defun vc-hg-dir-status (dir update-function status-buffer) +(defun vc-hg-dir-status (dir update-function) (vc-hg-command (current-buffer) 'async dir "status") (vc-exec-after - `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer))) + `(vc-hg-after-dir-status (quote ,update-function)))) ;; XXX this adds another top level menu, instead figure out how to ;; replace the Log-View menu.
--- a/lisp/vc-rcs.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-rcs.el Fri Apr 11 15:17:59 2008 +0000 @@ -182,7 +182,7 @@ (vc-rcs-state file))))) ;; XXX Experimental function for the vc-dired replacement. -(defun vc-rcs-dir-status (dir update-function status-buffer) +(defun vc-rcs-dir-status (dir update-function) ;; XXX: quick hack, there should be a better way to do this, ;; but it's not worse than vc-dired :-). (let ((flist (vc-expand-dirs (list dir))) @@ -191,7 +191,7 @@ (let ((state (vc-state file)) (frel (file-relative-name file))) (push (list frel state) result))) - (funcall update-function result status-buffer))) + (funcall update-function result))) (defun vc-rcs-working-revision (file) "RCS-specific version of `vc-working-revision'."
--- a/lisp/vc-sccs.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-sccs.el Fri Apr 11 15:17:59 2008 +0000 @@ -145,7 +145,7 @@ (vc-sccs-state file))) ;; XXX Experimental function for the vc-dired replacement. -(defun vc-sccs-dir-status (dir update-function status-buffer) +(defun vc-sccs-dir-status (dir update-function) ;; XXX: quick hack, there should be a better way to do this, ;; but it's not worse than vc-dired :-). (let ((flist (vc-expand-dirs (list dir))) @@ -154,7 +154,7 @@ (let ((state (vc-state file)) (frel (file-relative-name file))) (push (list frel state) result))) - (funcall update-function result status-buffer))) + (funcall update-function result))) (defun vc-sccs-working-revision (file) "SCCS-specific version of `vc-working-revision'."
--- a/lisp/vc-svn.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc-svn.el Fri Apr 11 15:17:59 2008 +0000 @@ -158,7 +158,7 @@ (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) (vc-svn-parse-status)))) -(defun vc-svn-after-dir-status (callback buffer) +(defun vc-svn-after-dir-status (callback) (let ((state-map '((?A . added) (?C . conflict) (?D . removed) @@ -177,13 +177,13 @@ (setq result (cons (list filename state) result))))) (funcall callback result buffer))) -(defun vc-svn-dir-status (dir callback buffer) +(defun vc-svn-dir-status (dir callback) "Run 'svn status' for DIR and update BUFFER via CALLBACK. CALLBACK is called as (CALLBACK RESULT BUFFER), where RESULT is a list of conses (FILE . STATE) for directory DIR." (vc-svn-command (current-buffer) 'async nil "status") (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback) ,buffer))) + `(vc-svn-after-dir-status (quote ,callback)))) (defun vc-svn-working-revision (file) "SVN-specific version of `vc-working-revision'."
--- a/lisp/vc.el Fri Apr 11 13:34:14 2008 +0000 +++ b/lisp/vc.el Fri Apr 11 15:17:59 2008 +0000 @@ -168,7 +168,7 @@ ;; in older versions this method was not required to recurse into ;; subdirectories.) ;; -;; - dir-status (dir update-function status-buffer) +;; - dir-status (dir update-function) ;; ;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA) ;; for the files in DIR. @@ -176,11 +176,11 @@ ;; If a command needs to be run to compute this list, it should be ;; run asynchronously using (current-buffer) as the buffer for the ;; command. When RESULT is computed, it should be passed back by -;; doing: (funcall UPDATE-FUNCTION RESULT STATUS-BUFFER nil). +;; doing: (funcall UPDATE-FUNCTION RESULT nil). ;; If the backend uses a process filter, hence it produces partial results, ;; they can be passed back by doing: -;; (funcall UPDATE-FUNCTION RESULT STATUS-BUFFER t) -;; and then do a (funcall UPDATE-FUNCTION RESULT STATUS-BUFFER nil) +;; (funcall UPDATE-FUNCTION RESULT t) +;; and then do a (funcall UPDATE-FUNCTION RESULT nil) ;; when all the results have been computed. ;; To provide more backend specific functionality for `vc-status' ;; the following functions might be needed: `status-extra-headers', @@ -582,6 +582,9 @@ ;;; Todo: +;; - vc-status-kill-dir-status-process should not be specific to dir-status, +;; it should work for other async commands as well (pull/push/...). +;; ;; - vc-update/vc-merge should deal with VC systems that don't ;; update/merge on a file basis, but on a whole repository basis. ;; @@ -1438,10 +1441,8 @@ (error "All members of a fileset must be under the same version-control system.")))) marked)) ((eq major-mode 'vc-status-mode) - (let ((marked (vc-status-marked-files))) - (if marked - marked - (list (vc-status-current-file))))) + (or (vc-status-marked-files) + (list (vc-status-current-file)))) ((vc-backend buffer-file-name) (list buffer-file-name)) ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) @@ -2705,14 +2706,16 @@ ;; Each item displayed corresponds to one of these defstructs. (defstruct (vc-status-fileinfo (:copier nil) + (:type list) ;So we can use `member' on lists of FIs. (:constructor - vc-status-create-fileinfo (name state extra &optional marked)) + ;; We could define it as an alias for `list'. + vc-status-create-fileinfo (name state &optional extra marked)) (:conc-name vc-status-fileinfo->)) - marked + name ;Keep it as first, for `member'. state - name ;; For storing backend specific information. - extra) + extra + marked) (defvar vc-status nil) @@ -2804,11 +2807,11 @@ :help "Quit")) (define-key map [kill] '(menu-item "Kill Update Command" vc-status-kill-dir-status-process - :enable vc-status-process-buffer + :enable (vc-status-busy) :help "Kill the command that updates VC status buffer")) (define-key map [refresh] '(menu-item "Refresh" vc-status-refresh - :enable (not vc-status-process-buffer) + :enable (not (vc-status-busy)) :help "Refresh the contents of the VC status buffer")) (define-key map [remup] '(menu-item "Hide up-to-date" vc-status-hide-up-to-date @@ -2974,16 +2977,12 @@ (defvar vc-status-process-buffer nil "The buffer used for the asynchronous call that computes the VC status.") -(defvar vc-status-crt-marked nil - "The list of marked files before `vc-status-refresh'.") - (defun vc-status-mode () "Major mode for VC status. \\{vc-status-mode-map}" (setq mode-name "VC Status") (setq major-mode 'vc-status-mode) (setq buffer-read-only t) - (set (make-local-variable 'vc-status-crt-marked) nil) (use-local-map vc-status-mode-map) (set (make-local-variable 'tool-bar-map) vc-status-tool-bar-map) (let ((buffer-read-only nil) @@ -2999,76 +2998,52 @@ (put 'vc-status-mode 'mode-class 'special) -(defun vc-status-add-entries (entries buffer) +(defun vc-status-update (entries buffer &optional noinsert) + "Update BUFFER's ewoc from the list of ENTRIES. +If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." ;; Add ENTRIES to the vc-status buffer BUFFER. (with-current-buffer buffer - (when entries - ;; Insert the entries sorted by name into the ewoc. - ;; We assume the ewoc is sorted too, which should be the - ;; case if we always add entries with vc-status-add-entries. - (setq entries (sort (copy-sequence entries) - (lambda (entry1 entry2) - (string-lessp (car entry1) (car entry2))))) - (let ((entry (pop entries)) - (node (ewoc-nth vc-status 0))) - (while entry - (while (and vc-status-crt-marked - (string-lessp (car vc-status-crt-marked) (car entry))) - (setq vc-status-crt-marked (cdr vc-status-crt-marked))) - (let* ((file (car entry)) - (state (nth 1 entry)) - (extra (nth 2 entry)) - (marked (and vc-status-crt-marked - (string-equal (car vc-status-crt-marked) file)))) - (cond ((not node) - (setq node (ewoc-enter-last vc-status - (vc-status-create-fileinfo file state extra marked))) - (setq entry (pop entries))) - ((string-lessp (vc-status-fileinfo->name (ewoc-data node)) file) - (setq node (ewoc-next vc-status node))) - ((string-equal (vc-status-fileinfo->name (ewoc-data node)) file) - (setf (vc-status-fileinfo->state (ewoc-data node)) state) - (setf (vc-status-fileinfo->extra (ewoc-data node)) extra) - (ewoc-invalidate vc-status node) - (setq entry (pop entries))) - (t - (setq node (ewoc-enter-before vc-status node - (vc-status-create-fileinfo file state extra marked))) - (setq entry (pop entries)))))))))) - -(defun vc-update-vc-status-buffer (entries buffer &optional more-to-come) - ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items. - ;; BUFFER is the *vc-status* buffer to be updated with ENTRIES - ;; If MORE-TO-COME is true, then more updates will come from the - ;; asynchronous process. - (with-current-buffer buffer - (when entries - (vc-status-add-entries entries buffer) - (ewoc-goto-node vc-status (ewoc-nth vc-status 0))) - ;; No more updates are expected from the asynchronous process. - (unless more-to-come - (setq vc-status-process-buffer nil) - ;; We are done, turn off the mode-line "in progress" message. - (setq mode-line-process nil)))) + ;; Insert the entries sorted by name into the ewoc. + ;; We assume the ewoc is sorted too, which should be the + ;; case if we always add entries with vc-status-update. + (setq entries (sort entries + (lambda (entry1 entry2) + (string-lessp (car entry1) (car entry2))))) + (let ((entry (car entries)) + (node (ewoc-nth vc-status 0))) + (while (and entry node) + (let ((entryfile (car entry)) + (nodefile (vc-status-fileinfo->name (ewoc-data node)))) + (cond + ((string-lessp nodefile entryfile) + (setq node (ewoc-next vc-status node))) + ((string-lessp nodefile entryfile) + (unless noinsert + (ewoc-enter-before vc-status node + (apply 'vc-status-create-fileinfo entry))) + (setq entries (cdr entries) entry (car entries))) + (t + (setf (vc-status-fileinfo->state (ewoc-data node)) (nth 1 entry)) + (setf (vc-status-fileinfo->extra (ewoc-data node)) (nth 2 entry)) + (ewoc-invalidate vc-status node) + (setq entries (cdr entries) entry (car entries)) + (setq node (ewoc-next vc-status node)))))) + (unless (or node noinsert) + ;; We're past the last node, all remaining entries go to the end. + (while entries + (ewoc-enter-last vc-status + (apply 'vc-status-create-fileinfo (pop entries)))))))) + +(defun vc-status-busy () + (and (buffer-live-p vc-status-process-buffer) + (get-buffer-process vc-status-process-buffer))) (defun vc-status-refresh () "Refresh the contents of the VC status buffer. Throw an error if another update process is in progress." (interactive) - (if vc-status-process-buffer + (if (vc-status-busy) (error "Another update process is in progress, cannot run two at a time") - ;; We clear the ewoc, but remember the marked files so that we can - ;; mark them again after the refresh is done. - ;; This is not very efficient; ewoc could use a new function here. - (setq vc-status-crt-marked - (mapcar - (lambda (elem) - (vc-status-fileinfo->name elem)) - (ewoc-collect - vc-status - (lambda (crt) (vc-status-fileinfo->marked crt))))) - (ewoc-filter vc-status (lambda (node) nil)) - (let ((backend (vc-responsible-backend default-directory)) (status-buffer (current-buffer)) (def-dir default-directory)) @@ -3084,14 +3059,35 @@ ;; `vc-status-process-buffer' to remember this buffer, so that ;; it can be used later to kill the update process in case it ;; takes too long. - (setq vc-status-process-buffer - (get-buffer-create - (generate-new-buffer-name (format " *VC-%s* tmp status" backend)))) - (with-current-buffer vc-status-process-buffer - (cd def-dir) - (erase-buffer) - (vc-call-backend backend 'dir-status def-dir - #'vc-update-vc-status-buffer status-buffer))))) + (unless (buffer-live-p vc-status-process-buffer) + (setq vc-status-process-buffer + (generate-new-buffer (format " *VC-%s* tmp status" backend)))) + (lexical-let ((oldentries (ewoc-collect vc-status (lambda (_) t))) + (buffer (current-buffer))) + (with-current-buffer vc-status-process-buffer + (cd def-dir) + (erase-buffer) + (vc-call-backend + backend 'dir-status def-dir + (lambda (entries &optional more-to-come) + ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items. + ;; If MORE-TO-COME is true, then more updates will come from + ;; the asynchronous process. + (with-current-buffer buffer + (dolist (entry entries) + (setq oldentries + (delq (member (car entry) oldentries) oldentries))) + (vc-status-update entries buffer) + (ewoc-goto-node vc-status (ewoc-nth vc-status 0)) + ;; No more updates are expected from the asynchronous process. + (unless more-to-come + ;; We are done, turn off the mode-line "in progress" message. + (setq mode-line-process nil) + ;; Update old entries that were not mentioned, and were + ;; hence implicitly given as uptodate. + (dolist (entry oldentries) + (setf (vc-status-fileinfo->state entry) 'up-to-date)) + (vc-status-update oldentries buffer 'noinsert)))))))))) (defun vc-status-kill-dir-status-process () "Kill the temporary buffer and associated process." @@ -3236,10 +3232,9 @@ (defun vc-status-register () "Register the marked files, or the current file if no marks." (interactive) - (let ((files (or (vc-status-marked-files) - (list (vc-status-current-file))))) - (dolist (file files) - (vc-register file)))) + ;; FIXME: Just pass the fileset to vc-register. + (mapc 'vc-register (or (vc-status-marked-files) + (list (vc-status-current-file))))) (defun vc-status-find-file () "Find the file on the current line." @@ -3260,11 +3255,8 @@ (defun vc-status-marked-files () "Return the list of marked files" (mapcar - (lambda (elem) - (expand-file-name (vc-status-fileinfo->name elem))) - (ewoc-collect - vc-status - (lambda (crt) (vc-status-fileinfo->marked crt))))) + (lambda (elem) (expand-file-name (vc-status-fileinfo->name elem))) + (ewoc-collect vc-status 'vc-status-fileinfo->marked))) (defun vc-status-hide-up-to-date () "Hide up-to-date items from display." @@ -3297,7 +3289,7 @@ (vc-call-backend backend 'status-fileinfo-extra file))) (entry (list file-short (if state state 'unregistered) extra))) - (vc-status-add-entries (list entry) status-buf)))))) + (vc-status-update (list entry) status-buf)))))) ;; We didn't find any vc-status buffers, remove the hook, it is ;; not needed. (unless found-vc-status-buf (remove-hook 'after-save-hook 'vc-status-mark-buffer-changed)))))