Mercurial > emacs
diff lisp/vc-dispatcher.el @ 94573:ce09c5078ae7
Partially undo the dispatcher split, it needs to happen more gradually
to avoid breaking things.
| author | Eric S. Raymond <esr@snark.thyrsus.com> |
|---|---|
| date | Sat, 03 May 2008 09:28:04 +0000 |
| parents | 3bdffe280ad3 |
| children | 7de38dedf0a6 |
line wrap: on
line diff
--- a/lisp/vc-dispatcher.el Sat May 03 07:39:17 2008 +0000 +++ b/lisp/vc-dispatcher.el Sat May 03 09:28:04 2008 +0000 @@ -76,52 +76,6 @@ (provide 'vc-dispatcher) -(eval-when-compile - (require 'cl) - (require 'dired) ; for dired-map-over-marks macro - (require 'dired-aux)) ; for dired-kill-{line,tree} - -(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-command-messages nil - "If non-nil, display run messages from back-end commands." - :type 'boolean - :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-dir-mode-hook nil - "Normal hook run by `vc-dir-mode'. -See `run-hooks'." - :type 'hook - :group 'vc) - -(defvar vc-log-fileset) -(defvar vc-dired-mode nil) -(make-variable-buffer-local 'vc-dired-mode) - ;; Common command execution logic (defun vc-process-filter (p s) @@ -273,7 +227,7 @@ (and (stringp buffer) (string= (buffer-name) buffer)) (eq buffer (current-buffer))) - (vc-setup-buffer buffer)) + (vc-setup-buffer (or buffer "*vc*"))) ;; 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 @@ -333,1356 +287,4 @@ ',command ',file-or-list ',flags)) status)))) -;; Context management - -(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)))))) - -(defvar vc-dired-window-configuration) - -;; Command closures - -;; FIXME: The rev argument is VCS-specific and needs to be factored out -(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-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))) - -;; 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) - ;; FIXME: This needs to be factored out - (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))) - -;; FIXME: VCS-specific knowledge in here needs to be factored out -(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)))) - -;; 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))))) - -;; FIXME: VCS-specific concept of backend needs to be factored out -(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))) - ;; FIXME: VCS-specific stuff needs to be factored out. - ;; 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))))) - -;; 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))))) +;;; vc-dispatcher.el ends here