;;; vc.el --- drive a version-control system from within Emacs
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
;; (or its free replacement, CSSC).
;;
-;; Some features will not work with old RCS versions. Where
-;; appropriate, VC finds out which version you have, and allows or
-;; disallows those features (stealing locks, for example, works only
-;; from 5.6.2 onwards).
-;; Even initial checkins will fail if your RCS version is so old that ci
-;; doesn't understand -t-; this has been known to happen to people running
-;; NExTSTEP 3.0.
-;;
-;; You can support the RCS -x option by customizing vc-rcs-master-templates.
-;;
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
;; If your site uses the ChangeLog convention supported by Emacs, the
;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
;; vc's back is turned, or move/rename master files while vc is running,
;; vc may get seriously confused. Don't do these things!
;;
-;; Developer's notes on some concurrency issues are included at the end of
-;; the file.
-;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
;; VC can use arbitrary version control systems as a backend. To add
;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
;; when all the results have been computed.
;; To provide more backend specific functionality for `vc-dir'
-;; the following functions might be needed: `status-extra-headers',
-;; `status-printer', `extra-status-menu' and `dir-status-files'.
+;; the following functions might be needed: `dir-extra-headers',
+;; `dir-printer', `extra-dir-menu' and `dir-status-files'.
;;
;; - dir-status-files (dir files default-state update-function)
;;
;; files. If not provided, the default is to consider that the files
;; are in DEFAULT-STATE.
;;
-;; - status-extra-headers (dir)
+;; - dir-extra-headers (dir)
;;
;; Return a string that will be added to the *vc-dir* buffer header.
;;
-;; - status-printer (fileinfo)
+;; - dir-printer (fileinfo)
;;
;; Pretty print the `vc-dir-fileinfo' FILEINFO.
;; If a backend needs to show more information than the default FILE
;; The default implementation deals well with all states that
;; `vc-state' can return.
;;
-;; - prettify-state-info (file)
-;;
-;; Translate the `vc-state' property of FILE into a string that can be
-;; used in a human-readable buffer. The default implementation deals well
-;; with all states that `vc-state' can return.
-;;
;; STATE-CHANGING FUNCTIONS
;;
;; * create-repo (backend)
;; arg CONTENTS-DONE is non-nil, then the contents of FILE have
;; already been reverted from a version backup, and this function
;; only needs to update the status of FILE within the backend.
+;; If FILE is in the `added' state it should be returned to the
+;; `unregistered' state.
;;
;; - rollback (files)
;;
;;
;; HISTORY FUNCTIONS
;;
-;; * print-log (files &optional buffer)
+;; * print-log (files buffer &optional shortlog start-revision limit)
;;
-;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
-;; if BUFFER is nil. (Note: older versions of this function expected
-;; only a single file argument.)
+;; Insert the revision log for FILES into BUFFER.
+;; If SHORTLOG is true insert a short version of the log.
+;; If LIMIT is true insert only insert LIMIT log entries. If the
+;; backend does not support limiting the number of entries to show
+;; it should return `limit-unsupported'.
+;; If START-REVISION is given, then show the log starting from the
+;; revision. At this point START-REVISION is only required to work
+;; in conjunction with LIMIT = 1.
;;
;; - log-view-mode ()
;;
;; Invoked from a buffer in vc-annotate-mode, return the revision
;; corresponding to the current line, or nil if there is no revision
;; corresponding to the current line.
+;; If the backend supports annotating through copies and renames,
+;; and displays a file name and a revision, then return a cons
+;; (REVISION . FILENAME).
;;
;; TAG SYSTEM
;;
;;
;; MISCELLANEOUS
;;
-;; - root (dir)
-;;
-;; Return DIR's "root" directory, that is, a parent directory of
-;; DIR for which the same backend as used for DIR applies. If no
-;; such parent exists, this function should return DIR.
-;;
;; - make-version-backups-p (file)
;;
;; Return non-nil if unmodified repository revisions of FILE should be
;; `revert' operations itself, without calling the backend system. The
;; default implementation always returns nil.
;;
+;; - root (file)
+;; Return the root of the VC controlled hierarchy for file.
+;;
;; - repository-hostname (dirname)
;;
;; Return the hostname that the backend will have to contact
;; Operation called in current buffer when opening a file. This can
;; be used by the backend to setup some local variables it might need.
;;
-;; - find-file-not-found-hook ()
-;;
-;; Operation called in current buffer when opening a non-existing file.
-;; By default, this asks the user if she wants to check out the file.
-;;
;; - extra-menu ()
;;
;; Return a menu keymap, the items in the keymap will appear at the
;; to your backend and which does not map to any of the VC generic
;; concepts.
;;
-;; - extra-status-menu ()
+;; - extra-dir-menu ()
;;
;; Return a menu keymap, the items in the keymap will appear at the
;; end of the VC Status menu. The goal is to allow backends to
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;; - C-x v b does switch to a different backend, but the mode line is not
-;; adapted accordingly. Also, it considers RCS and CVS to be the same,
-;; which is pretty confusing.
-;;
;; - vc-create-tag and vc-retrieve-tag should update the
;; buffers that might be visiting the affected files.
;;
-;;;; Default Behavior:
-;;
-;; - do not default to RCS anymore when the current directory is not
-;; controlled by any VCS and the user does C-x v v
-;;
-;; - vc-responsible-backend should not return RCS if no backend
-;; declares itself responsible.
-;;
;;;; Internal cleanups:
;;
;; - backends that care about vc-stay-local should try to take it into
;; the two branches. Or you locally add file FOO and then pull a
;; change that also adds a new file FOO, ...
;;
-;; - C-x v l should insert the file set in the *VC-log* buffer so that
-;; log-view can recognize it and use it for its commands.
-;;
-;; - vc-diff should be able to show the diff for all files in a
-;; changeset, especially for VC systems that have per repository
-;; version numbers. log-view should take advantage of this.
-;;
;; - make it easier to write logs. Maybe C-x 4 a should add to the log
;; buffer, if one is present, instead of adding to the ChangeLog.
;;
;; `diff-add-change-log-entries-other-window' to create a detailed
;; skeleton for the log...
;;
-;; - The *vc-dir* buffer needs to be updated properly after VC
-;; operations on directories that change the file VC state.
-;;
;; - most vc-dir backends need more work. They might need to
;; provide custom headers, use the `extra' field and deal with all
;; possible VC states.
;; vc-dir, it is possible that these commands are called
;; for unregistered/ignored files.
;;
-;; - Using multiple backends needs work. Given a CVS directory with some
-;; files checked into git (but not all), using C-x v l to get a log file
-;; from a file only present in git, and then typing RET on some log entry,
-;; vc will bombs out because it wants to see the file being in CVS.
-;; Those logs should likely use a local variable to hardware the VC they
-;; are supposed to work with.
+;; - vc-next-action needs work in order to work with multiple
+;; backends: `vc-state' returns the state for the default backend,
+;; not for the backend in the current *vc-dir* buffer.
+;;
+;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
+;; it should work for other async commands done through vc-do-command
+;; as well,
;;
-;;;; Problems:
+;; - vc-dir toolbar needs more icons.
;;
-;; - the *vc-dir* buffer is not updated correctly anymore after VC
-;; operations that change the file state.
+;; - The backends should avoid using `vc-file-setprop' and `vc-file-getprop'.
;;
;;; Code:
(require 'vc-hooks)
(require 'vc-dispatcher)
-(require 'tool-bar)
-(require 'ewoc)
(eval-when-compile
- (require 'cl))
+ (require 'cl)
+ (require 'dired))
(unless (assoc 'vc-parent-buffer minor-mode-alist)
(setq minor-mode-alist
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
-When running diff under a given BACKEND, VC concatenates the values of
-`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
-get the switches for that command. Thus, `vc-diff-switches' should
-contain switches that are specific to version control, but not
-specific to any particular backend."
- :type '(choice (const :tag "None" nil)
+When running diff under a given BACKEND, VC uses the first
+non-nil value of `vc-BACKEND-diff-switches', `vc-diff-switches',
+and `diff-switches', in that order. Since nil means to check the
+next variable in the sequence, either of the first two may use
+the value t to mean no switches at all. `vc-diff-switches'
+should contain switches that are specific to version control, but
+not specific to any particular backend."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
(string :tag "Argument String")
- (repeat :tag "Argument List"
- :value ("")
- string))
+ (repeat :tag "Argument List" :value ("") string))
:group 'vc
:version "21.1")
(defcustom vc-diff-knows-L nil
- "*Indicates whether diff understands the -L option.
+ "Indicates whether diff understands the -L option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use -L and sets this variable to remember whether it worked."
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
:group 'vc)
+(defcustom vc-log-show-limit 2000
+ "Limit the number of items shown by the VC log commands.
+Zero means unlimited.
+Not all VC backends are able to support this feature."
+ :type 'integer
+ :group 'vc)
+
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
:group 'vc
:version "21.1")
-(defcustom vc-annotate-display-mode 'fullscale
- "Which mode to color the output of \\[vc-annotate] with by default."
- :type '(choice (const :tag "By Color Map Range" nil)
- (const :tag "Scale to Oldest" scale)
- (const :tag "Scale Oldest->Newest" fullscale)
- (number :tag "Specify Fractional Number of Days"
- :value "20.5"))
- :group 'vc)
-
;;;###autoload
(defcustom vc-checkin-hook nil
"Normal hook (list of functions) run after commit or file checkin.
:type 'hook
:group 'vc)
-;; Annotate customization
-(defcustom vc-annotate-color-map
- (if (and (tty-display-color-p) (<= (display-color-cells) 8))
- ;; A custom sorted TTY colormap
- (let* ((colors
- (sort
- (delq nil
- (mapcar (lambda (x)
- (if (not (or
- (string-equal (car x) "white")
- (string-equal (car x) "black") ))
- (car x)))
- (tty-color-alist)))
- (lambda (a b)
- (cond
- ((or (string-equal a "red") (string-equal b "blue")) t)
- ((or (string-equal b "red") (string-equal a "blue")) nil)
- ((string-equal a "yellow") t)
- ((string-equal b "yellow") nil)
- ((string-equal a "cyan") t)
- ((string-equal b "cyan") nil)
- ((string-equal a "green") t)
- ((string-equal b "green") nil)
- ((string-equal a "magenta") t)
- ((string-equal b "magenta") nil)
- (t (string< a b))))))
- (date 20.)
- (delta (/ (- 360. date) (1- (length colors)))))
- (mapcar (lambda (x)
- (prog1
- (cons date x)
- (setq date (+ date delta)))) colors))
- ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
- '(( 20. . "#FF3F3F")
- ( 40. . "#FF6C3F")
- ( 60. . "#FF993F")
- ( 80. . "#FFC63F")
- (100. . "#FFF33F")
- (120. . "#DDFF3F")
- (140. . "#B0FF3F")
- (160. . "#83FF3F")
- (180. . "#56FF3F")
- (200. . "#3FFF56")
- (220. . "#3FFF83")
- (240. . "#3FFFB0")
- (260. . "#3FFFDD")
- (280. . "#3FF3FF")
- (300. . "#3FC6FF")
- (320. . "#3F99FF")
- (340. . "#3F6CFF")
- (360. . "#3F3FFF")))
- "Association list of age versus color, for \\[vc-annotate].
-Ages are given in units of fractional days. Default is eighteen
-steps using a twenty day increment, from red to blue. For TTY
-displays with 8 or fewer colors, the default is red to blue with
-all other colors between (excluding black and white)."
- :type 'alist
- :group 'vc)
-
-(defcustom vc-annotate-very-old-color "#3F3FFF"
- "Color for lines older than the current color range in \\[vc-annotate]]."
- :type 'string
- :group 'vc)
-
-(defcustom vc-annotate-background "black"
- "Background color for \\[vc-annotate].
-Default color is used if nil."
- :type '(choice (const :tag "Default background" nil) (color))
- :group 'vc)
-
-(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
- "Menu elements for the mode-specific menu of VC-Annotate mode.
-List of factors, used to expand/compress the time scale. See `vc-annotate'."
- :type '(repeat number)
- :group 'vc)
-
-(defvar vc-annotate-mode-map
- (let ((m (make-sparse-keymap)))
- (define-key m "A" 'vc-annotate-revision-previous-to-line)
- (define-key m "D" 'vc-annotate-show-diff-revision-at-line)
- (define-key m "f" 'vc-annotate-find-revision-at-line)
- (define-key m "J" 'vc-annotate-revision-at-line)
- (define-key m "L" 'vc-annotate-show-log-revision-at-line)
- (define-key m "N" 'vc-annotate-next-revision)
- (define-key m "P" 'vc-annotate-prev-revision)
- (define-key m "W" 'vc-annotate-working-revision)
- (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
- m)
- "Local keymap used for VC-Annotate mode.")
-
;; Header-insertion hair
(defcustom vc-static-header-alist
'(("\\.c\\'" .
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
- "*Associate static header string templates with file types.
+ "Associate static header string templates with file types.
A \%s in the template is replaced with the first string associated with
the file's version control type in `vc-header-alist'."
:type '(repeat (cons :format "%v"
(defcustom vc-comment-alist
'((nroff-mode ".\\\"" ""))
- "*Special comment delimiters for generating VC headers.
+ "Special comment delimiters for generating VC headers.
Add an entry in this list if you need to override the normal `comment-start'
and `comment-end' variables. This will only be necessary if the mode language
is sensitive to blank lines."
:group 'vc)
(defcustom vc-checkout-carefully (= (user-uid) 0)
- "*Non-nil means be extra-careful in checkout.
+ "Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
and that its contents match what the master file says."
:type 'boolean
;;; Code for deducing what fileset and backend to assume
-(defun vc-responsible-backend (file &optional register)
+(defun vc-backend-for-registration (file)
+ "Return a backend that can be used for registering FILE.
+
+If no backend declares itself responsible for FILE, then FILE
+must not be in a version controlled directory, so try to create a
+repository, prompting for the directory and the VC backend to
+use."
+ (catch 'found
+ ;; First try: find a responsible backend, it must be a backend
+ ;; under which FILE is not yet registered.
+ (dolist (backend vc-handled-backends)
+ (and (not (vc-call-backend backend 'registered file))
+ (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend)))
+ ;; no responsible backend
+ (let* ((possible-backends
+ (let (pos)
+ (dolist (crt vc-handled-backends)
+ (when (vc-find-backend-function crt 'create-repo)
+ (push crt pos)))
+ pos))
+ (bk
+ (intern
+ ;; Read the VC backend from the user, only
+ ;; complete with the backends that have the
+ ;; 'create-repo method.
+ (completing-read
+ (format "%s is not in a version controlled directory.\nUse VC backend: " file)
+ (mapcar 'symbol-name possible-backends) nil t)))
+ (repo-dir
+ (let ((def-dir (file-name-directory file)))
+ ;; read the directory where to create the
+ ;; repository, make sure it's a parent of
+ ;; file.
+ (read-file-name
+ (format "create %s repository in: " bk)
+ default-directory def-dir t nil
+ (lambda (arg)
+ (message "arg %s" arg)
+ (and (file-directory-p arg)
+ (vc-string-prefix-p (expand-file-name arg) def-dir)))))))
+ (let ((default-directory repo-dir))
+ (vc-call-backend bk 'create-repo))
+ (throw 'found bk))))
+
+(defun vc-responsible-backend (file)
"Return the name of a backend system that is responsible for FILE.
-The optional argument REGISTER means that a backend suitable for
-registration should be found.
-If REGISTER is nil, then if FILE is already registered, return the
-backend of FILE. If FILE is not registered, or a directory, then the
+If FILE is already registered, return the
+backend of FILE. If FILE is not registered, then the
first backend in `vc-handled-backends' that declares itself
-responsible for FILE is returned. If no backend declares itself
-responsible, return the first backend.
-
-If REGISTER is non-nil, return the first responsible backend under
-which FILE is not yet registered. If there is no such backend, return
-the first backend under which FILE is not yet registered, but could
-be registered."
- (when (not vc-handled-backends)
- (error "No handled backends"))
- (or (and (not (file-directory-p file)) (not register) (vc-backend file))
+responsible for FILE is returned."
+ (or (and (not (file-directory-p file)) (vc-backend file))
(catch 'found
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
(dolist (backend vc-handled-backends)
- (and (or (not register)
- (not (vc-call-backend backend 'registered file)))
- (vc-call-backend backend 'responsible-p file)
- (throw 'found backend)))
- ;; no responsible backend
- (if (not register)
- ;; if this is not for registration, the first backend must do
- (car vc-handled-backends)
- ;; for registration, we need to find a new backend that
- ;; could register FILE
- (dolist (backend vc-handled-backends)
- (and (not (vc-call-backend backend 'registered file))
- (vc-call-backend backend 'could-register file)
- (throw 'found backend)))
- (error "No backend that could register")))))
+ (and (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend))))
+ (error "No VC backend is responsible for %s" file)))
(defun vc-expand-dirs (file-or-dir-list)
"Expands directories in a file list specification.
(unless (file-directory-p node) (push node flattened)))
(nreverse flattened)))
-(defun vc-derived-from-dir-mode (&optional buffer)
- "Are we in a VC-directory buffer, or do we have one as an ancestor?"
- (let ((buffer (or buffer (current-buffer))))
- (cond ((derived-mode-p 'vc-dir-mode) t)
- (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer))
- (t nil))))
-
-(defvar vc-dir-backend nil
- "The backend used by the current *vc-dir* buffer.")
-
-;; FIXME: this is not functional, commented out.
-;; (defun vc-deduce-fileset (&optional observer)
-;; "Deduce a set of files and a backend to which to apply an operation and
-;; the common state of the fileset. Return (BACKEND . FILESET)."
-;; (let* ((selection (vc-dispatcher-selection-set observer))
-;; (raw (car selection)) ;; Selection as user made it
-;; (cooked (cdr selection)) ;; Files only
-;; ;; FIXME: Store the backend in a buffer-local variable.
-;; (backend (if (vc-derived-from-dir-mode (current-buffer))
-;; ;; FIXME: this should use vc-dir-backend from
-;; ;; the *vc-dir* buffer.
-;; (vc-responsible-backend default-directory)
-;; (assert (and (= 1 (length raw))
-;; (not (file-directory-p (car raw)))))
-;; (vc-backend (car cooked)))))
-;; (cons backend selection)))
-
-(defun vc-deduce-fileset (&optional observer allow-unregistered only-files)
+(defvar vc-dir-backend)
+
+(declare-function vc-dir-current-file "vc-dir" ())
+(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+
+(defun vc-deduce-fileset (&optional observer allow-unregistered
+ state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND FILESET FILESET-ONLY-FILES).
+Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
If we're in VC-dir mode, the fileset is the list of marked files.
Otherwise, if we're looking at a buffer visiting a version-controlled file,
the fileset is a singleton containing this file.
If none of these conditions is met, but ALLOW_UNREGISTERED is on and the
visited file is not registered, return a singleton fileset containing it.
Otherwise, throw an error.
-ONLY-FILES if non-nil, means that the caller needs to FILESET-ONLY-FILES
-info. Otherwise, that part may be skipped.
-BEWARE: this function may change the current buffer."
+
+STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
+the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
+part may be skipped.
+BEWARE: this function may change the
+current buffer."
;; FIXME: OBSERVER is unused. The name is not intuitive and is not
;; documented. It's set to t when called from diff and print-log.
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
- (let ((marked (vc-dir-marked-files)))
- (if marked
- (list vc-dir-backend marked
- (if only-files (vc-dir-marked-only-files)))
- (let ((crt (vc-dir-current-file)))
- (list vc-dir-backend (list crt)
- (if only-files (vc-dir-child-files)))))))
+ (vc-dir-deduce-fileset state-model-only-files))
+ ((derived-mode-p 'dired-mode)
+ (if observer
+ (vc-dired-deduce-fileset)
+ (error "State changing VC operations not supported in `dired-mode'")))
((setq backend (vc-backend buffer-file-name))
- (list backend (list buffer-file-name) (list buffer-file-name)))
+ (if state-model-only-files
+ (list backend (list buffer-file-name)
+ (list buffer-file-name)
+ (vc-state buffer-file-name)
+ (vc-checkout-model backend buffer-file-name))
+ (list backend (list buffer-file-name))))
((and (buffer-live-p vc-parent-buffer)
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (eq major-mode 'vc-dir-mode))))
+ (derived-mode-p 'vc-dir-mode))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered only-files)))
+ (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
((not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
- (list (vc-responsible-backend
- (file-name-directory (buffer-file-name)))
- (list buffer-file-name) (list buffer-file-name)))
- (t (error "No fileset is available here.")))))
+ (if state-model-only-files
+ (list (vc-backend-for-registration (buffer-file-name))
+ (list buffer-file-name)
+ (list buffer-file-name)
+ (when state-model-only-files 'unregistered)
+ nil)
+ (list (vc-backend-for-registration (buffer-file-name))
+ (list buffer-file-name))))
+ (t (error "No fileset is available here")))))
+
+(defun vc-dired-deduce-fileset ()
+ (let ((backend (vc-responsible-backend default-directory)))
+ (unless backend (error "Directory not under VC"))
+ (list backend
+ (dired-map-over-marks (dired-get-filename nil t) nil))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
- ((vc-dispatcher-browsing)
+ ((derived-mode-p 'vc-dir-mode)
(set-buffer (find-file-noselect (vc-dir-current-file))))
(t
(while (and vc-parent-buffer
If the repository file is changed, you are asked if you want to
merge in the changes into your working copy."
(interactive "P")
- (let* ((vc-fileset (vc-deduce-fileset nil t 'only-files))
+ (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
(files (nth 1 vc-fileset))
(fileset-only-files (nth 2 vc-fileset))
;; FIXME: We used to call `vc-recompute-state' here.
- (state (vc-state (car fileset-only-files)))
+ (state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
;; among all the `files'.
- (model
- ;; FIXME: This is not very elegant...
- (when (and state (not (eq state 'unregistered)))
- (vc-checkout-model backend files)))
+ (model (nth 4 vc-fileset))
revision)
- ;; Check that all files are in a consistent state, since we use that
- ;; state to decide which operation to perform.
- (dolist (file (cdr fileset-only-files))
- (unless (vc-compatible-state (vc-state file) state)
- (error "%s:%s clashes with %s:%s"
- file (vc-state file) (car fileset-only-files) state)))
-
;; Do the right thing
(cond
((eq state 'missing)
- (error "Fileset files are missing, so cannot be operated on."))
+ (error "Fileset files are missing, so cannot be operated on"))
((eq state 'ignored)
- (error "Fileset files are ignored by the version-control system."))
+ (error "Fileset files are ignored by the version-control system"))
((or (null state) (eq state 'unregistered))
(vc-register nil vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
(verbose
;; go to a different revision
(setq revision (read-string "Branch, revision, or backend to move to: "))
- (let ((vsym (intern-soft (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends))
+ (let ((vsym (intern-soft revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
(vc-checkout file (eq model 'implicit) revision)))))
((not (eq model 'implicit))
;; finishing the log entry and committing.
(not (and visited (buffer-modified-p))))
(vc-revert-file file)
- (delete file ready-for-commit)))))
+ (setq ready-for-commit (delete file ready-for-commit))))))
;; Remaining files need to be committed
(if (not ready-for-commit)
(message "No files remain to be committed")
(if (not verbose)
- (vc-checkin ready-for-commit)
- (progn
- (setq revision (read-string "New revision or backend: "))
- (let ((vsym (intern (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
- (vc-checkin ready-for-commit revision))))))))
+ (vc-checkin ready-for-commit backend)
+ (setq revision (read-string "New revision or backend: "))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg)))
+ vc-handled-backends))
+ (let ((vsym (intern revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
+ (vc-checkin ready-for-commit backend revision)))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
;; In the old days, we computed the revision once and used it on
;; show that the file is locked now.
(vc-clear-headers file)
(write-file buffer-file-name)
- (vc-mode-line file))
+ (vc-mode-line file backend))
(if (not (yes-or-no-p
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
nil t)))))
(vc-call-backend backend 'create-repo))
+(declare-function vc-dir-move-to-goal-column "vc-dir" ())
+
;;;###autoload
(defun vc-register (&optional set-revision vc-fileset comment)
"Register into a version control system.
(not (file-exists-p buffer-file-name)))
(set-buffer-modified-p t))
(vc-buffer-sync)))))
- (lexical-let ((backend backend)
- (files files))
- (vc-start-logentry
- files
- (if set-revision
- (read-string (format "Initial revision level for %s: " files))
- (vc-call-backend backend 'init-revision))
- (or comment (not vc-initial-comment))
- nil
- "Enter initial comment."
- "*VC-log*"
- (lambda (files rev comment)
- (message "Registering %s... " files)
- (mapc 'vc-file-clearprops files)
- (vc-call-backend backend 'register files rev comment)
- (dolist (file files)
- (vc-file-setprop file 'vc-backend backend)
- ;; FIXME: This is wrong: it should set `backup-inhibited' in all
- ;; the buffers visiting files affected by this `vc-register', not
- ;; in the current-buffer.
- ;; (unless vc-make-backup-files
- ;; (make-local-variable 'backup-inhibited)
- ;; (setq backup-inhibited t))
- )
- (message "Registering %s... done" files))))))
+ (message "Registering %s... " files)
+ (mapc 'vc-file-clearprops files)
+ (vc-call-backend backend 'register files
+ (if set-revision
+ (read-string (format "Initial revision level for %s: " files))
+ (vc-call-backend backend 'init-revision))
+ comment)
+ (mapc
+ (lambda (file)
+ (vc-file-setprop file 'vc-backend backend)
+ ;; FIXME: This is wrong: it should set `backup-inhibited' in all
+ ;; the buffers visiting files affected by this `vc-register', not
+ ;; in the current-buffer.
+ ;; (unless vc-make-backup-files
+ ;; (make-local-variable 'backup-inhibited)
+ ;; (setq backup-inhibited t))
+
+ (vc-resynch-buffer file vc-keep-workfiles t))
+ files)
+ (when (derived-mode-p 'vc-dir-mode)
+ (vc-dir-move-to-goal-column))
+ (message "Registering %s... done" files)))
(defun vc-register-with (backend)
"Register the current file with a specified back end."
(interactive "SBackend: ")
(when (not (member backend vc-handled-backends))
- (error "Unknown back end."))
+ (error "Unknown back end"))
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
(run-hooks 'vc-checkout-hook))
(defun vc-mark-resolved (backend files)
- (with-vc-properties
- files
- (vc-call-backend backend 'mark-resolved files)
- ;; XXX: Is this TRTD? Might not be.
- `((vc-state . edited))))
+ (prog1 (with-vc-properties
+ files
+ (vc-call-backend backend 'mark-resolved files)
+ ;; FIXME: Is this TRTD? Might not be.
+ `((vc-state . edited)))
+ (message
+ (substitute-command-keys
+ "Conflicts have been resolved in %s. \
+Type \\[vc-next-action] to check in changes.")
+ (if (> (length files) 1)
+ (format "%d files" (length files))
+ "this file"))))
(defun vc-steal-lock (file rev owner)
"Steal the lock on FILE."
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-checkin (files &optional rev comment initial-contents)
+(defun vc-checkin (files backend &optional rev comment initial-contents)
"Check in FILES.
The optional argument REV may be a string specifying the new revision
level (if nil increment the current level). COMMENT is a comment
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (vc-start-logentry
- files rev comment initial-contents
- "Enter a change comment."
- "*VC-log*"
- (lambda (files rev comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (with-vc-properties
- files
- ;; We used to change buffers to get local value of vc-checkin-switches,
- ;; but 'the' local buffer is not a well-defined concept for filesets.
- (progn
- (vc-call checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files)))
- 'vc-checkin-hook))
+ (lexical-let
+ ((backend backend))
+ (vc-start-logentry
+ files rev comment initial-contents
+ "Enter a change comment."
+ "*VC-log*"
+ (lambda (files rev comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "This log message intentionally left almost blank".
+ ;; RCS 5.7 gripes about white-space-only comments too.
+ (or (and comment (string-match "[^\t\n ]" comment))
+ (setq comment "*** empty log message ***"))
+ (with-vc-properties
+ files
+ ;; We used to change buffers to get local value of vc-checkin-switches,
+ ;; but 'the' local buffer is not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files)))
+ 'vc-checkin-hook)))
;;; Additional entry points for examining version histories
'undecided))
(defun vc-switches (backend op)
+ "Return a list of vc-BACKEND switches for operation OP.
+BACKEND is a symbol such as `CVS', which will be downcased.
+OP is a symbol such as `diff'.
+
+In decreasing order of preference, return the value of:
+vc-BACKEND-OP-switches (e.g. `vc-cvs-diff-switches');
+vc-OP-switches (e.g. `vc-diff-switches'); or, in the case of
+diff only, `diff-switches'.
+
+If the chosen value is not a string or a list, return nil.
+This is so that you may set, e.g. `vc-svn-diff-switches' to t in order
+to override the value of `vc-diff-switches' and `diff-switches'."
(let ((switches
(or (when backend
(let ((sym (vc-make-backend-sym
;; I made it conditional on vc-diff-added-files but it should probably
;; just be removed (or copied/moved to specific backends). --Stef.
(when vc-diff-added-files
- (let ((filtered '()))
+ (let ((filtered '())
+ process-file-side-effects)
(dolist (file files)
(if (or (file-directory-p file)
(not (string= (vc-working-revision file) "0")))
;; because we don't know that yet.
t)))
+(defun vc-read-revision (prompt &optional files backend default initial-input)
+ (cond
+ ((null files)
+ (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
+ (setq files (cadr vc-fileset))
+ (setq backend (car vc-fileset))))
+ ((null backend) (setq backend (vc-backend (car files)))))
+ (let ((completion-table
+ (vc-call-backend backend 'revision-completion-table files)))
+ (if completion-table
+ (completing-read prompt completion-table
+ nil nil initial-input nil default)
+ (read-string prompt initial-input nil default))))
+
;;;###autoload
(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(files (cadr vc-fileset))
(backend (car vc-fileset))
(first (car files))
- (completion-table
- (vc-call-backend backend 'revision-completion-table files))
(rev1-default nil)
(rev2-default nil))
(cond
"Older revision: "))
(rev2-prompt (concat "Newer revision (default "
(or rev2-default "current source") "): "))
- (rev1 (if completion-table
- (completing-read rev1-prompt completion-table
- nil nil nil nil rev1-default)
- (read-string rev1-prompt nil nil rev1-default)))
- (rev2 (if completion-table
- (completing-read rev2-prompt completion-table
- nil nil nil nil rev2-default)
- (read-string rev2-prompt nil nil rev2-default))))
+ (rev1 (vc-read-revision rev1-prompt files backend rev1-default))
+ (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
(when (string= rev1 "") (setq rev1 nil))
(when (string= rev2 "") (setq rev2 nil))
(list files rev1 rev2))))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
- (error "Not a valid revision range."))
+ (error "Not a valid revision range"))
;; Yes, it's painful to call (vc-deduce-fileset) again. Alas, the
;; placement rules for (interactive) don't actually leave us a choice.
- (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 (interactive-p)))
-
-;; (defun vc-contains-version-controlled-file (dir)
-;; "Return t if DIR contains a version-controlled file, nil otherwise."
-;; (catch 'found
-;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
-;; nil))
+ (vc-diff-internal t (vc-deduce-fileset t) rev1 rev2
+ (called-interactively-p 'interactive)))
;;;###autoload
(defun vc-diff (historic &optional not-urgent)
(if historic
(call-interactively 'vc-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p))))
+ (vc-diff-internal t (vc-deduce-fileset t) nil nil
+ (called-interactively-p 'interactive))))
+
+;;;###autoload
+(defun vc-root-diff (historic &optional not-urgent)
+ "Display diffs between file revisions.
+Normally this compares the currently selected fileset with their
+working revisions. With a prefix argument HISTORIC, it reads two revision
+designators specifying which revisions to compare.
+
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+ (interactive (list current-prefix-arg t))
+ (if historic
+ ;; FIXME: this does not work right, `vc-version-diff' ends up
+ ;; calling `vc-deduce-fileset' to find the files to diff, and
+ ;; that's not what we want here, we want the diff for the VC root dir.
+ (call-interactively 'vc-version-diff)
+ (when buffer-file-name (vc-buffer-sync not-urgent))
+ (let ((backend
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+ (vc-mode (vc-backend buffer-file-name))))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ (vc-diff-internal
+ t (list backend (list rootdir) working-revision) nil nil
+ (called-interactively-p 'interactive)))))
;;;###autoload
(defun vc-revision-other-window (rev)
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
- (let ((completion-table
- (vc-call revision-completion-table buffer-file-name))
- (prompt "Revision to visit (default is working revision): "))
- (list
- (if completion-table
- (completing-read prompt completion-table)
- (read-string prompt))))))
+ (list
+ (vc-read-revision "Revision to visit (default is working revision): "
+ (list buffer-file-name)))))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(revision (if (string-equal rev "")
(vc-checkout file t)
(error "Merge aborted"))))
(setq first-revision
- (read-string (concat "Branch or revision to merge from "
- "(default news on current branch): ")))
+ (vc-read-revision
+ (concat "Branch or revision to merge from "
+ "(default news on current branch): ")
+ (list file)
+ backend))
(if (string= first-revision "")
(setq status (vc-call-backend backend 'merge-news file))
(if (not (vc-find-backend-function backend 'merge))
(error "Sorry, merging is not implemented for %s" backend)
(if (not (vc-branch-p first-revision))
(setq second-revision
- (read-string "Second revision: "
- (concat (vc-branch-part first-revision) ".")))
+ (vc-read-revision
+ "Second revision: "
+ (list file) backend nil
+ ;; FIXME: This is CVS/RCS/SCCS specific.
+ (concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-BACKEND-merge understands us.
(setq second-revision first-revision)
;;;###autoload
(defalias 'vc-resolve-conflicts 'smerge-ediff)
-;; VC status implementation
-
-(defun vc-default-status-extra-headers (backend dir)
- ;; Be loud by default to remind people to add code to display
- ;; backend specific headers.
- ;; XXX: change this to return nil before the release.
- (concat
- (propertize "Extra : " 'face 'font-lock-type-face)
- (propertize "Please add backend specific headers here. It's easy!"
- 'face 'font-lock-warning-face)))
-
-(defun vc-dir-headers (backend dir)
- "Display the headers in the *VC dir* 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* ((isdir (vc-dir-fileinfo->directory fileentry))
- (state (if isdir 'DIRECTORY (vc-dir-fileinfo->state fileentry)))
- (filename (vc-dir-fileinfo->name fileentry)))
- ;; FIXME: Backends that want to print the state in a different way
- ;; can do it by defining the `status-printer' function. Using
- ;; `prettify-state-info' adds two extra vc-calls per item, which
- ;; is too expensive.
- ;;(prettified (if isdir state (vc-call-backend backend 'prettify-state-info filename))))
- (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" filename)
- 'face 'font-lock-function-name-face
- 'mouse-face 'highlight))))
-
-(defun vc-default-extra-status-menu (backend)
- nil)
-
-(defun vc-dir-refresh-files (files default-state)
- "Refresh some files in the *VC-dir* buffer."
- (let ((def-dir default-directory)
- (backend vc-dir-backend))
- (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)
- ;; The state for directory entries might
- ;; have been changed to 'up-to-date,
- ;; reset it, othewise it will be removed when doing 'x'
- ;; next time.
- ;; FIXME: There should be a more elegant way to do this.
- (when (and (vc-dir-fileinfo->directory info)
- (eq (vc-dir-fileinfo->state info)
- 'up-to-date))
- (setf (vc-dir-fileinfo->state info) nil))
-
- (not (vc-dir-fileinfo->needs-update info))))))))))))
-
-(defun vc-dir-refresh ()
- "Refresh the contents of the *VC-dir* 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 ((def-dir default-directory)
- (backend vc-dir-backend))
- (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-show-fileentry (file)
- "Insert an entry for a specific file into the current *VC-dir* 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-hide-up-to-date ()
- "Hide up-to-date items from display."
- (interactive)
- (ewoc-filter
- vc-ewoc
- (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
-
-(defun vc-default-status-fileinfo-extra (backend file)
- "Default absence of extra information returned for a file."
- nil)
-
-;; FIXME: Replace these with a more efficient dispatch
-
-(defun vc-generic-status-printer (fileentry)
- (vc-call-backend vc-dir-backend 'status-printer fileentry))
-
-(defun vc-generic-state (file)
- (vc-call-backend vc-dir-backend 'state file))
-
-(defun vc-generic-status-fileinfo-extra (file)
- (vc-call-backend vc-dir-backend 'status-fileinfo-extra file))
-
-(defun vc-dir-extra-menu ()
- (vc-call-backend vc-dir-backend 'extra-status-menu))
-
-(defun vc-make-backend-object (file-or-dir)
- "Create the backend capability object needed by vc-dispatcher."
- (vc-create-client-object
- "VC dir"
- (vc-dir-headers vc-dir-backend file-or-dir)
- #'vc-generic-status-printer
- #'vc-generic-state
- #'vc-generic-status-fileinfo-extra
- #'vc-dir-refresh
- #'vc-dir-extra-menu))
-
-;;;###autoload
-(defun vc-dir (dir)
- "Show the VC status for DIR."
- (interactive "DVC status for directory: ")
- (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir))
- (if (and (derived-mode-p 'vc-dir-mode) (boundp 'client-object))
- (vc-dir-refresh)
- ;; Otherwise, initialize a new view using the dispatcher layer
- (progn
- (set (make-local-variable 'vc-dir-backend) (vc-responsible-backend dir))
- ;; Build a capability object and hand it to the dispatcher initializer
- (vc-dir-mode (vc-make-backend-object dir))
- ;; FIXME: Make a derived-mode instead.
- ;; Add VC-specific keybindings
- (let ((map (current-local-map)))
- (define-key map "v" 'vc-next-action) ;; C-x v v
- (define-key map "=" 'vc-diff) ;; C-x v =
- (define-key map "i" 'vc-register) ;; C-x v i
- (define-key map "+" 'vc-update) ;; C-x v +
- (define-key map "l" 'vc-print-log) ;; C-x v l
- ;; More confusing than helpful, probably
- ;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
- ;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh
- (define-key map "x" 'vc-dir-hide-up-to-date))
- )
- ;; FIXME: Needs to alter a buffer-local map, otherwise clients may clash
- (let ((map vc-dir-menu-map))
- ;; 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"))
- )))
-
;; Named-configuration entry points
(defun vc-tag-precondition (dir)
;; Miscellaneous other entry points
+;; FIXME: this should be a defcustom
+;; FIXME: maybe add another choice:
+;; `root-directory' (or somesuch), which would mean show a short log
+;; for the root directory.
+(defvar vc-log-short-style '(directory)
+ "Whether or not to show a short log.
+If it contains `directory' then if the fileset contains a directory show a short log.
+If it contains `file' then show short logs for files.
+Not all VC backends support short logs!")
+
+(defvar log-view-vc-backend)
+(defvar log-view-vc-fileset)
+
+(defun vc-print-log-internal (backend files working-revision
+ &optional is-start-revision limit)
+ ;; Don't switch to the output buffer before running the command,
+ ;; so that any buffer-local settings in the vc-controlled
+ ;; buffer can be accessed by the command.
+ (let ((dir-present nil)
+ (vc-short-log nil)
+ pl-return)
+ (dolist (file files)
+ (when (file-directory-p file)
+ (setq dir-present t)))
+ (setq vc-short-log
+ (not (null (if dir-present
+ (memq 'directory vc-log-short-style)
+ (memq 'file vc-log-short-style)))))
+
+ (setq pl-return (vc-call-backend
+ backend 'print-log files "*vc-change-log*"
+ vc-short-log (when is-start-revision working-revision) limit))
+ (pop-to-buffer "*vc-change-log*")
+ (let ((inhibit-read-only t))
+ ;; log-view-mode used to be called with inhibit-read-only bound
+ ;; to t, so let's keep doing it, just in case.
+ (vc-call-backend backend 'log-view-mode))
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) files)
+
+ (vc-exec-after
+ `(let ((inhibit-read-only t))
+ (when (and ,limit (not ,(eq 'limit-unsupported pl-return))
+ (not ,is-start-revision))
+ (goto-char (point-max))
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (vc-print-log-internal
+ ',backend ',files ',working-revision nil (* 2 ,limit)))
+ :help-echo "Show the log again, and double the number of log entries shown"
+ "Show 2X entries")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (vc-print-log-internal
+ ',backend ',files ',working-revision nil nil))
+ :help-echo "Show the log again, showing all entries"
+ "Show unlimited entries")
+ (widget-setup))
+
+ (shrink-window-if-larger-than-buffer)
+ ;; move point to the log entry for the working revision
+ (vc-call-backend ',backend 'show-log-entry ',working-revision)
+ (setq vc-sentinel-movepoint (point))
+ (set-buffer-modified-p nil)))))
+
;;;###autoload
-(defun vc-print-log (&optional working-revision)
+(defun vc-print-log (&optional working-revision limit)
"List the change log of the current fileset in a window.
If WORKING-REVISION is non-nil, leave the point at that revision."
- (interactive)
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((rev (read-from-minibuffer "Log from revision (default: last revision): " nil
+ nil nil nil))
+ (lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (string= rev "") (setq rev nil))
+ (when (<= lim 0) (setq lim nil))
+ (list rev lim)))
+ (t
+ (list nil (when (> vc-log-show-limit 0) vc-log-show-limit)))))
(let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
(backend (car vc-fileset))
(files (cadr vc-fileset))
(working-revision (or working-revision (vc-working-revision (car files)))))
- ;; Don't switch to the output buffer before running the command,
- ;; so that any buffer-local settings in the vc-controlled
- ;; buffer can be accessed by the command.
- (vc-call-backend backend 'print-log files "*vc-change-log*")
- (pop-to-buffer "*vc-change-log*")
- (vc-exec-after
- `(let ((inhibit-read-only t))
- (vc-call-backend ',backend 'log-view-mode)
- (set (make-local-variable 'log-view-vc-backend) ',backend)
- (set (make-local-variable 'log-view-vc-fileset) ',files)
- (goto-char (point-max)) (forward-line -1)
- (while (looking-at "=*\n")
- (delete-char (- (match-end 0) (match-beginning 0)))
- (forward-line -1))
- (goto-char (point-min))
- (when (looking-at "[\b\t\n\v\f\r ]+")
- (delete-char (- (match-end 0) (match-beginning 0))))
- (shrink-window-if-larger-than-buffer)
- ;; move point to the log entry for the working revision
- (vc-call-backend ',backend 'show-log-entry ',working-revision)
- (setq vc-sentinel-movepoint (point))
- (set-buffer-modified-p nil)))))
+ (vc-print-log-internal backend files working-revision nil limit)))
+
+;;;###autoload
+(defun vc-print-root-log (&optional limit)
+ "List the change log of for the current VC controlled tree in a window."
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (<= lim 0) (setq lim nil))
+ (list lim)))
+ (t
+ (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
+ (let ((backend
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+ (vc-mode (vc-backend buffer-file-name))))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
;;;###autoload
(defun vc-revert ()
(dolist (file files)
(let ((buf (get-file-buffer file)))
(when (and buf (buffer-modified-p buf))
- (error "Please kill or save all modified buffers before reverting.")))
+ (error "Please kill or save all modified buffers before reverting")))
(when (vc-up-to-date-p file)
(unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
(error "Revert canceled"))))
(when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
- (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
+ (unless (yes-or-no-p
+ (format "Discard changes in %s? "
+ (let ((str (vc-delistify files))
+ (nfiles (length files)))
+ (if (< (length str) 50)
+ str
+ (format "%d file%s" nfiles
+ (if (= nfiles 1) "" "s"))))))
(error "Revert canceled"))
(delete-windows-on "*vc-diff*")
(kill-buffer "*vc-diff*"))
(error "Rollback requires a singleton fileset or repository versioning"))
;; FIXME: latest-on-branch-p should take the fileset.
(when (not (vc-call-backend backend 'latest-on-branch-p (car files)))
- (error "Rollback is only possible at the tip revision."))
+ (error "Rollback is only possible at the tip revision"))
;; If any of the files is visited by the current buffer, make
;; sure buffer is saved. If the user says `no', abort since
;; we cannot show the changes and ask for confirmation to
(vc-buffer-sync nil))
(dolist (file files)
(when (buffer-modified-p (get-file-buffer file))
- (error "Please kill or save all modified buffers before rollback."))
+ (error "Please kill or save all modified buffers before rollback"))
(when (not (vc-up-to-date-p file))
- (error "Please revert all modified workfiles before rollback.")))
+ (error "Please revert all modified workfiles before rollback")))
;; Accumulate changes associated with the fileset
(vc-setup-buffer "*vc-diff*")
(not-modified)
(list
(or buffer-file-name
(error "There is no version-controlled file in this buffer"))
- (let ((backend (vc-backend buffer-file-name))
+ (let ((crt-bk (vc-backend buffer-file-name))
(backends nil))
- (unless backend
+ (unless crt-bk
(error "File %s is not under version control" buffer-file-name))
;; Find the registered backends.
- (dolist (backend vc-handled-backends)
- (when (vc-call-backend backend 'registered buffer-file-name)
- (push backend backends)))
+ (dolist (crt vc-handled-backends)
+ (when (and (vc-call-backend crt 'registered buffer-file-name)
+ (not (eq crt-bk crt)))
+ (push crt backends)))
;; Find the next backend.
- (let ((def (car (delq backend (append (memq backend backends) backends))))
- (others (delete backend backends)))
+ (let ((def (car backends))
+ (others backends))
(cond
((null others) (error "No other backend to switch to"))
(current-prefix-arg
(format "Switch to backend [%s]: " def)
(mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
nil t nil nil (downcase (symbol-name def))))))
- (t def))))))
+ (t def))))))
(unless (eq backend (vc-backend file))
(vc-file-clearprops file)
(vc-file-setprop file 'vc-backend backend)
(vc-switch-backend file new-backend)
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
- (vc-mode-line file)
- (vc-checkin file nil comment (stringp comment)))))
+ (vc-mode-line file new-backend)
+ (vc-checkin file new-backend nil comment (stringp comment)))))
(defun vc-rename-master (oldmaster newfile templates)
"Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
(throw 'found f)))
(error "New file lacks a version control directory")))))
+;;;###autoload
(defun vc-delete-file (file)
"Delete file and mark it as such in the version control system."
(interactive "fVC delete file: ")
(with-current-buffer oldbuf
(let ((buffer-read-only buffer-read-only))
(set-visited-file-name new))
- (vc-backend new)
- (vc-mode-line new)
+ (vc-mode-line new (vc-backend new))
(set-buffer-modified-p nil)))))
;;;###autoload
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
-;;; The default back end. Assumes RCS-like revision numbering.
-
-(defun vc-default-revision-granularity ()
- (error "Your backend will not work with this version of VC mode."))
-
;; functions that operate on RCS revision numbers. This code should
;; also be moved into the backends. It stays for now, however, since
;; it is used in code below.
-;;;###autoload
-(defun vc-trunk-p (rev)
- "Return t if REV is a revision on the trunk."
- (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
-
(defun vc-branch-p (rev)
"Return t if REV is a branch revision."
(not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
(when index
(substring rev 0 index))))
-(defun vc-minor-part (rev)
- "Return the minor revision number of a revision number REV."
- (string-match "[0-9]+\\'" rev)
- (substring rev (match-beginning 0) (match-end 0)))
-
-(defun vc-default-previous-revision (backend file rev)
- "Return the revision number immediately preceding REV for FILE,
-or nil if there is no previous revision. This default
-implementation works for MAJOR.MINOR-style revision numbers as
-used by RCS and CVS."
- (let ((branch (vc-branch-part rev))
- (minor-num (string-to-number (vc-minor-part rev))))
- (when branch
- (if (> minor-num 1)
- ;; revision does probably not start a branch or release
- (concat branch "." (number-to-string (1- minor-num)))
- (if (vc-trunk-p rev)
- ;; we are at the beginning of the trunk --
- ;; don't know anything to return here
- nil
- ;; we are at the beginning of a branch --
- ;; return revision of starting point
- (vc-branch-part branch))))))
-
-(defun vc-default-next-revision (backend file rev)
- "Return the revision number immediately following REV for FILE,
-or nil if there is no next revision. This default implementation
-works for MAJOR.MINOR-style revision numbers as used by RCS
-and CVS."
- (when (not (string= rev (vc-working-revision file)))
- (let ((branch (vc-branch-part rev))
- (minor-num (string-to-number (vc-minor-part rev))))
- (concat branch "." (number-to-string (1+ minor-num))))))
+(define-obsolete-function-alias
+ 'vc-default-previous-version 'vc-default-previous-revision "23.1")
(defun vc-default-responsible-p (backend file)
"Indicate whether BACKEND is reponsible for FILE.
(defun vc-default-init-revision (backend) vc-default-init-revision)
-(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
-
-(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
-
-;; FIXME: This should probably be moved to vc-rcs.el and replaced in
-;; vc-cvs.el by code using cvs2cl.
-(defun vc-update-changelog-rcs2log (files)
- "Default implementation of update-changelog.
-Uses `rcs2log' which only works for RCS and CVS."
- ;; FIXME: We (c|sh)ould add support for cvs2cl
- (let ((odefault default-directory)
- (changelog (find-change-log))
- ;; Presumably not portable to non-Unixy systems, along with rcs2log:
- (tempfile (make-temp-file
- (expand-file-name "vc"
- (or small-temporary-file-directory
- temporary-file-directory))))
- (login-name (or user-login-name
- (format "uid%d" (number-to-string (user-uid)))))
- (full-name (or add-log-full-name
- (user-full-name)
- (user-login-name)
- (format "uid%d" (number-to-string (user-uid)))))
- (mailing-address (or add-log-mailing-address
- user-mail-address)))
- (find-file-other-window changelog)
- (barf-if-buffer-read-only)
- (vc-buffer-sync)
- (undo-boundary)
- (goto-char (point-min))
- (push-mark)
- (message "Computing change log entries...")
- (message "Computing change log entries... %s"
- (unwind-protect
- (progn
- (setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
- nil (list t tempfile) nil
- "-c" changelog
- "-u" (concat login-name
- "\t" full-name
- "\t" mailing-address)
- (mapcar
- (lambda (f)
- (file-relative-name
- (expand-file-name f odefault)))
- files)))
- "done"
- (pop-to-buffer (get-buffer-create "*vc*"))
- (erase-buffer)
- (insert-file-contents tempfile)
- "failed"))
- (setq default-directory (file-name-directory changelog))
- (delete-file tempfile)))))
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-prettify-state-info (backend file)
- (let* ((state (vc-state file))
- (statestring
- (cond
- ((stringp state) (concat "(locked:" state ")"))
- ((eq state 'edited) "(modified)")
- ((eq state 'needs-merge) "(merge)")
- ((eq state 'needs-update) "(update)")
- ((eq state 'added) "(added)")
- ((eq state 'removed) "(removed)")
- ((eq state 'ignored) "(ignored)")
- ((eq state 'unregistered) "(unregistered)")
- ((eq state 'unlocked-changes) "(stale)")
- (t (format "(unknown:%s)" state))))
- (buffer
- (get-file-buffer file))
- (modflag
- (if (and buffer (buffer-modified-p buffer)) "+" "")))
- (concat statestring modflag)))
-
(defun vc-default-rename-file (backend old new)
(condition-case nil
(add-name-to-file old new)
(defun vc-default-receive-file (backend file rev)
"Let BACKEND receive FILE from another version control system."
- (vc-call-backend backend 'register file rev ""))
+ (vc-call-backend backend 'register (list file) rev ""))
(defun vc-default-retrieve-tag (backend dir name update)
(if (string= name "")
(message "Checking out %s...done" file))))
(defalias 'vc-default-revision-completion-table 'ignore)
+(defalias 'vc-default-mark-resolved 'ignore)
(defun vc-default-dir-status-files (backend dir files default-state update-function)
(funcall update-function
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
-;;; Annotate functionality
-
-;; Declare globally instead of additional parameter to
-;; temp-buffer-show-function (not possible to pass more than one
-;; parameter). The use of annotate-ratio is deprecated in favor of
-;; annotate-mode, which replaces it with the more sensible "span-to
-;; days", along with autoscaling support.
-(defvar vc-annotate-ratio nil "Global variable.")
-
-;; internal buffer-local variables
-(defvar vc-annotate-backend nil)
-(defvar vc-annotate-parent-file nil)
-(defvar vc-annotate-parent-rev nil)
-(defvar vc-annotate-parent-display-mode nil)
-
-(defconst vc-annotate-font-lock-keywords
- ;; The fontification is done by vc-annotate-lines instead of font-lock.
- '((vc-annotate-lines)))
-
-(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
- "Major mode for output buffers of the `vc-annotate' command.
-
-You can use the mode-specific menu to alter the time-span of the used
-colors. See variable `vc-annotate-menu-elements' for customizing the
-menu items."
- ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
- ;; it will become a list, to avoid initial annotations being invisible.
- (add-to-invisibility-spec 'foo)
- (remove-from-invisibility-spec 'foo)
- (set (make-local-variable 'truncate-lines) t)
- (set (make-local-variable 'font-lock-defaults)
- '(vc-annotate-font-lock-keywords t))
- (view-mode 1))
-
-(defun vc-annotate-toggle-annotation-visibility ()
- "Toggle whether or not the annotation is visible."
- (interactive)
- (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
- 'remove-from-invisibility-spec
- 'add-to-invisibility-spec)
- 'vc-annotate-annotation)
- (force-window-update (current-buffer)))
-
-(defun vc-annotate-display-default (ratio)
- "Display the output of \\[vc-annotate] using the default color range.
-The color range is given by `vc-annotate-color-map', scaled by RATIO.
-The current time is used as the offset."
- (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0)))
- (message "Redisplaying annotation...")
- (vc-annotate-display ratio)
- (message "Redisplaying annotation...done"))
-
-(defun vc-annotate-oldest-in-map (color-map)
- "Return the oldest time in the COLOR-MAP."
- ;; Since entries should be sorted, we can just use the last one.
- (caar (last color-map)))
-
-(defun vc-annotate-get-time-set-line-props ()
- (let ((bol (point))
- (date (vc-call-backend vc-annotate-backend 'annotate-time))
- (inhibit-read-only t))
- (assert (>= (point) bol))
- (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
- date))
-
-(defun vc-annotate-display-autoscale (&optional full)
- "Highlight the output of \\[vc-annotate] using an autoscaled color map.
-Autoscaling means that the map is scaled from the current time to the
-oldest annotation in the buffer, or, with prefix argument FULL, to
-cover the range from the oldest annotation to the newest."
- (interactive "P")
- (let ((newest 0.0)
- (oldest 999999.) ;Any CVS users at the founding of Rome?
- (current (vc-annotate-convert-time (current-time)))
- date)
- (message "Redisplaying annotation...")
- ;; Run through this file and find the oldest and newest dates annotated.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (setq date (vc-annotate-get-time-set-line-props))
- (when (> date newest)
- (setq newest date))
- (when (< date oldest)
- (setq oldest date)))
- (forward-line 1)))
- (vc-annotate-display
- (/ (- (if full newest current) oldest)
- (vc-annotate-oldest-in-map vc-annotate-color-map))
- (if full newest))
- (message "Redisplaying annotation...done \(%s\)"
- (if full
- (format "Spanned from %.1f to %.1f days old"
- (- current oldest)
- (- current newest))
- (format "Spanned to %.1f days old" (- current oldest))))))
-
-;; Menu -- Using easymenu.el
-(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
- "VC Annotate Display Menu"
- `("VC-Annotate"
- ["By Color Map Range" (unless (null vc-annotate-display-mode)
- (setq vc-annotate-display-mode nil)
- (vc-annotate-display-select))
- :style toggle :selected (null vc-annotate-display-mode)]
- ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
- (mapcar (lambda (element)
- (let ((days (* element oldest-in-map)))
- `[,(format "Span %.1f days" days)
- (vc-annotate-display-select nil ,days)
- :style toggle :selected
- (eql vc-annotate-display-mode ,days) ]))
- vc-annotate-menu-elements))
- ["Span ..."
- (vc-annotate-display-select
- nil (float (string-to-number (read-string "Span how many days? "))))]
- "--"
- ["Span to Oldest"
- (unless (eq vc-annotate-display-mode 'scale)
- (vc-annotate-display-select nil 'scale))
- :help
- "Use an autoscaled color map from the oldest annotation to the current time"
- :style toggle :selected
- (eq vc-annotate-display-mode 'scale)]
- ["Span Oldest->Newest"
- (unless (eq vc-annotate-display-mode 'fullscale)
- (vc-annotate-display-select nil 'fullscale))
- :help
- "Use an autoscaled color map from the oldest to the newest annotation"
- :style toggle :selected
- (eq vc-annotate-display-mode 'fullscale)]
- "--"
- ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility
- :help
- "Toggle whether the annotation is visible or not"]
- ["Annotate previous revision" vc-annotate-prev-revision
- :help "Visit the annotation of the revision previous to this one"]
- ["Annotate next revision" vc-annotate-next-revision
- :help "Visit the annotation of the revision after this one"]
- ["Annotate revision at line" vc-annotate-revision-at-line
- :help
- "Visit the annotation of the revision identified in the current line"]
- ["Annotate revision previous to line" vc-annotate-revision-previous-to-line
- :help "Visit the annotation of the revision before the revision at line"]
- ["Annotate latest revision" vc-annotate-working-revision
- :help "Visit the annotation of the working revision of this file"]
- ["Show log of revision at line" vc-annotate-show-log-revision-at-line
- :help "Visit the log of the revision at line"]
- ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line
- :help "Visit the diff of the revision at line from its previous revision"]
- ["Show changeset diff of revision at line"
- vc-annotate-show-changeset-diff-revision-at-line
- :enable
- (eq 'repository (vc-call-backend ,vc-annotate-backend 'revision-granularity))
- :help "Visit the diff of the revision at line from its previous revision"]
- ["Visit revision at line" vc-annotate-find-revision-at-line
- :help "Visit the revision identified in the current line"]))
-
-(defun vc-annotate-display-select (&optional buffer mode)
- "Highlight the output of \\[vc-annotate].
-By default, the current buffer is highlighted, unless overridden by
-BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
-use; you may override this using the second optional arg MODE."
- (interactive)
- (when mode (setq vc-annotate-display-mode mode))
- (pop-to-buffer (or buffer (current-buffer)))
- (cond ((null vc-annotate-display-mode)
- ;; The ratio is global, thus relative to the global color-map.
- (kill-local-variable 'vc-annotate-color-map)
- (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
- ;; One of the auto-scaling modes
- ((eq vc-annotate-display-mode 'scale)
- (vc-exec-after `(vc-annotate-display-autoscale)))
- ((eq vc-annotate-display-mode 'fullscale)
- (vc-exec-after `(vc-annotate-display-autoscale t)))
- ((numberp vc-annotate-display-mode) ; A fixed number of days lookback
- (vc-annotate-display-default
- (/ vc-annotate-display-mode
- (vc-annotate-oldest-in-map vc-annotate-color-map))))
- (t (error "No such display mode: %s"
- vc-annotate-display-mode))))
-
-;;;###autoload
-(defun vc-annotate (file rev &optional display-mode buf move-point-to)
- "Display the edit history of the current file using colors.
-
-This command creates a buffer that shows, for each line of the current
-file, when it was last edited and by whom. Additionally, colors are
-used to show the age of each line--blue means oldest, red means
-youngest, and intermediate colors indicate intermediate ages. By
-default, the time scale stretches back one year into the past;
-everything that is older than that is shown in blue.
-
-With a prefix argument, this command asks two questions in the
-minibuffer. First, you may enter a revision number; then the buffer
-displays and annotates that revision instead of the working revision
-\(type RET in the minibuffer to leave that default unchanged). Then,
-you are prompted for the time span in days which the color range
-should cover. For example, a time span of 20 days means that changes
-over the past 20 days are shown in red to blue, according to their
-age, and everything that is older than that is shown in blue.
-
-If MOVE-POINT-TO is given, move the point to that line.
-
-Customization variables:
-
-`vc-annotate-menu-elements' customizes the menu elements of the
-mode-specific menu. `vc-annotate-color-map' and
-`vc-annotate-very-old-color' define the mapping of time to colors.
-`vc-annotate-background' specifies the background color."
- (interactive
- (save-current-buffer
- (vc-ensure-vc-buffer)
- (list buffer-file-name
- (let ((def (vc-working-revision buffer-file-name)))
- (if (null current-prefix-arg) def
- (read-string
- (format "Annotate from revision (default %s): " def)
- nil nil def)))
- (if (null current-prefix-arg)
- vc-annotate-display-mode
- (float (string-to-number
- (read-string "Annotate span days (default 20): "
- nil nil "20")))))))
- (vc-ensure-vc-buffer)
- (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
- (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
- (temp-buffer-show-function 'vc-annotate-display-select)
- ;; If BUF is specified, we presume the caller maintains current line,
- ;; so we don't need to do it here. This implementation may give
- ;; strange results occasionally in the case of REV != WORKFILE-REV.
- (current-line (or move-point-to (unless buf (line-number-at-pos)))))
- (message "Annotating...")
- ;; If BUF is specified it tells in which buffer we should put the
- ;; annotations. This is used when switching annotations to another
- ;; revision, so we should update the buffer's name.
- (when buf (with-current-buffer buf
- (rename-buffer temp-buffer-name t)
- ;; In case it had to be uniquified.
- (setq temp-buffer-name (buffer-name))))
- (with-output-to-temp-buffer temp-buffer-name
- (let ((backend (vc-backend file)))
- (vc-call-backend backend 'annotate-command file
- (get-buffer temp-buffer-name) rev)
- ;; we must setup the mode first, and then set our local
- ;; variables before the show-function is called at the exit of
- ;; with-output-to-temp-buffer
- (with-current-buffer temp-buffer-name
- (unless (equal major-mode 'vc-annotate-mode)
- (vc-annotate-mode))
- (set (make-local-variable 'vc-annotate-backend) backend)
- (set (make-local-variable 'vc-annotate-parent-file) file)
- (set (make-local-variable 'vc-annotate-parent-rev) rev)
- (set (make-local-variable 'vc-annotate-parent-display-mode)
- display-mode))))
-
- (with-current-buffer temp-buffer-name
- (vc-exec-after
- `(progn
- ;; Ideally, we'd rather not move point if the user has already
- ;; moved it elsewhere, but really point here is not the position
- ;; of the user's cursor :-(
- (when ,current-line ;(and (bobp))
- (goto-line ,current-line)
- (setq vc-sentinel-movepoint (point)))
- (unless (active-minibuffer-window)
- (message "Annotating... done")))))))
-
-(defun vc-annotate-prev-revision (prefix)
- "Visit the annotation of the revision previous to this one.
-
-With a numeric prefix argument, annotate the revision that many
-revisions previous."
- (interactive "p")
- (vc-annotate-warp-revision (- 0 prefix)))
-
-(defun vc-annotate-next-revision (prefix)
- "Visit the annotation of the revision after this one.
-
-With a numeric prefix argument, annotate the revision that many
-revisions after."
- (interactive "p")
- (vc-annotate-warp-revision prefix))
-
-(defun vc-annotate-working-revision ()
- "Visit the annotation of the working revision of this file."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
- (if (equal warp-rev vc-annotate-parent-rev)
- (message "Already at revision %s" warp-rev)
- (vc-annotate-warp-revision warp-rev)))))
-
-(defun vc-annotate-extract-revision-at-line ()
- "Extract the revision number of the current line."
- ;; This function must be invoked from a buffer in vc-annotate-mode
- (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
-
-(defun vc-annotate-revision-at-line ()
- "Visit the annotation of the revision identified in the current line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (if (equal rev-at-line vc-annotate-parent-rev)
- (message "Already at revision %s" rev-at-line)
- (vc-annotate-warp-revision rev-at-line))))))
-
-(defun vc-annotate-find-revision-at-line ()
- "Visit the revision identified in the current line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (vc-revision-other-window rev-at-line)))))
-
-(defun vc-annotate-revision-previous-to-line ()
- "Visit the annotation of the revision before the revision at line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (setq prev-rev
- (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file rev-at-line))
- (vc-annotate-warp-revision prev-rev)))))
-
-(defun vc-annotate-show-log-revision-at-line ()
- "Visit the log of the revision at line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (vc-print-log rev-at-line)))))
-
-(defun vc-annotate-show-diff-revision-at-line-internal (fileset)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (setq prev-rev
- (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file rev-at-line))
- (if (not prev-rev)
- (message "Cannot diff from any revision prior to %s" rev-at-line)
- (save-window-excursion
- (vc-diff-internal
- nil
- ;; The value passed here should follow what
- ;; `vc-deduce-fileset' returns.
- (cons vc-annotate-backend (cons fileset nil))
- prev-rev rev-at-line))
- (switch-to-buffer "*vc-diff*"))))))
-
-(defun vc-annotate-show-diff-revision-at-line ()
- "Visit the diff of the revision at line from its previous revision."
- (interactive)
- (vc-annotate-show-diff-revision-at-line-internal (list vc-annotate-parent-file)))
-
-(defun vc-annotate-show-changeset-diff-revision-at-line ()
- "Visit the diff of the revision at line from its previous revision for all files in the changeset."
- (interactive)
- (when (eq 'file (vc-call-backend vc-annotate-backend 'revision-granularity))
- (error "The %s backend does not support changeset diffs" vc-annotate-backend))
- (vc-annotate-show-diff-revision-at-line-internal nil))
-
-(defun vc-annotate-warp-revision (revspec)
- "Annotate the revision described by REVSPEC.
-
-If REVSPEC is a positive integer, warp that many revisions
-forward, if possible, otherwise echo a warning message. If
-REVSPEC is a negative integer, warp that many revisions backward,
-if possible, otherwise echo a warning message. If REVSPEC is a
-string, then it describes a revision number, so warp to that
-revision."
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let* ((buf (current-buffer))
- (oldline (line-number-at-pos))
- (revspeccopy revspec)
- (newrev nil))
- (cond
- ((and (integerp revspec) (> revspec 0))
- (setq newrev vc-annotate-parent-rev)
- (while (and (> revspec 0) newrev)
- (setq newrev (vc-call-backend vc-annotate-backend 'next-revision
- vc-annotate-parent-file newrev))
- (setq revspec (1- revspec)))
- (unless newrev
- (message "Cannot increment %d revisions from revision %s"
- revspeccopy vc-annotate-parent-rev)))
- ((and (integerp revspec) (< revspec 0))
- (setq newrev vc-annotate-parent-rev)
- (while (and (< revspec 0) newrev)
- (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file newrev))
- (setq revspec (1+ revspec)))
- (unless newrev
- (message "Cannot decrement %d revisions from revision %s"
- (- 0 revspeccopy) vc-annotate-parent-rev)))
- ((stringp revspec) (setq newrev revspec))
- (t (error "Invalid argument to vc-annotate-warp-revision")))
- (when newrev
- (vc-annotate vc-annotate-parent-file newrev
- vc-annotate-parent-display-mode
- buf
- ;; Pass the current line so that vc-annotate will
- ;; place the point in the line.
- (min oldline (progn (goto-char (point-max))
- (forward-line -1)
- (line-number-at-pos))))))))
-
-(defun vc-annotate-compcar (threshold a-list)
- "Test successive cons cells of A-LIST against THRESHOLD.
-Return the first cons cell with a car that is not less than THRESHOLD,
-nil if no such cell exists."
- (let ((i 1)
- (tmp-cons (car a-list)))
- (while (and tmp-cons (< (car tmp-cons) threshold))
- (setq tmp-cons (car (nthcdr i a-list)))
- (setq i (+ i 1)))
- tmp-cons)) ; Return the appropriate value
-
-(defun vc-annotate-convert-time (time)
- "Convert a time value to a floating-point number of days.
-The argument TIME is a list as returned by `current-time' or
-`encode-time', only the first two elements of that list are considered."
- (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
-
-(defun vc-annotate-difference (&optional offset)
- "Return the time span in days to the next annotation.
-This calls the backend function annotate-time, and returns the
-difference in days between the time returned and the current time,
-or OFFSET if present."
- (let ((next-time (vc-annotate-get-time-set-line-props)))
- (when next-time
- (- (or offset
- (vc-call-backend vc-annotate-backend 'annotate-current-time))
- next-time))))
-
-(defun vc-default-annotate-current-time (backend)
- "Return the current time, encoded as fractional days."
- (vc-annotate-convert-time (current-time)))
-
-(defvar vc-annotate-offset nil)
-
-(defun vc-annotate-display (ratio &optional offset)
- "Highlight `vc-annotate' output in the current buffer.
-RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
-The annotations are relative to the current time, unless overridden by OFFSET."
- (when (/= ratio 1.0)
- (set (make-local-variable 'vc-annotate-color-map)
- (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
- vc-annotate-color-map)))
- (set (make-local-variable 'vc-annotate-offset) offset)
- (font-lock-mode 1))
-
-(defun vc-annotate-lines (limit)
- (while (< (point) limit)
- (let ((difference (vc-annotate-difference vc-annotate-offset))
- (start (point))
- (end (progn (forward-line 1) (point))))
- (when difference
- (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
- (cons nil vc-annotate-very-old-color)))
- ;; substring from index 1 to remove any leading `#' in the name
- (face-name (concat "vc-annotate-face-"
- (if (string-equal
- (substring (cdr color) 0 1) "#")
- (substring (cdr color) 1)
- (cdr color))))
- ;; Make the face if not done.
- (face (or (intern-soft face-name)
- (let ((tmp-face (make-face (intern face-name))))
- (set-face-foreground tmp-face (cdr color))
- (when vc-annotate-background
- (set-face-background tmp-face
- vc-annotate-background))
- tmp-face)))) ; Return the face
- (put-text-property start end 'face face)))))
- ;; Pretend to font-lock there were no matches.
- nil)
\f
;; These things should probably be generally available
+(defun vc-string-prefix-p (prefix string)
+ (let ((lpref (length prefix)))
+ (and (>= (length string) lpref)
+ (eq t (compare-strings prefix nil nil string nil lpref)))))
+
(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."
HCoop / bpt / emacs.git / blobdiff