;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Credits:
;; Designed and implemented by Eric S. Raymond, originally as part of VC mode.
-;; Stefan Monnier and Dan Nicolaescu contributed substinituial work on the
+;; Stefan Monnier and Dan Nicolaescu contributed substantial work on the
;; vc-dir front end.
;;; Commentary:
;; of the file tree from the state of the currently visited buffer
;; and returns that subset, presumably to a client mode.
;;
-;; The user may be attempting to select one of three contexts: an
-;; explicitly selected fileset, the current working directory, or a
-;; global (null) context. The user may be looking at either of two
-;; different views; a buffer visiting a file, or a directory buffer
-;; generated by vc-dispatcher. The main UI problem connected with
-;; this mode is that the user may need to be able to select any of
-;; these three contexts from either view.
+;; The user may be looking at either of two different views; a buffer
+;; visiting a file, or a directory buffer generated by vc-dispatcher.
;;
;; The lower layer of this mode runs commands in subprocesses, either
;; synchronously or asynchronously. Commands may be launched in one
;; (vc-dir) sets up a dispatcher browsing buffer; (vc-dispatcher-selection-set)
;; returns a selection set of files, either the marked files in a browsing
;; buffer or the singleton set consisting of the file visited by the current
-;; buffer (when that is appropriate).
+;; buffer (when that is appropriate). It also does what is needed to ensure
+;; that on-disk files and the contents of their visiting Emacs buffers
+;; coincide.
+;;
+;; When the client mode adds a local mode-line-hook to a buffer, it
+;; will be called with the buffer file name as argument whenever the
+;; dispatcher resynchs the buffer.
;; To do:
;;
;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
-;; it should work for other async commands as well (pull/push/...).
+;; it should work for other async commands done through vc-do-command
+;; as well,
;;
;; - the *VC-log* buffer needs font-locking.
;;
-;; - Set `vc-dir-insert-directories' to t and check what operations
-;; and backends do not support directory arguments and fix them.
-;;
;; - vc-dir needs mouse bindings.
;;
-;; - vc-dir needs more key bindings for VC actions.
-;;
;; - vc-dir toolbar needs more icons.
;;
-;; - vc-dir-next-line should not print an "end of buffer" message when
-;; invoked with the cursor on the last file.
-;;
-;; - add commands to move to the prev/next directory in vc-dir.
-;;
-;; - document vc-dir in the manual.
+;; - vc-dir-menu-map-filter hook call needs to be moved to vc.el.
;;
-(provide 'vc-dispatcher)
+(require 'vc-hooks)
+(require 'ewoc)
(eval-when-compile
- (require 'cl)
- (require 'dired) ; for dired-map-over-marks macro
- (require 'dired-aux)) ; for dired-kill-{line,tree}
+ (require 'cl))
+
+(declare-function vc-log-edit "vc" (fileset))
+(declare-function vc-buffer-sync "vc" (&optional not-urgent))
;; General customization
;; In a log entry buffer, this is a local variable
;; that points to the buffer for which it was made
-;; (either a file, or a VC dired buffer).
+;; (either a file, or a VC directory buffer).
(defvar vc-parent-buffer nil)
(put 'vc-parent-buffer 'permanent-local t)
(defvar vc-parent-buffer-name nil)
;;;###autoload
(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
- "Execute a VC command, notifying user and checking for errors.
-Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
-current buffer if BUFFER is t. If the destination buffer is not
-already current, set it up properly and erase it. The command is
-considered successful if its exit status does not exceed OKSTATUS (if
-OKSTATUS is nil, that means to ignore error status, if it is `async', that
-means not to wait for termination of the subprocess; if it is t it means to
-ignore all execution errors). FILE-OR-LIST is the name of a working file;
-it may be a list of files or be nil (to execute commands that don't expect
-a file name or set of files). If an optional list of FLAGS is present,
+ "Execute a slave command, notifying user and checking for errors.
+Output from COMMAND goes to BUFFER, or the current buffer if
+BUFFER is t. If the destination buffer is not already current,
+set it up properly and erase it. The command is considered
+successful if its exit status does not exceed OKSTATUS (if
+OKSTATUS is nil, that means to ignore error status, if it is
+`async', that means not to wait for termination of the
+subprocess; if it is t it means to ignore all execution errors).
+FILE-OR-LIST is the name of a working file; it may be a list of
+files or be nil (to execute commands that don't expect a file
+name or set of files). If an optional list of FLAGS is present,
that is inserted into the command line before the filename."
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
(and (stringp buffer)
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
- (vc-setup-buffer (or buffer "*vc*")))
+ (vc-setup-buffer buffer))
;; If there's some previous async process still running, just kill it.
(let ((oldproc (get-buffer-process (current-buffer))))
;; If we wanted to wait for oldproc to finish before doing
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))
+ (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)))
+ (mark-active nil))
+ (list point-context mark-context nil)))
(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)))
-
+ (mark-context (nth 1 context)))
;; 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)))
(and (not view-mode)
(not (eq (get major-mode 'mode-class) 'special))
(view-mode-enter))))
- ;; FIXME: Call into vc.el
- (vc-mode-line buffer-file-name))
+ (run-hook-with-args 'modeline-hook buffer-file-name))
(kill-buffer (current-buffer)))))
(defun vc-resynch-buffer (file &optional keep noquery)
(when buffer
(with-current-buffer buffer
(vc-resynch-window file keep noquery)))))
- (vc-directory-resynch-file file)
- (when (memq 'vc-dir-mark-buffer-changed after-save-hook)
- (let ((buffer (get-file-buffer file)))
- (vc-dir-mark-buffer-changed file))))
+ (vc-directory-resynch-file file))
;; Command closures
\(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
+ (if (vc-dispatcher-browsing)
+ ;; If we are called from a directory browser, the parent buffer is
;; the current buffer.
(current-buffer)
(if (and files (equal (length files) 1))
(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.
+ ;; But not if it is a vc-directory buffer.
(with-current-buffer vc-parent-buffer
- (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
+ (or (vc-dispatcher-browsing) (vc-buffer-sync)))
(unless vc-log-operation
(error "No log operation is pending"))
;; save the parameters held in buffer-local variables
(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)
+ (when (vc-dispatcher-browsing)
(vc-dir-move-to-goal-column))
(run-hooks after-hook 'vc-finish-logentry-hook)))
-;; VC-Dired mode
-;; FIXME: to be removed when vc-dir support is finished
-
-(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")
-
-(defvar vc-dired-mode nil)
-(defvar vc-dired-window-configuration)
-(defvar vc-dired-switches)
-(defvar vc-dired-terse-mode)
-
-(make-variable-buffer-local 'vc-dired-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 VC"
- "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-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))))
-
;; The ewoc-based vc-directory implementation
(defcustom vc-dir-mode-hook nil
(unless create-new
(dolist (buffer (buffer-list))
(set-buffer buffer)
- (when (and (eq major-mode 'vc-dir-mode)
+ (when (and (vc-dispatcher-browsing)
(string= (expand-file-name default-directory) dir))
(return buffer)))))))
(or buf
(define-key map [open]
'(menu-item "Open file" vc-dir-find-file
:help "Find the file on the current line"))
- ;; FIXME: Stuff starting here should be appended by vc
- ;; VC info details
- (define-key map [sepvcdet] '("--"))
- (define-key map [remup]
- '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
- :help "Hide up-to-date items from display"))
- ;; 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")
+ "Menu for dispatcher status")
(defalias 'vc-dir-menu-map vc-dir-menu-map)
(define-key map "\t" 'vc-dir-next-line)
(define-key map "p" 'vc-dir-previous-line)
(define-key map [backtab] 'vc-dir-previous-line)
+ ;;; Rebind paragraph-movement commands.
+ (define-key map "\M-}" 'vc-dir-next-directory)
+ (define-key map "\M-{" 'vc-dir-prev-directory)
+ (define-key map "\M-<down>" 'vc-dir-next-directory)
+ (define-key map "\M-<up>" 'vc-dir-prev-directory)
;; The remainder.
(define-key map "f" 'vc-dir-find-file)
(define-key map "\C-m" 'vc-dir-find-file)
map vc-dir-mode-map)
map))
-;; 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."
((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))))
+ ;; 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-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
+ ((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))))))
- (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))))
+ (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-last vc-ewoc
- (apply 'vc-dir-create-fileinfo entry))))))))))
+ (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)
"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))
+ (with-no-warnings
+ (ewoc-goto-next vc-ewoc arg)
+ (vc-dir-move-to-goal-column)))
(defun vc-dir-previous-line (arg)
"Go to the previous line.
(ewoc-goto-prev vc-ewoc arg)
(vc-dir-move-to-goal-column))
+(defun vc-dir-next-directory ()
+ "Go to the next directory."
+ (interactive)
+ (let ((orig (point)))
+ (if
+ (catch 'foundit
+ (while t
+ (let* ((next (ewoc-next vc-ewoc (ewoc-locate vc-ewoc))))
+ (cond ((not next)
+ (throw 'foundit t))
+ (t
+ (progn
+ (ewoc-goto-node vc-ewoc next)
+ (vc-dir-move-to-goal-column)
+ (if (vc-dir-fileinfo->directory (ewoc-data next))
+ (throw 'foundit nil))))))))
+ (goto-char orig))))
+
+(defun vc-dir-prev-directory ()
+ "Go to the previous directory."
+ (interactive)
+ (let ((orig (point)))
+ (if
+ (catch 'foundit
+ (while t
+ (let* ((prev (ewoc-prev vc-ewoc (ewoc-locate vc-ewoc))))
+ (cond ((not prev)
+ (throw 'foundit t))
+ (t
+ (progn
+ (ewoc-goto-node vc-ewoc prev)
+ (vc-dir-move-to-goal-column)
+ (if (vc-dir-fileinfo->directory (ewoc-data prev))
+ (throw 'foundit nil))))))))
+ (goto-char orig))))
+
(defun vc-dir-mark-unmark (mark-unmark-function)
(if (use-region-p)
(let ((firstl (line-number-at-pos (region-beginning)))
(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)))
+ ;; 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 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)))
+ (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)))
+ (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.
(setq crt (ewoc-next vc-ewoc crt)))))
result))
-(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)))
- (state
- (funcall (vc-client-object->file-to-state vc-client-mode)
- file))
- (extra
- (funcall (vc-client-object->file-to-extra vc-client-mode)
- file))
- (entry
- (list file-short state 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)))))
+(defun vc-directory-resynch-file (&optional fname)
+ "Update the entries for FILE in any directory buffers that list it."
+ (let ((file (or fname (expand-file-name buffer-file-name))))
+ ;; The vc-dir case
+ (let ((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)))
+ (state
+ (funcall (vc-client-object->file-to-state vc-client-mode)
+ file))
+ (extra
+ (funcall (vc-client-object->file-to-extra vc-client-mode)
+ file))
+ (entry
+ (list file-short state 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-directory-resynch-file))))))
(defun vc-dir-mode (client-object)
"Major mode for showing the VC status for a directory.
(set (make-local-variable 'vc-ewoc)
(ewoc-create (vc-client-object->file-to-info client-object)
(vc-client-object->headers client-object)))
- (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed)
+ (add-hook 'after-save-hook 'vc-directory-resynch-file)
;; 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)
(put 'vc-dir-mode 'mode-class 'special)
-(defun vc-buffer-sync (&optional not-urgent)
- "Make sure the current buffer and its working file are in sync.
-NOT-URGENT means it is ok to continue if the user says not to save."
- (when (buffer-modified-p)
- (if (or vc-suppress-confirm
- (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
- (save-buffer)
- (unless not-urgent
- (error "Aborted")))))
-
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
- (or vc-dired-mode (eq major-mode 'vc-dir-mode)))
-
-(defun vc-dispatcher-selection-set (eligible
- &optional
- allow-directory-wildcard
- allow-inegible
- include-files-not-directories)
- "Deduce a set of files to which to apply an operation. Return the fileset.
-If we're in VC-dired mode, the fileset is the list of marked files.
-Otherwise, if we're looking at a buffer for which ELIGIBLE returns non-NIL,
-the fileset is a singleton containing this file.
-If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
-and we're in a dired buffer, select the current directory.
-If none of these conditions is met, but ALLOW-INELIGIBLE is on and the
-visited file is not registered, return a singleton fileset containing it.
-If INCLUDE-FILES-NOT-DIRECTORIES then if directories are marked,
-return the list of VC files in those directories instead of
-the directories themselves.
-Otherwise, throw an error."
+ (derived-mode-p 'vc-dir-mode))
+
+(defun vc-dispatcher-in-fileset-p (fileset)
+ (let ((member nil))
+ (while (and (not member) fileset)
+ (let ((elem (pop fileset)))
+ (if (if (file-directory-p elem)
+ (eq t (compare-strings buffer-file-name nil (length elem)
+ elem nil nil))
+ (eq (current-buffer) (get-file-buffer elem)))
+ (setq member t))))
+ member))
+
+(defun vc-dispatcher-selection-set (&optional observer)
+ "Deduce a set of files to which to apply an operation. Return the fileset.
+If we're in a directory display, the fileset is the list of marked files (if
+there is one) else the file on the curreent line. If not in a directory
+display, but the current buffer visits a file, the fileset is a singleton
+containing that file. Otherwise, throw an error."
(let ((files
- (cond
- ;; Browsing with dired
- (vc-dired-mode
- (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
- (if marked
- marked
- (error "No files have been selected."))))
- ;; Browsing with vc-dir
- ((eq major-mode 'vc-dir-mode)
- (or
- (if include-files-not-directories
- (vc-dir-marked-only-files)
- (vc-dir-marked-files))
- (list (vc-dir-current-file))))
- ;; Visiting an eligible file
- ((funcall eligible buffer-file-name)
- (list buffer-file-name))
- ;; No eligible file -- if there's a parent buffer, deuce from there
- ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
- (with-current-buffer vc-parent-buffer
- (vc-dispatcher-browsing))))
- (progn
- (set-buffer vc-parent-buffer)
- (vc-dispatcher-selection-set)))
- ;; No parent buffer, we may want to select entire directory
- ;;
- ;; This is guarded by an enabling arg so users won't potentially
- ;; shoot themselves in the foot by modifying a fileset they can't
- ;; verify by eyeball. Allow it for nondestructive commands like
- ;; making diffs, or possibly for destructive ones that have
- ;; confirmation prompts.
- ((and allow-directory-wildcard
- ;; I think this is a misfeature. For now, I'll leave it in, but
- ;; I'll disable it anywhere else than in dired buffers. --Stef
- (and (derived-mode-p 'dired-mode)
- (equal buffer-file-name nil)
- (equal list-buffers-directory default-directory)))
- (progn
- (message "All eligible files below %s selected."
- default-directory)
- (list default-directory)))
- ;; Last, if we're allowing ineligible files and visiting one, select it.
- ((and allow-ineligible (not (eligible buffer-file-name)))
- (list buffer-file-name))
- ;; No good set here, throw error
- (t (error "No fileset is available here.")))))
- ;; We assume, in order to avoid unpleasant surprises to the user,
- ;; that a fileset is not in good shape to be handed to the user if the
- ;; buffers visting the fileset don't match the on-disk contents.
- (dolist (file files)
- (let ((visited (get-file-buffer file)))
- (when visited
- (if (or vc-dired-mode (eq major-mode 'vc-dir-mode))
- (switch-to-buffer-other-window visited)
- (set-buffer visited))
- ;; Check relation of buffer and file, and make sure
- ;; user knows what he's doing. First, finding the file
- ;; will check whether the file on disk is newer.
- ;; Ignore buffer-read-only during this test, and
- ;; preserve find-file-literally.
- (let ((buffer-read-only (not (file-writable-p file))))
- (find-file-noselect file nil find-file-literally))
- (if (not (verify-visited-file-modtime (current-buffer)))
- (if (yes-or-no-p (format "Replace %s on disk with buffer contents? " file))
- (write-file buffer-file-name)
- (error "Aborted"))
- ;; Now, check if we have unsaved changes.
- (vc-buffer-sync t)
- (when (buffer-modified-p)
- (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
- (error "Aborted")))))))
+ (cond
+ ;; Browsing with vc-dir
+ ((vc-dispatcher-browsing)
+ (or (vc-dir-marked-files) (list (vc-dir-current-file))))
+ ;; Visiting an eligible file
+ ((buffer-file-name)
+ (list buffer-file-name))
+ ;; No eligible file -- if there's a parent buffer, deduce from there
+ ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
+ (with-current-buffer vc-parent-buffer
+ (vc-dispatcher-browsing))))
+ (with-current-buffer vc-parent-buffer
+ (vc-dispatcher-selection-set)))
+ ;; No good set here, throw error
+ (t (error "No fileset is available here")))))
+ ;; We assume, in order to avoid unpleasant surprises to the user,
+ ;; that a fileset is not in good shape to be handed to the user if the
+ ;; buffers visiting the fileset don't match the on-disk contents.
+ (if (not observer)
+ (save-some-buffers
+ nil (lambda () (vc-dispatcher-in-fileset-p files))))
files))
+(provide 'vc-dispatcher)
+
;; arch-tag: 7d08b17f-5470-4799-914b-bfb9fcf6a246
;;; vc-dispatcher.el ends here