aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAlexandre Julliard2008-04-13 18:07:54 +0000
committerAlexandre Julliard2008-04-13 18:07:54 +0000
commitd41080ca3f4df045073ee531a6ce8267c1cf75f9 (patch)
treeb3a5958886cd850a3a401b2727c71d68324c8730
parentfb0ac090ccac3142e52615a569286158d3a3d952 (diff)
downloademacs-d41080ca3f4df045073ee531a6ce8267c1cf75f9.tar.gz
emacs-d41080ca3f4df045073ee531a6ce8267c1cf75f9.zip
(vc-git-after-dir-status-stage)
(vc-git-dir-status-goto-stage): New functions. (vc-git-after-dir-status-stage1) (vc-git-after-dir-status-stage1-empty-db) (vc-git-after-dir-status-stage2): Removed, functionality moved into the new generic stage functions. (vc-git-dir-status-files): New function.
-rw-r--r--lisp/ChangeLog17
-rw-r--r--lisp/vc-git.el127
2 files changed, 93 insertions, 51 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c3cede9b75a..13375be784a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
12008-04-13 Alexandre Julliard <julliard@winehq.org>
2
3 * vc-git.el (vc-git-after-dir-status-stage)
4 (vc-git-dir-status-goto-stage): New functions.
5 (vc-git-after-dir-status-stage1)
6 (vc-git-after-dir-status-stage1-empty-db)
7 (vc-git-after-dir-status-stage2): Removed, functionality moved
8 into the new generic stage functions.
9 (vc-git-dir-status-files): New function.
10
11 * vc.el (vc-status-update): Revert an incorrect rewrite. Add some
12 comments.
13 (vc-status-refresh-files): New function.
14 (vc-status-refresh): Use `vc-status-refresh-files' to refresh the
15 state of up-to-date files.
16 (vc-default-dir-status-files): New function.
17
12008-04-13 Juanma Barranquero <lekktu@gmail.com> 182008-04-13 Juanma Barranquero <lekktu@gmail.com>
2 19
3 * minibuffer.el (completion--embedded-envvar-table) 20 * minibuffer.el (completion--embedded-envvar-table)
diff --git a/lisp/vc-git.el b/lisp/vc-git.el
index e1276955aeb..70ef18cf8f5 100644
--- a/lisp/vc-git.el
+++ b/lisp/vc-git.el
@@ -310,64 +310,89 @@
310 (vc-git-file-type-as-string old-perm new-perm) 310 (vc-git-file-type-as-string old-perm new-perm)
311 (vc-git-rename-as-string state extra)))) 311 (vc-git-rename-as-string state extra))))
312 312
313;; Variable used to keep the intermediate results for vc-git-status. 313(defun vc-git-after-dir-status-stage (stage files update-function)
314(defvar vc-git-status-result nil) 314 "Process sentinel for the various dir-status stages."
315 315 (let (remaining next-stage result)
316(defun vc-git-after-dir-status-stage2 (update-function) 316 (goto-char (point-min))
317 (goto-char (point-min)) 317 (case stage
318 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) 318 ('update-index
319 (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) vc-git-status-result)) 319 (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
320 (funcall update-function (nreverse vc-git-status-result))) 320 (if files 'ls-files-up-to-date 'diff-index))))
321 321 ('ls-files-added
322(defun vc-git-after-dir-status-stage1 (update-function) 322 (setq next-stage 'ls-files-unknown)
323 (goto-char (point-min)) 323 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
324 (while (re-search-forward 324 (let ((new-perm (string-to-number (match-string 1) 8))
325 ":\\([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" 325 (name (match-string 2)))
326 nil t 1) 326 (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) result))))
327 (let ((old-perm (string-to-number (match-string 1) 8)) 327 ('ls-files-up-to-date
328 (new-perm (string-to-number (match-string 2) 8)) 328 (setq next-stage 'diff-index)
329 (state (or (match-string 4) (match-string 6))) 329 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
330 (name (or (match-string 5) (match-string 7))) 330 (let ((perm (string-to-number (match-string 1) 8))
331 (new-name (match-string 8))) 331 (name (match-string 2)))
332 (if new-name ; copy or rename 332 (push (list name 'up-to-date (vc-git-create-extra-fileinfo perm perm)) result))))
333 (if (eq ?C (string-to-char state)) 333 ('ls-files-unknown
334 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) vc-git-status-result) 334 (when files (setq next-stage 'ls-files-ignored))
335 (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) vc-git-status-result) 335 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
336 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) vc-git-status-result)) 336 (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) result)))
337 (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) vc-git-status-result)))) 337 ('ls-files-ignored
338 (erase-buffer) 338 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
339 (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o" 339 (push (list (match-string 1) 'ignored (vc-git-create-extra-fileinfo 0 0)) result)))
340 "--directory" "--no-empty-directory" "--exclude-standard") 340 ('diff-index
341 (vc-exec-after 341 (setq next-stage 'ls-files-unknown)
342 `(vc-git-after-dir-status-stage2 (quote ,update-function)))) 342 (while (re-search-forward
343 343 ":\\([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"
344(defun vc-git-after-dir-status-stage1-empty-db (update-function) 344 nil t 1)
345 (goto-char (point-min)) 345 (let ((old-perm (string-to-number (match-string 1) 8))
346 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) 346 (new-perm (string-to-number (match-string 2) 8))
347 (let ((new-perm (string-to-number (match-string 1) 8)) 347 (state (or (match-string 4) (match-string 6)))
348 (name (match-string 2))) 348 (name (or (match-string 5) (match-string 7)))
349 (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) vc-git-status-result))) 349 (new-name (match-string 8)))
350 (if new-name ; copy or rename
351 (if (eq ?C (string-to-char state))
352 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) result)
353 (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) result)
354 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) result))
355 (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) result))))))
356 (when result
357 (setq result (nreverse result))
358 (when files
359 (dolist (entry result) (setq files (delete (car entry) files)))
360 (unless files (setq next-stage nil))))
361 (when (or result (not next-stage)) (funcall update-function result next-stage))
362 (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function))))
363
364(defun vc-git-dir-status-goto-stage (stage files update-function)
350 (erase-buffer) 365 (erase-buffer)
351 (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o" 366 (case stage
352 "--directory" "--no-empty-directory" "--exclude-standard") 367 ('update-index
368 (if files
369 (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
370 (vc-git-command (current-buffer) 'async nil "update-index" "--refresh")))
371 ('ls-files-added
372 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
373 ('ls-files-up-to-date
374 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
375 ('ls-files-unknown
376 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o"
377 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
378 ('ls-files-ignored
379 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "-i"
380 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
381 ('diff-index
382 (vc-git-command (current-buffer) 'async files "diff-index" "-z" "-M" "HEAD" "--")))
353 (vc-exec-after 383 (vc-exec-after
354 `(vc-git-after-dir-status-stage2 (quote ,update-function)))) 384 `(vc-git-after-dir-status-stage (quote ,stage) (quote ,files) (quote ,update-function))))
355 385
356(defun vc-git-dir-status (dir update-function) 386(defun vc-git-dir-status (dir update-function)
357 "Return a list of conses (file . state) for DIR." 387 "Return a list of (FILE STATE EXTRA) entries for DIR."
358 ;; Further things that would have to be fixed later: 388 ;; Further things that would have to be fixed later:
359 ;; - how to handle unregistered directories 389 ;; - how to handle unregistered directories
360 ;; - how to support vc-status on a subdir of the project tree 390 ;; - how to support vc-status on a subdir of the project tree
361 (set (make-local-variable 'vc-git-status-result) nil) 391 (vc-git-dir-status-goto-stage 'update-index nil update-function))
362 (if (vc-git--empty-db-p) 392
363 (progn 393(defun vc-git-dir-status-files (dir files default-state update-function)
364 (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-c" "-s") 394 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
365 (vc-exec-after 395 (vc-git-dir-status-goto-stage 'update-index files update-function))
366 `(vc-git-after-dir-status-stage1-empty-db
367 (quote ,update-function))))
368 (vc-git-command (current-buffer) 'async nil "diff-index" "-z" "-M" "HEAD")
369 (vc-exec-after
370 `(vc-git-after-dir-status-stage1 (quote ,update-function)))))
371 396
372(defun vc-git-status-extra-headers (dir) 397(defun vc-git-status-extra-headers (dir)
373 (let ((str (with-output-to-string 398 (let ((str (with-output-to-string