diff options
| author | Alexandre Julliard | 2008-04-13 18:07:54 +0000 |
|---|---|---|
| committer | Alexandre Julliard | 2008-04-13 18:07:54 +0000 |
| commit | d41080ca3f4df045073ee531a6ce8267c1cf75f9 (patch) | |
| tree | b3a5958886cd850a3a401b2727c71d68324c8730 | |
| parent | fb0ac090ccac3142e52615a569286158d3a3d952 (diff) | |
| download | emacs-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/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/vc-git.el | 127 |
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 @@ | |||
| 1 | 2008-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 | |||
| 1 | 2008-04-13 Juanma Barranquero <lekktu@gmail.com> | 18 | 2008-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 |