* vc.el (vc-status-fileinfo): New defstruct.

(vc-status): New defvar
(vc-status-insert-headers, vc-status-printer, vc-status)
(vc-status-mode-map, vc-status-mode, vc-status-mark-file)
(vc-status-unmark-file, vc-status-marked-files): New functions.

* vc-hg.el (vc-hg-dir-status): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index caa9c0f71f15514e2922793db1a578bdb77f1198..4896c2c1f142f54e2dba48fc8916175836e380c7 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2008-01-06  Dan Nicolaescu  <dann@ics.uci.edu>
+
+       * vc.el (vc-status-fileinfo): New defstruct.
+       (vc-status): New defvar
+       (vc-status-insert-headers, vc-status-printer, vc-status)
+       (vc-status-mode-map, vc-status-mode, vc-status-mark-file)
+       (vc-status-unmark-file, vc-status-marked-files): New functions.
+
+       * vc-hg.el (vc-hg-dir-status): New function.
+
 2008-01-06  Martin Rudalics  <rudalics@gmx.at>
 
        * cus-edit.el (custom-tool-bar-map): Move initialization of this

diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el
index d921de9bbd9932fc0d51edc22c2acda3f03f92b1..081e469d4683cd39b19fe378453cf1daa1f1892a 100644 (file)
--- a/lisp/vc-hg.el
+++ b/lisp/vc-hg.el
@@ -477,6 +477,36 @@ REV is the revision to check out into WORKFILE."
 
 (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-dir-status (dir)
+  "Return a list of conses (file . state) for DIR."
+  (with-temp-buffer
+    (vc-hg-command (current-buffer) nil nil "status" "-A")
+    (goto-char (point-min))
+    (let ((status-char nil)
+         (file nil)
+         (translation '((?= . up-to-date)
+                        (?C . up-to-date)
+                        (?A . added)
+                        (?R . removed)
+                        (?M . edited)
+                        (?I . ignored)
+                        (?! . deleted)
+                        (?? . unregistered)))
+         (translated nil)
+         (result nil))
+      (while (not (eobp))
+       (setq status-char (char-after))
+       (setq file 
+             (buffer-substring-no-properties (+ (point) 2) 
+                                              (line-end-position)))
+       (setq translated (assoc status-char translation))
+       (when (and translated (not (eq (cdr translated) 'up-to-date)))
+         (push (cons file (cdr translated)) result))
+       (forward-line))
+      result)))
+
 ;; XXX this adds another top level menu, instead figure out how to
 ;; replace the Log-View menu.
 (easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map

diff --git a/lisp/vc.el b/lisp/vc.el
index 74ab1afeb208d38ec82c884caff6b2057c26964b..9e5df6865463c21bc62805e70ec36393ec7ee739 100644 (file)
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -1276,6 +1276,8 @@ Otherwise, throw an error."
                (unless (eq (vc-backend f) firstbackend)
                  (error "All members of a fileset must be under the same version-control system."))))
           marked))
+       ((eq major-mode 'vc-status-mode)
+        (vc-status-marked-files))
        ((vc-backend buffer-file-name)
         (list buffer-file-name))
        ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
@@ -2496,6 +2498,94 @@ With prefix arg READ-SWITCHES, specify a value to override
                               vc-dired-switches
                               'vc-dired-mode))))
 
+;;; Experimental code for the vc-dired replacement
+(require 'ewoc)
+
+(defstruct (vc-status-fileinfo
+            (:copier nil)
+            (:constructor vc-status-create-fileinfo (state name &optional marked))
+            (:conc-name vc-status-fileinfo->))
+  marked
+  state
+  name)
+
+(defvar vc-status nil)
+
+(defun vc-status-insert-headers (backend dir)
+  (insert (format "VC backend :%s\n" backend))
+  (insert "Repository : The repository goes here\n")
+  (insert (format "Working dir: %s\n\n\n" dir)))
+
+(defun vc-status-printer (fileentry)
+  "Pretty print FILEENTRY."
+  (insert
+   (format "%c   %-20s %s"
+          (if (vc-status-fileinfo->marked fileentry) ?* ? )
+          (vc-status-fileinfo->state fileentry)
+          (vc-status-fileinfo->name fileentry))))
+
+(defun vc-status (dir)
+  "Show the VC status for DIR."
+  (interactive "DVC status for directory: ")
+  (vc-setup-buffer "*vc-status*")
+  (switch-to-buffer "*vc-status*")
+  (cd dir)
+  (vc-status-mode))
+
+(defvar vc-status-mode-map 
+  (let ((map (make-sparse-keymap)))
+    (define-key map "m" 'vc-status-mark-file)
+    (define-key map "u" 'vc-status-unmark-file)
+    map)
+  "Keymap for VC status")
+
+(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)
+  (use-local-map vc-status-mode-map)
+  (let ((buffer-read-only nil)
+       (backend (vc-responsible-backend default-directory))
+       entries)
+    (erase-buffer)
+    (set (make-local-variable 'vc-status)
+        (ewoc-create #'vc-status-printer))
+    (vc-status-insert-headers backend default-directory)
+    (setq entries (vc-call-backend backend 'dir-status default-directory))
+    (dolist (entry entries)
+      (ewoc-enter-last 
+       vc-status (vc-status-create-fileinfo (cdr entry) (car entry))))))
+
+(defun vc-status-mark-file ()
+  "Mark the current file."
+  (interactive)
+  (let* ((crt (ewoc-locate vc-status))
+         (file (ewoc-data crt)))
+    (setf (vc-status-fileinfo->marked file) t)
+    (ewoc-invalidate vc-status crt)
+    (ewoc-goto-next vc-status 1)))
+
+(defun vc-status-unmark-file ()
+  "Mark the current file."
+  (interactive)
+  (let* ((crt (ewoc-locate vc-status))
+         (file (ewoc-data crt)))
+    (setf (vc-status-fileinfo->marked file) nil)
+    (ewoc-invalidate vc-status crt)
+    (ewoc-goto-next vc-status 1)))
+
+(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)))))
+
+;;; End experimental code.
 
 ;; Named-configuration entry points