Commit 8fcaf22f authored by Dan Nicolaescu's avatar Dan Nicolaescu
Browse files

* 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.
parent 2614ccc3
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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment