[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/vc.el,v
|
From: |
Eric S. Raymond |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/vc.el,v |
|
Date: |
Sat, 03 May 2008 09:28:05 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Eric S. Raymond <esr> 08/05/03 09:28:04
Index: vc.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/vc.el,v
retrieving revision 1.617
retrieving revision 1.618
diff -u -b -r1.617 -r1.618
--- vc.el 3 May 2008 07:39:17 -0000 1.617
+++ vc.el 3 May 2008 09:28:04 -0000 1.618
@@ -693,6 +693,11 @@
(require 'tool-bar)
(require 'ewoc)
+(eval-when-compile
+ (require 'cl)
+ (require 'dired) ; for dired-map-over-marks macro
+ (require 'dired-aux)) ; for dired-kill-{line,tree}
+
(unless (assoc 'vc-parent-buffer minor-mode-alist)
(setq minor-mode-alist
(cons '(vc-parent-buffer vc-parent-buffer-name)
@@ -709,6 +714,14 @@
:type 'boolean
:group 'vc)
+(defcustom vc-delete-logbuf-window t
+ "If non-nil, delete the *VC-log* buffer and window after each logical action.
+If nil, bury that buffer instead.
+This is most useful if you have multiple windows on a frame and would like to
+preserve the setting."
+ :type 'boolean
+ :group 'vc)
+
(defcustom vc-initial-comment nil
"If non-nil, prompt for initial comment when a file is registered."
:type 'boolean
@@ -722,6 +735,11 @@
:group 'vc
:version "20.3")
+(defcustom vc-command-messages nil
+ "If non-nil, display run messages from back-end commands."
+ :type 'boolean
+ :group 'vc)
+
(defcustom vc-checkin-switches nil
"A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
@@ -752,6 +770,24 @@
string))
:group 'vc)
+(defcustom vc-dired-listing-switches "-al"
+ "Switches passed to `ls' for vc-dired. MUST contain the `l' option."
+ :type 'string
+ :group 'vc
+ :version "21.1")
+
+(defcustom vc-dired-recurse t
+ "If non-nil, show directory trees recursively in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
+(defcustom vc-dired-terse-display t
+ "If non-nil, show only locked or locally modified files in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
When running diff under a given BACKEND, VC concatenates the values of
@@ -822,6 +858,12 @@
:type 'hook
:group 'vc)
+(defcustom vc-dir-mode-hook nil
+ "Normal hook run by `vc-dir-mode'.
+See `run-hooks'."
+ :type 'hook
+ :group 'vc)
+
;; Annotate customization
(defcustom vc-annotate-color-map
(if (and (tty-display-color-p) (<= (display-color-cells) 8))
@@ -965,8 +1007,12 @@
Backends that offer asynchronous diffs should respect this variable
in their implementation of vc-BACKEND-diff.")
+(defvar vc-log-fileset)
(defvar vc-log-revision)
+(defvar vc-dired-mode nil)
+(make-variable-buffer-local 'vc-dired-mode)
+
;; File property caching
(defun vc-clear-context ()
@@ -1028,6 +1074,121 @@
,@body
(save-buffer)))))
+(defun vc-position-context (posn)
+ "Save a bit of the text around POSN in the current buffer.
+Used to help us find the corresponding position again later
+if markers are destroyed or corrupted."
+ ;; A lot of this was shamelessly lifted from Sebastian Kremer's
+ ;; rcs.el mode.
+ (list posn
+ (buffer-size)
+ (buffer-substring posn
+ (min (point-max) (+ posn 100)))))
+
+(defun vc-find-position-by-context (context)
+ "Return the position of CONTEXT in the current buffer.
+If CONTEXT cannot be found, return nil."
+ (let ((context-string (nth 2 context)))
+ (if (equal "" context-string)
+ (point-max)
+ (save-excursion
+ (let ((diff (- (nth 1 context) (buffer-size))))
+ (when (< diff 0) (setq diff (- diff)))
+ (goto-char (nth 0 context))
+ (if (or (search-forward context-string nil t)
+ ;; Can't use search-backward since the match may continue
+ ;; after point.
+ (progn (goto-char (- (point) diff (length context-string)))
+ ;; goto-char doesn't signal an error at
+ ;; beginning of buffer like backward-char would
+ (search-forward context-string nil t)))
+ ;; to beginning of OSTRING
+ (- (point) (length context-string))))))))
+
+(defun vc-context-matches-p (posn context)
+ "Return t if POSN matches CONTEXT, nil otherwise."
+ (let* ((context-string (nth 2 context))
+ (len (length context-string))
+ (end (+ posn len)))
+ (if (> end (1+ (buffer-size)))
+ nil
+ (string= context-string (buffer-substring posn end)))))
+
+(defun vc-buffer-context ()
+ "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
+Used by `vc-restore-buffer-context' to later restore the context."
+ (let ((point-context (vc-position-context (point)))
+ ;; Use mark-marker to avoid confusion in transient-mark-mode.
+ (mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer))
+ (vc-position-context (mark-marker))))
+ ;; Make the right thing happen in transient-mark-mode.
+ (mark-active nil)
+ ;; The new compilation code does not use compilation-error-list any
+ ;; more, so the code below is now ineffective and might as well
+ ;; be disabled. -- Stef
+ ;; ;; We may want to reparse the compilation buffer after revert
+ ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded
+ ;; ;; Construct a list; each elt is nil or a buffer
+ ;; ;; if that buffer is a compilation output buffer
+ ;; ;; that contains markers into the current buffer.
+ ;; (save-current-buffer
+ ;; (mapcar (lambda (buffer)
+ ;; (set-buffer buffer)
+ ;; (let ((errors (or
+ ;; compilation-old-error-list
+ ;; compilation-error-list))
+ ;; (buffer-error-marked-p nil))
+ ;; (while (and (consp errors)
+ ;; (not buffer-error-marked-p))
+ ;; (and (markerp (cdr (car errors)))
+ ;; (eq buffer
+ ;; (marker-buffer
+ ;; (cdr (car errors))))
+ ;; (setq buffer-error-marked-p t))
+ ;; (setq errors (cdr errors)))
+ ;; (if buffer-error-marked-p buffer)))
+ ;; (buffer-list)))))
+ (reparse nil))
+ (list point-context mark-context reparse)))
+
+(defun vc-restore-buffer-context (context)
+ "Restore point/mark, and reparse any affected compilation buffers.
+CONTEXT is that which `vc-buffer-context' returns."
+ (let ((point-context (nth 0 context))
+ (mark-context (nth 1 context))
+ ;; (reparse (nth 2 context))
+ )
+ ;; The new compilation code does not use compilation-error-list any
+ ;; more, so the code below is now ineffective and might as well
+ ;; be disabled. -- Stef
+ ;; ;; Reparse affected compilation buffers.
+ ;; (while reparse
+ ;; (if (car reparse)
+ ;; (with-current-buffer (car reparse)
+ ;; (let ((compilation-last-buffer (current-buffer)) ;select
buffer
+ ;; ;; Record the position in the compilation buffer of
+ ;; ;; the last error next-error went to.
+ ;; (error-pos (marker-position
+ ;; (car (car-safe compilation-error-list)))))
+ ;; ;; Reparse the error messages as far as they were parsed
before.
+ ;; (compile-reinitialize-errors '(4) compilation-parsing-end)
+ ;; ;; Move the pointer up to find the error we were at before
+ ;; ;; reparsing. Now next-error should properly go to the
next one.
+ ;; (while (and compilation-error-list
+ ;; (/= error-pos (car (car
compilation-error-list))))
+ ;; (setq compilation-error-list (cdr
compilation-error-list))))))
+ ;; (setq reparse (cdr reparse)))
+
+ ;; if necessary, restore point and mark
+ (if (not (vc-context-matches-p (point) point-context))
+ (let ((new-point (vc-find-position-by-context point-context)))
+ (when new-point (goto-char new-point))))
+ (and mark-active
+ mark-context
+ (not (vc-context-matches-p (mark) mark-context))
+ (let ((new-mark (vc-find-position-by-context mark-context)))
+ (when new-mark (set-mark new-mark))))))
+
;;; Code for deducing what fileset and backend to assume
(defun vc-responsible-backend (file &optional register)
@@ -1205,6 +1366,8 @@
(unless not-urgent
(error "Aborted")))))
+(defvar vc-dired-window-configuration)
+
(defun vc-compatible-state (p q)
"Controls which states can be in the same commit."
(or
@@ -1536,6 +1699,51 @@
(let ((buffer (get-file-buffer file)))
(vc-dir-mark-buffer-changed file))))
+
+(defun vc-start-entry (files rev comment initial-contents msg action &optional
after-hook)
+ "Accept a comment for an operation on FILES revision REV.
+If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
+action on close to ACTION. If COMMENT is a string and
+INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
+contents of the log entry buffer. If COMMENT is a string and
+INITIAL-CONTENTS is nil, do action immediately as if the user had
+entered COMMENT. If COMMENT is t, also do action immediately with an
+empty comment. Remember the file's buffer in `vc-parent-buffer'
+\(current one if no file). AFTER-HOOK specifies the local value
+for `vc-log-after-operation-hook'."
+ (let ((parent
+ (if (or (eq major-mode 'vc-dired-mode) (eq major-mode 'vc-dir-mode))
+ ;; If we are called from VC dired, the parent buffer is
+ ;; the current buffer.
+ (current-buffer)
+ (if (and files (equal (length files) 1))
+ (get-file-buffer (car files))
+ (current-buffer)))))
+ (when vc-before-checkin-hook
+ (if files
+ (with-current-buffer parent
+ (run-hooks 'vc-before-checkin-hook))
+ (run-hooks 'vc-before-checkin-hook)))
+ (if (and comment (not initial-contents))
+ (set-buffer (get-buffer-create "*VC-log*"))
+ (pop-to-buffer (get-buffer-create "*VC-log*")))
+ (set (make-local-variable 'vc-parent-buffer) parent)
+ (set (make-local-variable 'vc-parent-buffer-name)
+ (concat " from " (buffer-name vc-parent-buffer)))
+ ;;(if file (vc-mode-line file))
+ (vc-log-edit files)
+ (make-local-variable 'vc-log-after-operation-hook)
+ (when after-hook
+ (setq vc-log-after-operation-hook after-hook))
+ (setq vc-log-operation action)
+ (setq vc-log-revision rev)
+ (when comment
+ (erase-buffer)
+ (when (stringp comment) (insert comment)))
+ (if (or (not comment) initial-contents)
+ (message "%s Type C-c C-c when done" msg)
+ (vc-finish-logentry (eq comment t)))))
+
(defun vc-checkout (file &optional writable rev)
"Retrieve a copy of the revision REV of FILE.
If WRITABLE is non-nil, make sure the retrieved file is writable.
@@ -1635,6 +1843,57 @@
(message "Checking in %s...done" (vc-delistify files)))
'vc-checkin-hook))
+(defun vc-finish-logentry (&optional nocomment)
+ "Complete the operation implied by the current log entry.
+Use the contents of the current buffer as a check-in or registration
+comment. If the optional arg NOCOMMENT is non-nil, then don't check
+the buffer contents as a comment."
+ (interactive)
+ ;; Check and record the comment, if any.
+ (unless nocomment
+ (run-hooks 'vc-logentry-check-hook))
+ ;; Sync parent buffer in case the user modified it while editing the comment.
+ ;; But not if it is a vc-dired buffer.
+ (with-current-buffer vc-parent-buffer
+ (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
+ (unless vc-log-operation
+ (error "No log operation is pending"))
+ ;; save the parameters held in buffer-local variables
+ (let ((log-operation vc-log-operation)
+ (log-fileset vc-log-fileset)
+ (log-revision vc-log-revision)
+ (log-entry (buffer-string))
+ (after-hook vc-log-after-operation-hook)
+ (tmp-vc-parent-buffer vc-parent-buffer))
+ (pop-to-buffer vc-parent-buffer)
+ ;; OK, do it to it
+ (save-excursion
+ (funcall log-operation
+ log-fileset
+ log-revision
+ log-entry))
+ ;; Remove checkin window (after the checkin so that if that fails
+ ;; we don't zap the *VC-log* buffer and the typing therein).
+ ;; -- IMO this should be replaced with quit-window
+ (let ((logbuf (get-buffer "*VC-log*")))
+ (cond ((and logbuf vc-delete-logbuf-window)
+ (delete-windows-on logbuf (selected-frame))
+ ;; Kill buffer and delete any other dedicated windows/frames.
+ (kill-buffer logbuf))
+ (logbuf (pop-to-buffer "*VC-log*")
+ (bury-buffer)
+ (pop-to-buffer tmp-vc-parent-buffer))))
+ ;; Now make sure we see the expanded headers
+ (when log-fileset
+ (mapc
+ (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+ log-fileset))
+ (when vc-dired-mode
+ (dired-move-to-filename))
+ (when (eq major-mode 'vc-dir-mode)
+ (vc-dir-move-to-goal-column))
+ (run-hooks after-hook 'vc-finish-logentry-hook)))
+
;;; Additional entry points for examining version histories
;; (defun vc-default-diff-tree (backend dir rev1 rev2)
@@ -2020,7 +2279,140 @@
;;;###autoload
(defalias 'vc-resolve-conflicts 'smerge-ediff)
-;; Hooks to the dired code
+;; The VC directory major mode. Coopt Dired for this.
+;; All VC commands get mapped into logical equivalents.
+
+(defvar vc-dired-switches)
+(defvar vc-dired-terse-mode)
+
+(defvar vc-dired-mode-map
+ (let ((map (make-sparse-keymap))
+ (vmap (make-sparse-keymap)))
+ (define-key map "\C-xv" vmap)
+ (define-key map "v" vmap)
+ (set-keymap-parent vmap vc-prefix-map)
+ (define-key vmap "t" 'vc-dired-toggle-terse-mode)
+ map))
+
+(define-derived-mode vc-dired-mode dired-mode "Dired under "
+ "The major mode used in VC directory buffers.
+
+It works like Dired, but lists only files under version control, with
+the current VC state of each file being indicated in the place of the
+file's link count, owner, group and size. Subdirectories are also
+listed, and you may insert them into the buffer as desired, like in
+Dired.
+
+All Dired commands operate normally, with the exception of `v', which
+is redefined as the version control prefix, so that you can type
+`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
+the file named in the current Dired buffer line. `vv' invokes
+`vc-next-action' on this file, or on all files currently marked.
+There is a special command, `*l', to mark all files currently locked."
+ ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
+ ;; We do it here because dired might not be loaded yet
+ ;; when vc-dired-mode-map is initialized.
+ (set-keymap-parent vc-dired-mode-map dired-mode-map)
+ (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+ ;; The following is slightly modified from files.el,
+ ;; because file lines look a bit different in vc-dired-mode
+ ;; (the column before the date does not end in a digit).
+ ;; albinus: It should be done in the original declaration. Problem
+ ;; is the optional empty state-info; otherwise ")" would be good
+ ;; enough as delimeter.
+ (set (make-local-variable 'directory-listing-before-filename-regexp)
+ (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be followed by ".".
+ (month (concat l l "+\\.?"))
+ (s " ")
+ (yyyy "[0-9][0-9][0-9][0-9]")
+ (dd "[ 0-3][0-9]")
+ (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+ (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
+ (zone "[-+][0-2][0-9][0-5][0-9]")
+ (iso-mm-dd "[01][0-9]-[0-3][0-9]")
+ (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
+ (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
+ "\\|" yyyy "-" iso-mm-dd "\\)"))
+ (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
+ s "+"
+ "\\(" HH:MM "\\|" yyyy "\\)"))
+ (western-comma (concat month s "+" dd "," s "+" yyyy))
+ ;; Japanese MS-Windows ls-lisp has one-digit months, and
+ ;; omits the Kanji characters after month and day-of-month.
+ (mm "[ 0-1]?[0-9]")
+ (japanese
+ (concat mm l "?" s dd l "?" s "+"
+ "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
+ ;; the .* below ensures that we find the last match on a line
+ (concat ".*" s
+ "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
+ s "+")))
+ (and (boundp 'vc-dired-switches)
+ vc-dired-switches
+ (set (make-local-variable 'dired-actual-switches)
+ vc-dired-switches))
+ (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
+ (let ((backend-name (symbol-name (vc-responsible-backend
+ default-directory))))
+ (setq mode-name (concat mode-name backend-name))
+ ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
+ (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
+ (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
+ (cons backend-name vc-dire-menu-map) 'subdir)))
+ (setq vc-dired-mode t))
+
+(defun vc-dired-toggle-terse-mode ()
+ "Toggle terse display in VC Dired."
+ (interactive)
+ (if (not vc-dired-mode)
+ nil
+ (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+ (if vc-dired-terse-mode
+ (vc-dired-hook)
+ (revert-buffer))))
+
+(defun vc-dired-mark-locked ()
+ "Mark all files currently locked."
+ (interactive)
+ (dired-mark-if (let ((f (dired-get-filename nil t)))
+ (and f
+ (not (file-directory-p f))
+ (not (vc-up-to-date-p f))))
+ "locked file"))
+
+(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
+
+(defun vc-dired-reformat-line (vc-info)
+ "Reformat a directory-listing line.
+Replace various columns with version control information, VC-INFO.
+This code, like dired, assumes UNIX -l format."
+ (beginning-of-line)
+ (when (re-search-forward
+ ;; Match link count, owner, group, size. Group may be missing,
+ ;; and only the size is present in OS/2 -l format.
+ "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
+ (line-end-position) t)
+ (replace-match (substring (concat vc-info " ") 0 10)
+ t t nil 1)))
+
+(defun vc-dired-ignorable-p (filename)
+ "Should FILENAME be ignored in VC-Dired listings?"
+ (catch t
+ ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
+ (dolist (ignorable completion-ignored-extensions)
+ (let ((ext (substring filename
+ (- (length filename)
+ (length ignorable)))))
+ (if (string= ignorable ext) (throw t t))))
+ ;; Ignore Makefiles derived from something else
+ (when (string= (file-name-nondirectory filename) "Makefile")
+ (let* ((dir (file-name-directory filename))
+ (peers (directory-files (or dir default-directory))))
+ (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
+ (throw t t))))
+ nil))
(defun vc-dired-hook ()
"Reformat the listing according to version control.
@@ -2098,6 +2490,980 @@
(goto-char (point-min))
(message "No changes pending under %s" default-directory)))))
+(defun vc-dired-purge ()
+ "Remove empty subdirs."
+ (goto-char (point-min))
+ (while (dired-get-subdir)
+ (forward-line 2)
+ (if (dired-get-filename nil t)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max)))
+ (forward-line -2)
+ (if (not (string= (dired-current-directory) default-directory))
+ (dired-do-kill-lines t "")
+ ;; We cannot remove the top level directory.
+ ;; Just make it look a little nicer.
+ (forward-line 1)
+ (or (eobp) (kill-line))
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max))))))
+ (goto-char (point-min)))
+
+(defun vc-dired-buffers-for-dir (dir)
+ "Return a list of all vc-dired buffers that currently display DIR."
+ (let (result)
+ ;; Check whether dired is loaded.
+ (when (fboundp 'dired-buffers-for-dir)
+ (dolist (buffer (dired-buffers-for-dir dir))
+ (with-current-buffer buffer
+ (when vc-dired-mode
+ (push buffer result)))))
+ (nreverse result)))
+
+(defun vc-directory-resynch-file (file)
+ "Update the entries for FILE in any VC Dired buffers that list it."
+ ;;FIXME This needs to be implemented so it works for vc-dir
+ (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
+ (when buffers
+ (mapcar (lambda (buffer)
+ (with-current-buffer buffer
+ (when (dired-goto-file file)
+ ;; bind vc-dired-terse-mode to nil so that
+ ;; files won't vanish when they are checked in
+ (let ((vc-dired-terse-mode nil))
+ (dired-do-redisplay 1)))))
+ buffers))))
+
+;;;###autoload
+(defun vc-directory (dir read-switches)
+ "Create a buffer in VC Dired Mode for directory DIR.
+
+See Info node `VC Dired Mode'.
+
+With prefix arg READ-SWITCHES, specify a value to override
+`dired-listing-switches' when generating the listing."
+ (interactive "DDired under VC (directory): \nP")
+ (let ((vc-dired-switches (concat vc-dired-listing-switches
+ (if vc-dired-recurse "R" ""))))
+ (if read-switches
+ (setq vc-dired-switches
+ (read-string "Dired listing switches: "
+ vc-dired-switches)))
+ (require 'dired)
+ (require 'dired-aux)
+ (switch-to-buffer
+ (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
+ vc-dired-switches
+ 'vc-dired-mode))))
+
+;; VC status implementation
+
+;; Used to store information for the files displayed in the *VC status* buffer.
+;; Each item displayed corresponds to one of these defstructs.
+(defstruct (vc-dir-fileinfo
+ (:copier nil)
+ (:type list) ;So we can use `member' on lists of FIs.
+ (:constructor
+ ;; We could define it as an alias for `list'.
+ vc-dir-create-fileinfo (name state &optional extra marked
directory))
+ (:conc-name vc-dir-fileinfo->))
+ name ;Keep it as first, for `member'.
+ state
+ ;; For storing backend specific information.
+ extra
+ marked
+ ;; To keep track of not updated files during a global refresh
+ needs-update
+ ;; To distinguish files and directories.
+ directory)
+
+(defvar vc-ewoc nil)
+
+(defun vc-default-status-extra-headers (backend dir)
+ ;; Be loud by default to remind people to add coded to display
+ ;; backend specific headers.
+ ;; XXX: change this to return nil before the release.
+ "Extra : Add backend specific headers here")
+
+(defun vc-dir-headers (backend dir)
+ "Display the headers in the *VC status* buffer.
+It calls the `status-extra-headers' backend method to display backend
+specific headers."
+ (concat
+ (propertize "VC backend : " 'face 'font-lock-type-face)
+ (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
+ (propertize "Working dir: " 'face 'font-lock-type-face)
+ (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
+ (vc-call-backend backend 'status-extra-headers dir)
+ "\n"))
+
+(defun vc-default-status-printer (backend fileentry)
+ "Pretty print FILEENTRY."
+ ;; If you change the layout here, change vc-dir-move-to-goal-column.
+ (let ((state
+ (if (vc-dir-fileinfo->directory fileentry)
+ 'DIRECTORY
+ (vc-dir-fileinfo->state fileentry))))
+ (insert
+ (propertize
+ (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
+ 'face 'font-lock-type-face)
+ " "
+ (propertize
+ (format "%-20s" state)
+ 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
+ ((memq state '(missing conflict)) 'font-lock-warning-face)
+ (t 'font-lock-variable-name-face))
+ 'mouse-face 'highlight)
+ " "
+ (propertize
+ (format "%s" (vc-dir-fileinfo->name fileentry))
+ 'face 'font-lock-function-name-face
+ 'mouse-face 'highlight))))
+
+(defun vc-dir-printer (fileentry)
+ (let ((backend (vc-responsible-backend default-directory)))
+ (vc-call-backend backend 'status-printer fileentry)))
+
+(defun vc-dir-move-to-goal-column ()
+ ;; Used to keep the cursor on the file name column.
+ (beginning-of-line)
+ ;; Must be in sync with vc-default-status-printer.
+ (forward-char 25))
+
+(defun vc-dir-prepare-status-buffer (dir &optional create-new)
+ "Find a *vc-dir* buffer showing DIR, or create a new one."
+ (setq dir (expand-file-name dir))
+ (let* ((bname "*vc-dir*")
+ ;; Look for another *vc-dir* buffer visiting the same directory.
+ (buf (save-excursion
+ (unless create-new
+ (dolist (buffer (buffer-list))
+ (set-buffer buffer)
+ (when (and (eq major-mode 'vc-dir-mode)
+ (string= (expand-file-name default-directory)
dir))
+ (return buffer)))))))
+ (or buf
+ ;; Create a new *vc-dir* buffer.
+ (with-current-buffer (create-file-buffer bname)
+ (cd dir)
+ (vc-setup-buffer (current-buffer))
+ ;; Reset the vc-parent-buffer-name so that it does not appear
+ ;; in the mode-line.
+ (setq vc-parent-buffer-name nil)
+ (current-buffer)))))
+
+;;;###autoload
+(defun vc-dir (dir)
+ "Show the VC status for DIR."
+ (interactive "DVC status for directory: ")
+ (pop-to-buffer (vc-dir-prepare-status-buffer dir))
+ (if (eq major-mode 'vc-dir-mode)
+ (vc-dir-refresh)
+ (vc-dir-mode)))
+
+(defvar vc-dir-menu-map
+ (let ((map (make-sparse-keymap "VC-dir")))
+ (define-key map [quit]
+ '(menu-item "Quit" quit-window
+ :help "Quit"))
+ (define-key map [kill]
+ '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
+ :enable (vc-dir-busy)
+ :help "Kill the command that updates VC status buffer"))
+ (define-key map [refresh]
+ '(menu-item "Refresh" vc-dir-refresh
+ :enable (not (vc-dir-busy))
+ :help "Refresh the contents of the VC status buffer"))
+ (define-key map [remup]
+ '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
+ :help "Hide up-to-date items from display"))
+ ;; Movement.
+ (define-key map [sepmv] '("--"))
+ (define-key map [next-line]
+ '(menu-item "Next line" vc-dir-next-line
+ :help "Go to the next line" :keys "n"))
+ (define-key map [previous-line]
+ '(menu-item "Previous line" vc-dir-previous-line
+ :help "Go to the previous line"))
+ ;; Marking.
+ (define-key map [sepmrk] '("--"))
+ (define-key map [unmark-all]
+ '(menu-item "Unmark All" vc-dir-unmark-all-files
+ :help "Unmark all files that are in the same state as the
current file\
+\nWith prefix argument unmark all files"))
+ (define-key map [unmark-previous]
+ '(menu-item "Unmark previous " vc-dir-unmark-file-up
+ :help "Move to the previous line and unmark the file"))
+
+ (define-key map [mark-all]
+ '(menu-item "Mark All" vc-dir-mark-all-files
+ :help "Mark all files that are in the same state as the
current file\
+\nWith prefix argument mark all files"))
+ (define-key map [unmark]
+ '(menu-item "Unmark" vc-dir-unmark
+ :help "Unmark the current file or all files in the region"))
+
+ (define-key map [mark]
+ '(menu-item "Mark" vc-dir-mark
+ :help "Mark the current file or all files in the region"))
+
+ (define-key map [sepopn] '("--"))
+ (define-key map [open-other]
+ '(menu-item "Open in other window" vc-dir-find-file-other-window
+ :help "Find the file on the current line, in another window"))
+ (define-key map [open]
+ '(menu-item "Open file" vc-dir-find-file
+ :help "Find the file on the current line"))
+ ;; VC info details
+ (define-key map [sepvcdet] '("--"))
+ ;; FIXME: This needs a key binding. And maybe a better name
+ ;; ("Insert" like PCL-CVS uses does not sound that great either)...
+ (define-key map [ins]
+ '(menu-item "Show File" vc-dir-show-fileentry
+ :help "Show a file in the VC status listing even though it
might be up to date"))
+ (define-key map [annotate]
+ '(menu-item "Annotate" vc-annotate
+ :help "Display the edit history of the current file using
colors"))
+ (define-key map [diff]
+ '(menu-item "Compare with Base Version" vc-diff
+ :help "Compare file set with the base version"))
+ (define-key map [log]
+ '(menu-item "Show history" vc-print-log
+ :help "List the change log of the current file set in a window"))
+ ;; VC commands.
+ (define-key map [sepvccmd] '("--"))
+ (define-key map [update]
+ '(menu-item "Update to latest version" vc-update
+ :help "Update the current fileset's files to their tip
revisions"))
+ (define-key map [revert]
+ '(menu-item "Revert to base version" vc-revert
+ :help "Revert working copies of the selected fileset to their
repository contents."))
+ (define-key map [next-action]
+ ;; FIXME: This really really really needs a better name!
+ ;; And a key binding too.
+ '(menu-item "Check In/Out" vc-next-action
+ :help "Do the next logical version control operation on the
current fileset"))
+ (define-key map [register]
+ '(menu-item "Register" vc-dir-register
+ :help "Register file set into the version control system"))
+ map)
+ "Menu for VC status")
+
+(defalias 'vc-dir-menu-map vc-dir-menu-map)
+
+(defvar vc-dir-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ ;; Marking.
+ (define-key map "m" 'vc-dir-mark)
+ (define-key map "M" 'vc-dir-mark-all-files)
+ (define-key map "u" 'vc-dir-unmark)
+ (define-key map "U" 'vc-dir-unmark-all-files)
+ (define-key map "\C-?" 'vc-dir-unmark-file-up)
+ (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
+ ;; Movement.
+ (define-key map "n" 'vc-dir-next-line)
+ (define-key map " " 'vc-dir-next-line)
+ (define-key map "\t" 'vc-dir-next-line)
+ (define-key map "p" 'vc-dir-previous-line)
+ (define-key map [backtab] 'vc-dir-previous-line)
+ ;; VC commands.
+ (define-key map "=" 'vc-diff) ;; C-x v =
+ (define-key map "a" 'vc-dir-register)
+ (define-key map "+" 'vc-update) ;; C-x v +
+ (define-key map "R" 'vc-revert) ;; u is taken by unmark.
+
+ ;; Can't be "g" (as in vc map), so "A" for "Annotate".
+ (define-key map "A" 'vc-annotate)
+ (define-key map "l" 'vc-print-log) ;; C-x v l
+ ;; The remainder.
+ (define-key map "f" 'vc-dir-find-file)
+ (define-key map "\C-m" 'vc-dir-find-file)
+ (define-key map "o" 'vc-dir-find-file-other-window)
+ (define-key map "x" 'vc-dir-hide-up-to-date)
+ (define-key map "q" 'quit-window)
+ (define-key map "g" 'vc-dir-refresh)
+ (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
+ (define-key map [(down-mouse-3)] 'vc-dir-menu)
+ (define-key map [(mouse-2)] 'vc-dir-toggle-mark)
+
+ ;; Hook up the menu.
+ (define-key map [menu-bar vc-dir-mode]
+ '(menu-item
+ ;; This is used to that VC backends could add backend specific
+ ;; menu items to vc-dir-menu-map.
+ "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter))
+ map)
+ "Keymap for VC status")
+
+(defun vc-default-extra-status-menu (backend)
+ nil)
+
+;; This is used to that VC backends could add backend specific menu
+;; items to vc-dir-menu-map.
+(defun vc-dir-menu-map-filter (orig-binding)
+ (when (and (symbolp orig-binding) (fboundp orig-binding))
+ (setq orig-binding (indirect-function orig-binding)))
+ (let ((ext-binding
+ (vc-call-backend (vc-responsible-backend default-directory)
+ 'extra-status-menu)))
+ (if (null ext-binding)
+ orig-binding
+ (append orig-binding
+ '("----")
+ ext-binding))))
+
+(defmacro vc-at-event (event &rest body)
+ "Evaluate `body' wich point located at event-start of `event'.
+If `body' uses `event', it should be a variable,
+ otherwise it will be evaluated twice."
+ (let ((posn (gensym "vc-at-event-posn")))
+ `(let ((,posn (event-start ,event)))
+ (save-excursion
+ (set-buffer (window-buffer (posn-window ,posn)))
+ (goto-char (posn-point ,posn))
+ ,@body))))
+
+(defun vc-dir-menu (e)
+ "Popup the VC status menu."
+ (interactive "e")
+ (vc-at-event e (popup-menu vc-dir-menu-map e)))
+
+(defvar vc-dir-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
+ map vc-dir-mode-map)
+ (tool-bar-local-item "bookmark_add"
+ 'vc-dir-toggle-mark 'vc-dir-toggle-mark map
+ :help "Toggle mark on current item")
+ (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
+ map vc-dir-mode-map
+ :rtl "right-arrow")
+ (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
+ map vc-dir-mode-map
+ :rtl "left-arrow")
+ (tool-bar-local-item-from-menu 'vc-print-log "info"
+ map vc-dir-mode-map)
+ (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
+ map vc-dir-mode-map)
+ (tool-bar-local-item-from-menu 'nonincremental-search-forward
+ "search" map)
+ (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
+ map vc-dir-mode-map)
+ (tool-bar-local-item-from-menu 'quit-window "exit"
+ map vc-dir-mode-map)
+ map))
+
+(defvar vc-dir-process-buffer nil
+ "The buffer used for the asynchronous call that computes the VC status.")
+
+(defun vc-dir-mode ()
+ "Major mode for showing the VC status for a directory.
+Marking/Unmarking key bindings and actions:
+m - marks a file/directory or ff the region is active, mark all the files
+ in region.
+ Restrictions: - a file cannot be marked if any parent directory is marked
+ - a directory cannot be marked if any child file or
+ directory is marked
+u - marks a file/directory or if the region is active, unmark all the files
+ in region.
+M - if the cursor is on a file: mark all the files with the same VC state as
+ the current file
+ - if the cursor is on a directory: mark all child files
+ - with a prefix argument: mark all files
+U - if the cursor is on a file: unmark all the files with the same VC state
+ as the current file
+ - if the cursor is on a directory: unmark all child files
+ - with a prefix argument: unmark all files
+
+
+\\{vc-dir-mode-map}"
+ (setq mode-name "VC Status")
+ (setq major-mode 'vc-dir-mode)
+ (setq buffer-read-only t)
+ (use-local-map vc-dir-mode-map)
+ (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)
+ (let ((buffer-read-only nil)
+ (backend (vc-responsible-backend default-directory))
+ entries)
+ (erase-buffer)
+ (set (make-local-variable 'vc-dir-process-buffer) nil)
+ (set (make-local-variable 'vc-ewoc)
+ (ewoc-create #'vc-dir-printer
+ (vc-dir-headers backend default-directory)))
+ (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed)
+ ;; Make sure that if the VC status buffer is killed, the update
+ ;; process running in the background is also killed.
+ (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
+ (vc-dir-refresh))
+ (run-hooks 'vc-dir-mode-hook))
+
+(put 'vc-dir-mode 'mode-class 'special)
+
+;; t if directories should be shown in vc-dir.
+;; WORK IN PROGRESS! DO NOT SET this! ONLY set it if you want to help
+;; write code for this feature. This variable will likely disappear
+;; when the work is done.
+(defvar vc-dir-insert-directories nil)
+
+(defun vc-dir-update (entries buffer &optional noinsert)
+ "Update BUFFER's ewoc from the list of ENTRIES.
+If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
+ ;; Add ENTRIES to the vc-dir buffer BUFFER.
+ (with-current-buffer buffer
+ ;; Insert the entries sorted by name into the ewoc.
+ ;; We assume the ewoc is sorted too, which should be the
+ ;; case if we always add entries with vc-dir-update.
+ (setq entries
+ ;; Sort: first files and then subdirectories.
+ ;; XXX: this is VERY inefficient, it computes the directory
+ ;; names too many times
+ (sort entries
+ (lambda (entry1 entry2)
+ (let ((dir1 (file-name-directory (expand-file-name (car
entry1))))
+ (dir2 (file-name-directory (expand-file-name (car
entry2)))))
+ (cond
+ ((string< dir1 dir2) t)
+ ((not (string= dir1 dir2)) nil)
+ ((string< (car entry1) (car entry2))))))))
+ (if (not vc-dir-insert-directories)
+ (let ((entry (car entries))
+ (node (ewoc-nth vc-ewoc 0)))
+ (while (and entry node)
+ (let ((entryfile (car entry))
+ (nodefile (vc-dir-fileinfo->name (ewoc-data node))))
+ (cond
+ ((string-lessp nodefile entryfile)
+ (setq node (ewoc-next vc-ewoc node)))
+ ((string-lessp entryfile nodefile)
+ (unless noinsert
+ (ewoc-enter-before vc-ewoc node
+ (apply 'vc-dir-create-fileinfo entry)))
+ (setq entries (cdr entries) entry (car entries)))
+ (t
+ (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
+ (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
+ (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
+ (ewoc-invalidate vc-ewoc node)
+ (setq entries (cdr entries) entry (car entries))
+ (setq node (ewoc-next vc-ewoc node))))))
+ (unless (or node noinsert)
+ ;; We're past the last node, all remaining entries go to the end.
+ (while entries
+ (ewoc-enter-last vc-ewoc
+ (apply 'vc-dir-create-fileinfo (pop entries))))))
+ ;; Insert directory entries in the right places.
+ (let ((entry (car entries))
+ (node (ewoc-nth vc-ewoc 0)))
+ ;; Insert . if it is not present.
+ (unless node
+ (let ((rd (file-relative-name default-directory)))
+ (ewoc-enter-last
+ vc-ewoc (vc-dir-create-fileinfo
+ rd nil nil nil (expand-file-name default-directory))))
+ (setq node (ewoc-nth vc-ewoc 0)))
+
+ (while (and entry node)
+ (let* ((entryfile (car entry))
+ (entrydir (file-name-directory (expand-file-name entryfile)))
+ (nodedir
+ (or (vc-dir-fileinfo->directory (ewoc-data node))
+ (file-name-directory
+ (expand-file-name
+ (vc-dir-fileinfo->name (ewoc-data node)))))))
+ (cond
+ ;; First try to find the directory.
+ ((string-lessp nodedir entrydir)
+ (setq node (ewoc-next vc-ewoc node)))
+ ((string-equal nodedir entrydir)
+ ;; Found the directory, find the place for the file name.
+ (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
+ (cond
+ ((string-lessp nodefile entryfile)
+ (setq node (ewoc-next vc-ewoc node)))
+ ((string-equal nodefile entryfile)
+ (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
+ (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
+ (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
+ (ewoc-invalidate vc-ewoc node)
+ (setq entries (cdr entries) entry (car entries))
+ (setq node (ewoc-next vc-ewoc node)))
+ (t
+ (ewoc-enter-before vc-ewoc node
+ (apply 'vc-dir-create-fileinfo entry))
+ (setq entries (cdr entries) entry (car entries))))))
+ (t
+ ;; We need to insert a directory node
+ (let ((rd (file-relative-name entrydir)))
+ (ewoc-enter-last
+ vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))
+ ;; Now insert the node itself.
+ (ewoc-enter-before vc-ewoc node
+ (apply 'vc-dir-create-fileinfo entry))
+ (setq entries (cdr entries) entry (car entries))))))
+ ;; We're past the last node, all remaining entries go to the end.
+ (unless (or node noinsert)
+ (let* ((lastnode (ewoc-nth vc-ewoc -1))
+ (lastdir
+ (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
+ (file-name-directory
+ (expand-file-name
+ (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
+ (dolist (entry entries)
+ (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
+ ;; Insert a directory node if needed.
+ (unless (string-equal lastdir entrydir)
+ (setq lastdir entrydir)
+ (let ((rd (file-relative-name entrydir)))
+ (ewoc-enter-last
+ vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
+ ;; Now insert the node itself.
+ (ewoc-enter-last vc-ewoc
+ (apply 'vc-dir-create-fileinfo entry))))))))))
+
+(defun vc-dir-busy ()
+ (and (buffer-live-p vc-dir-process-buffer)
+ (get-buffer-process vc-dir-process-buffer)))
+
+(defun vc-dir-refresh-files (files default-state)
+ "Refresh some files in the VC status buffer."
+ (let ((backend (vc-responsible-backend default-directory))
+ (status-buffer (current-buffer))
+ (def-dir default-directory))
+ (vc-set-mode-line-busy-indicator)
+ ;; Call the `dir-status-file' backend function.
+ ;; `dir-status-file' is supposed to be asynchronous.
+ ;; It should compute the results, and then call the function
+ ;; passed as an argument in order to update the vc-dir buffer
+ ;; with the results.
+ (unless (buffer-live-p vc-dir-process-buffer)
+ (setq vc-dir-process-buffer
+ (generate-new-buffer (format " *VC-%s* tmp status" backend))))
+ (lexical-let ((buffer (current-buffer)))
+ (with-current-buffer vc-dir-process-buffer
+ (cd def-dir)
+ (erase-buffer)
+ (vc-call-backend
+ backend 'dir-status-files def-dir files default-state
+ (lambda (entries &optional more-to-come)
+ ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
+ ;; If MORE-TO-COME is true, then more updates will come from
+ ;; the asynchronous process.
+ (with-current-buffer buffer
+ (vc-dir-update entries buffer)
+ (unless more-to-come
+ (setq mode-line-process nil)
+ ;; Remove the ones that haven't been updated at all.
+ ;; Those not-updated are those whose state is nil because the
+ ;; file/dir doesn't exist and isn't versioned.
+ (ewoc-filter vc-ewoc
+ (lambda (info)
+ (not (vc-dir-fileinfo->needs-update
info))))))))))))
+
+(defun vc-dir-refresh ()
+ "Refresh the contents of the VC status buffer.
+Throw an error if another update process is in progress."
+ (interactive)
+ (if (vc-dir-busy)
+ (error "Another update process is in progress, cannot run two at a time")
+ (let ((backend (vc-responsible-backend default-directory))
+ (status-buffer (current-buffer))
+ (def-dir default-directory))
+ (vc-set-mode-line-busy-indicator)
+ ;; Call the `dir-status' backend function.
+ ;; `dir-status' is supposed to be asynchronous.
+ ;; It should compute the results, and then call the function
+ ;; passed as an argument in order to update the vc-dir buffer
+ ;; with the results.
+
+ ;; Create a buffer that can be used by `dir-status' and call
+ ;; `dir-status' with this buffer as the current buffer. Use
+ ;; `vc-dir-process-buffer' to remember this buffer, so that
+ ;; it can be used later to kill the update process in case it
+ ;; takes too long.
+ (unless (buffer-live-p vc-dir-process-buffer)
+ (setq vc-dir-process-buffer
+ (generate-new-buffer (format " *VC-%s* tmp status" backend))))
+ ;; set the needs-update flag on all entries
+ (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t)
nil)
+ vc-ewoc)
+ (lexical-let ((buffer (current-buffer)))
+ (with-current-buffer vc-dir-process-buffer
+ (cd def-dir)
+ (erase-buffer)
+ (vc-call-backend
+ backend 'dir-status def-dir
+ (lambda (entries &optional more-to-come)
+ ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
+ ;; If MORE-TO-COME is true, then more updates will come from
+ ;; the asynchronous process.
+ (with-current-buffer buffer
+ (vc-dir-update entries buffer)
+ (unless more-to-come
+ (let ((remaining
+ (ewoc-collect
+ vc-ewoc 'vc-dir-fileinfo->needs-update)))
+ (if remaining
+ (vc-dir-refresh-files
+ (mapcar 'vc-dir-fileinfo->name remaining)
+ 'up-to-date)
+ (setq mode-line-process nil))))))))))))
+
+(defun vc-dir-kill-dir-status-process ()
+ "Kill the temporary buffer and associated process."
+ (interactive)
+ (when (buffer-live-p vc-dir-process-buffer)
+ (let ((proc (get-buffer-process vc-dir-process-buffer)))
+ (when proc (delete-process proc))
+ (setq vc-dir-process-buffer nil)
+ (setq mode-line-process nil))))
+
+(defun vc-dir-kill-query ()
+ ;; Make sure that when the VC status buffer is killed the update
+ ;; process running in background is also killed.
+ (if (vc-dir-busy)
+ (when (y-or-n-p "Status update process running, really kill status
buffer?")
+ (vc-dir-kill-dir-status-process)
+ t)
+ t))
+
+(defun vc-dir-next-line (arg)
+ "Go to the next line.
+If a prefix argument is given, move by that many lines."
+ (interactive "p")
+ (ewoc-goto-next vc-ewoc arg)
+ (vc-dir-move-to-goal-column))
+
+(defun vc-dir-previous-line (arg)
+ "Go to the previous line.
+If a prefix argument is given, move by that many lines."
+ (interactive "p")
+ (ewoc-goto-prev vc-ewoc arg)
+ (vc-dir-move-to-goal-column))
+
+(defun vc-dir-mark-unmark (mark-unmark-function)
+ (if (use-region-p)
+ (let ((firstl (line-number-at-pos (region-beginning)))
+ (lastl (line-number-at-pos (region-end))))
+ (save-excursion
+ (goto-char (region-beginning))
+ (while (<= (line-number-at-pos) lastl)
+ (funcall mark-unmark-function))))
+ (funcall mark-unmark-function)))
+
+(defun vc-dir-parent-marked-p (arg)
+ (when vc-dir-insert-directories
+ ;; Return nil if none of the parent directories of arg is marked.
+ (let* ((argdata (ewoc-data arg))
+ (argdir
+ (let ((crtdir (vc-dir-fileinfo->directory argdata)))
+ (if crtdir
+ crtdir
+ (file-name-directory (expand-file-name
+ (vc-dir-fileinfo->name argdata))))))
+ (arglen (length argdir))
+ (crt arg)
+ data dir)
+ ;; Go through the predecessors, checking if any directory that is
+ ;; a parent is marked.
+ (while (setq crt (ewoc-prev vc-ewoc crt))
+ (setq data (ewoc-data crt))
+ (setq dir
+ (let ((crtdir (vc-dir-fileinfo->directory data)))
+ (if crtdir
+ crtdir
+ (file-name-directory (expand-file-name
+ (vc-dir-fileinfo->name data))))))
+
+ (when (and (vc-dir-fileinfo->directory data)
+ (string-equal (substring argdir 0 (length dir)) dir))
+ (when (vc-dir-fileinfo->marked data)
+ (error "Cannot mark `%s', parent directory `%s' marked"
+ (vc-dir-fileinfo->name argdata)
+ (vc-dir-fileinfo->name data)))))
+ nil)))
+
+(defun vc-dir-children-marked-p (arg)
+ ;; Return nil if none of the children of arg is marked.
+ (when vc-dir-insert-directories
+ (let* ((argdata (ewoc-data arg))
+ (argdir (vc-dir-fileinfo->directory argdata))
+ (arglen (length argdir))
+ (is-child t)
+ (crt arg)
+ data dir)
+ (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
+ (setq data (ewoc-data crt))
+ (setq dir
+ (let ((crtdir (vc-dir-fileinfo->directory data)))
+ (if crtdir
+ crtdir
+ (file-name-directory (expand-file-name
+ (vc-dir-fileinfo->name data))))))
+ (if (string-equal argdir (substring dir 0 arglen))
+ (when (vc-dir-fileinfo->marked data)
+ (error "Cannot mark `%s', child `%s' marked"
+ (vc-dir-fileinfo->name argdata)
+ (vc-dir-fileinfo->name data)))
+ ;; We are done, we got to an entry that is not a child of `arg'.
+ (setq is-child nil)))
+ nil)))
+
+(defun vc-dir-mark-file (&optional arg)
+ ;; Mark ARG or the current file and move to the next line.
+ (let* ((crt (or arg (ewoc-locate vc-ewoc)))
+ (file (ewoc-data crt))
+ (isdir (vc-dir-fileinfo->directory file)))
+ (when (or (and isdir (not (vc-dir-children-marked-p crt)))
+ (and (not isdir) (not (vc-dir-parent-marked-p crt))))
+ (setf (vc-dir-fileinfo->marked file) t)
+ (ewoc-invalidate vc-ewoc crt)
+ (unless (or arg (mouse-event-p last-command-event))
+ (vc-dir-next-line 1)))))
+
+(defun vc-dir-mark ()
+ "Mark the current file or all files in the region.
+If the region is active, mark all the files in the region.
+Otherwise mark the file on the current line and move to the next
+line."
+ (interactive)
+ (vc-dir-mark-unmark 'vc-dir-mark-file))
+
+(defun vc-dir-mark-all-files (arg)
+ "Mark all files with the same state as the current one.
+With a prefix argument mark all files.
+If the current entry is a directory, mark all child files.
+
+The VC commands operate on files that are on the same state.
+This command is intended to make it easy to select all files that
+share the same state."
+ (interactive "P")
+ (if arg
+ ;; Mark all files.
+ (progn
+ ;; First check that no directory is marked, we can't mark
+ ;; files in that case.
+ (ewoc-map
+ (lambda (filearg)
+ (when (and (vc-dir-fileinfo->directory filearg)
+ (vc-dir-fileinfo->directory filearg))
+ (error "Cannot mark all files, directory `%s' marked"
+ (vc-dir-fileinfo->name filearg))))
+ vc-ewoc)
+ (ewoc-map
+ (lambda (filearg)
+ (unless (vc-dir-fileinfo->marked filearg)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+ (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
+ (if (vc-dir-fileinfo->directory data)
+ ;; It's a directory, mark child files.
+ (let ((crt (ewoc-locate vc-ewoc)))
+ (unless (vc-dir-children-marked-p crt)
+ (while (setq crt (ewoc-next vc-ewoc crt))
+ (let ((crt-data (ewoc-data crt)))
+ (unless (vc-dir-fileinfo->directory crt-data)
+ (setf (vc-dir-fileinfo->marked crt-data) t)
+ (ewoc-invalidate vc-ewoc crt))))))
+ ;; It's a file
+ (let ((state (vc-dir-fileinfo->state data))
+ (crt (ewoc-nth vc-ewoc 0)))
+ (while crt
+ (let ((crt-data (ewoc-data crt)))
+ (when (and (not (vc-dir-fileinfo->marked crt-data))
+ (eq (vc-dir-fileinfo->state crt-data) state)
+ (not (vc-dir-fileinfo->directory crt-data)))
+ (vc-dir-mark-file crt)))
+ (setq crt (ewoc-next vc-ewoc crt))))))))
+
+(defun vc-dir-unmark-file ()
+ ;; Unmark the current file and move to the next line.
+ (let* ((crt (ewoc-locate vc-ewoc))
+ (file (ewoc-data crt)))
+ (setf (vc-dir-fileinfo->marked file) nil)
+ (ewoc-invalidate vc-ewoc crt)
+ (unless (mouse-event-p last-command-event)
+ (vc-dir-next-line 1))))
+
+(defun vc-dir-unmark ()
+ "Unmark the current file or all files in the region.
+If the region is active, unmark all the files in the region.
+Otherwise mark the file on the current line and move to the next
+line."
+ (interactive)
+ (vc-dir-mark-unmark 'vc-dir-unmark-file))
+
+(defun vc-dir-unmark-file-up ()
+ "Move to the previous line and unmark the file."
+ (interactive)
+ ;; If we're on the first line, we won't move up, but we will still
+ ;; remove the mark. This seems a bit odd but it is what buffer-menu
+ ;; does.
+ (let* ((prev (ewoc-goto-prev vc-ewoc 1))
+ (file (ewoc-data prev)))
+ (setf (vc-dir-fileinfo->marked file) nil)
+ (ewoc-invalidate vc-ewoc prev)
+ (vc-dir-move-to-goal-column)))
+
+(defun vc-dir-unmark-all-files (arg)
+ "Unmark all files with the same state as the current one.
+With a prefix argument unmark all files.
+If the current entry is a directory, unmark all the child files.
+
+The VC commands operate on files that are on the same state.
+This command is intended to make it easy to deselect all files
+that share the same state."
+ (interactive "P")
+ (if arg
+ (ewoc-map
+ (lambda (filearg)
+ (when (vc-dir-fileinfo->marked filearg)
+ (setf (vc-dir-fileinfo->marked filearg) nil)
+ t))
+ vc-ewoc)
+ (let* ((crt (ewoc-locate vc-ewoc))
+ (data (ewoc-data crt)))
+ (if (vc-dir-fileinfo->directory data)
+ ;; It's a directory, unmark child files.
+ (while (setq crt (ewoc-next vc-ewoc crt))
+ (let ((crt-data (ewoc-data crt)))
+ (unless (vc-dir-fileinfo->directory crt-data)
+ (setf (vc-dir-fileinfo->marked crt-data) nil)
+ (ewoc-invalidate vc-ewoc crt))))
+ ;; It's a file
+ (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
+ (ewoc-map
+ (lambda (filearg)
+ (when (and (vc-dir-fileinfo->marked filearg)
+ (eq (vc-dir-fileinfo->state filearg) crt-state))
+ (setf (vc-dir-fileinfo->marked filearg) nil)
+ t))
+ vc-ewoc))))))
+
+(defun vc-dir-toggle-mark-file ()
+ (let* ((crt (ewoc-locate vc-ewoc))
+ (file (ewoc-data crt)))
+ (if (vc-dir-fileinfo->marked file)
+ (vc-dir-unmark-file)
+ (vc-dir-mark-file))))
+
+(defun vc-dir-toggle-mark (e)
+ (interactive "e")
+ (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
+
+(defun vc-dir-register ()
+ "Register the marked files, or the current file if no marks."
+ (interactive)
+ ;; FIXME: Just pass the fileset to vc-register.
+ (mapc (lambda (arg) (vc-register nil arg))
+ (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
+
+(defun vc-dir-delete-file ()
+ "Delete the marked files, or the current file if no marks."
+ (interactive)
+ (mapc 'vc-delete-file (or (vc-dir-marked-files)
+ (list (vc-dir-current-file)))))
+
+(defun vc-dir-show-fileentry (file)
+ "Insert an entry for a specific file into the current VC status listing.
+This is typically used if the file is up-to-date (or has been added
+outside of VC) and one wants to do some operation on it."
+ (interactive "fShow file: ")
+ (vc-dir-update (list (list (file-relative-name file) (vc-state file)))
(current-buffer)))
+
+(defun vc-dir-find-file ()
+ "Find the file on the current line."
+ (interactive)
+ (find-file (vc-dir-current-file)))
+
+(defun vc-dir-find-file-other-window ()
+ "Find the file on the current line, in another window."
+ (interactive)
+ (find-file-other-window (vc-dir-current-file)))
+
+(defun vc-dir-current-file ()
+ (let ((node (ewoc-locate vc-ewoc)))
+ (unless node
+ (error "No file available."))
+ (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
+
+(defun vc-dir-marked-files ()
+ "Return the list of marked files."
+ (mapcar
+ (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
+ (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
+
+(defun vc-dir-marked-only-files ()
+ "Return the list of marked files, for marked directories, return child
files."
+
+ (let ((crt (ewoc-nth vc-ewoc 0))
+ result)
+ (while crt
+ (let ((crt-data (ewoc-data crt)))
+ (if (vc-dir-fileinfo->marked crt-data)
+ (if (vc-dir-fileinfo->directory crt-data)
+ (let* ((dir (vc-dir-fileinfo->directory crt-data))
+ (dirlen (length dir))
+ data)
+ (while
+ (and (setq crt (ewoc-next vc-ewoc crt))
+ (string-equal
+ (substring
+ (progn
+ (setq data (ewoc-data crt))
+ (let ((crtdir (vc-dir-fileinfo->directory data)))
+ (if crtdir
+ crtdir
+ (file-name-directory
+ (expand-file-name
+ (vc-dir-fileinfo->name data))))))
+ 0 dirlen)
+ dir))
+ (unless (vc-dir-fileinfo->directory data)
+ (push (vc-dir-fileinfo->name data) result))))
+ (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
+ (setq crt (ewoc-next vc-ewoc crt)))
+ (setq crt (ewoc-next vc-ewoc crt)))))
+ result))
+
+(defun vc-dir-hide-up-to-date ()
+ "Hide up-to-date items from display."
+ (interactive)
+ (ewoc-filter
+ vc-ewoc
+ (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
+
+(defun vc-default-status-fileinfo-extra (backend file)
+ nil)
+
+(defun vc-dir-mark-buffer-changed (&optional fname)
+ (let* ((file (or fname (expand-file-name buffer-file-name)))
+ (found-vc-dir-buf nil))
+ (save-excursion
+ (dolist (status-buf (buffer-list))
+ (set-buffer status-buf)
+ ;; look for a vc-dir buffer that might show this file.
+ (when (eq major-mode 'vc-dir-mode)
+ (setq found-vc-dir-buf t)
+ (let ((ddir (expand-file-name default-directory)))
+ ;; This test is cvs-string-prefix-p
+ (when (eq t (compare-strings file nil (length ddir) ddir nil nil))
+ (let*
+ ((file-short (substring file (length ddir)))
+ (backend (vc-backend file))
+ (state (and backend (vc-state file)))
+ (extra
+ (and backend
+ (vc-call-backend backend 'status-fileinfo-extra file)))
+ (entry
+ (list file-short (if state state 'unregistered) extra)))
+ (vc-dir-update (list entry) status-buf))))))
+ ;; We didn't find any vc-dir buffers, remove the hook, it is
+ ;; not needed.
+ (unless found-vc-dir-buf (remove-hook 'after-save-hook
'vc-dir-mark-buffer-changed)))))
+
;; Named-configuration entry points
(defun vc-snapshot-precondition (dir)
@@ -3307,6 +4673,30 @@
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
+;; These things should probably be generally available
+
+(defun vc-file-tree-walk (dirname func &rest args)
+ "Walk recursively through DIRNAME.
+Invoke FUNC f ARGS on each VC-managed file f underneath it."
+ (vc-file-tree-walk-internal (expand-file-name dirname) func args)
+ (message "Traversing directory %s...done" dirname))
+
+(defun vc-file-tree-walk-internal (file func args)
+ (if (not (file-directory-p file))
+ (when (vc-backend file) (apply func file args))
+ (message "Traversing directory %s..." (abbreviate-file-name file))
+ (let ((dir (file-name-as-directory file)))
+ (mapcar
+ (lambda (f) (or
+ (string-equal f ".")
+ (string-equal f "..")
+ (member f vc-directory-exclusion-list)
+ (let ((dirf (expand-file-name f dir)))
+ (or
+ (file-symlink-p dirf) ;; Avoid possible loops.
+ (vc-file-tree-walk-internal dirf func args)))))
+ (directory-files dir)))))
+
(provide 'vc)
;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, (continued)
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Dan Nicolaescu, 2008/05/01
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/01
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/02
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/02
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Sam Steingold, 2008/05/02
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/02
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v,
Eric S. Raymond <=
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/03
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Andreas Schwab, 2008/05/04
- [Emacs-diffs] Changes to emacs/lisp/vc.el,v, Eric S. Raymond, 2008/05/04