changeset 87599:efe45ef69877

* 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.

--- a/lisp/ChangeLog	Sun Jan 06 09:49:16 2008 +0000
+++ b/lisp/ChangeLog	Sun Jan 06 10:20:26 2008 +0000
@@ -1,3 +1,13 @@
[phone]  Dan Nicolaescu  <[e-mail]>
+
+	* 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  <[e-mail]>
 
 	* cus-edit.el (custom-tool-bar-map): Move initialization of this

--- a/lisp/vc-hg.el	Sun Jan 06 09:49:16 2008 +0000
+++ b/lisp/vc-hg.el	Sun Jan 06 10:20:26 2008 +0000
@@ -477,6 +477,36 @@
 
 (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

--- a/lisp/vc.el	Sun Jan 06 09:49:16 2008 +0000
+++ b/lisp/vc.el	Sun Jan 06 10:20:26 2008 +0000
@@ -1276,6 +1276,8 @@
                (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 @@
                               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