Mercurial > emacs
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.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Sun, 06 Jan 2008 10:20:26 +0000 |
parents | 46e7050d6d6e |
children | 8f58e29f466a |
files | lisp/ChangeLog lisp/vc-hg.el lisp/vc.el |
diffstat | 3 files changed, 130 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- 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 @@ +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
--- 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