comparison lisp/vc.el @ 83428:d0eee3282e6b

Merged from [e-mail]--gnu-2005 (patch 678-680) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-678 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-679 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-680 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-468

83427:2afc49c9f0c0

(defgroup vc nil
  "Version-control system in Emacs."
  :group 'tools)

(defcustom vc-suppress-confirm nil
  "*If non-nil, treat user as expert; suppress yes-no prompts on some things."
  :type 'boolean
  :group 'vc)

(defcustom vc-delete-logbuf-window t
  "*If non-nil, delete the *VC-log* buffer and window after each logical action.
If nil, bury that buffer instead.
This is most useful if you have multiple windows on a frame and would like to
preserve the setting."
  :type 'boolean
  :group 'vc)

(defcustom vc-initial-comment nil
  "*If non-nil, prompt for initial comment when a file is registered."
  :type 'boolean
  :group 'vc)

(defcustom vc-default-init-version "1.1"
  "*A string used as the default version number when a new file is registered.
This can be overridden by giving a prefix argument to \\[vc-register].  This
can also be overridden by a particular VC backend."
  :type 'string
  :group 'vc
  :version "20.3")

(defcustom vc-command-messages nil
  "*If non-nil, display run messages from back-end commands."
  :type 'boolean
  :group 'vc)

(defcustom vc-checkin-switches nil
  "*A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-checkout-switches nil
  "*A string or list of strings specifying extra switches for checkout.
These are passed to the checkout program by \\[vc-checkout]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-register-switches nil
  "*A string or list of strings; extra switches for registering a file.
These are passed to the checkin program by \\[vc-register]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-dired-listing-switches "-al"
  "*Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
  :type 'string
  :group 'vc
  :version "21.1")

(defcustom vc-dired-recurse t
  "*If non-nil, show directory trees recursively in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

(defcustom vc-dired-terse-display t
  "*If non-nil, show only locked files in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}")
  "*List of directory names to be ignored when walking directory trees."
  :type '(repeat string)
  :group 'vc)

(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."

			 string))
  :group 'vc
  :version "21.1")

(defcustom vc-allow-async-revert nil
  "*Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
if the local changes in the file have not been found and displayed yet."
  :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t))
  :group 'vc
  :version "22.1")

;;;###autoload
(defcustom vc-checkout-hook nil
  "*Normal hook (list of functions) run after checking out a file.
See `run-hooks'."
  :type 'hook
  :group 'vc
  :version "21.1")

			 :value "20.5"))
  :group 'vc)

;;;###autoload
(defcustom vc-checkin-hook nil
  "*Normal hook (list of functions) run after a checkin is done.
See also `log-edit-done-hook'."
  :type 'hook
  :options '(log-edit-comment-to-change-log)
  :group 'vc)

;;;###autoload
(defcustom vc-before-checkin-hook nil
  "*Normal hook (list of functions) run before a file is checked in.
See `run-hooks'."
  :type 'hook
  :group 'vc)

(defcustom vc-logentry-check-hook nil
  "*Normal hook run by `vc-backend-logentry-check'.
Use this to impose your own rules on the entry in addition to any the
version control backend imposes itself."
  :type 'hook
  :group 'vc)

    (260. . "#66CC00")
    (280. . "#33CC33")
    (300. . "#00CCFF")
    (320. . "#00CC99")
    (340. . "#0099FF"))
  "*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."
  :type 'alist
  :group 'vc)

(defcustom vc-annotate-very-old-color "#0046FF"
  "*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 'string
  :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 [menu-bar] (make-sparse-keymap "VC-Annotate"))
    m)
  "Local keymap used for VC-Annotate mode.")

(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)
(define-key vc-annotate-mode-map "W" 'vc-annotate-workfile-version)

(defvar vc-annotate-mode-menu nil
  "Local keymap used for VC-Annotate mode's menu bar menu.")

;; 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.
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"


;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
(defvar vc-log-after-operation-hook nil)
(defvar vc-annotate-buffers nil
  "Alist of current \"Annotate\" buffers and their corresponding backends.
The keys are \(BUFFER . BACKEND\).  See also `vc-annotate-get-backend'.")
;; In a log entry buffer, this is a local variable
;; that points to the buffer for which it was made
;; (either a file, or a VC dired buffer).
(defvar vc-parent-buffer nil)
(put 'vc-parent-buffer 'permanent-local t)

        (vc-next-action-on-file buffer-file-name verbose)
      (error "Buffer %s is not associated with a file" (buffer-name)))))

;; These functions help the vc-next-action entry point

;;;###autoload
(defun vc-register (&optional set-version comment)
  "Register the current file into a version control system.
With prefix argument SET-VERSION, allow user to specify initial version
level.  If COMMENT is present, use that as an initial comment.

  (vc-start-entry buffer-file-name
                  (if set-version
                      (read-string (format "Initial version level for %s: "
					   (buffer-name)))
		    (let ((backend (vc-responsible-backend buffer-file-name)))
		      (if (vc-find-backend-function backend 'init-version)
			  (vc-call-backend backend 'init-version)
			vc-default-init-version)))
                  (or comment (not vc-initial-comment))
		  nil
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)

  (save-excursion
    (save-restriction
      (widen)
      (if (or (not (vc-check-headers))
	      (y-or-n-p "Version headers already exist.  Insert another set? "))
	  (progn
	    (let* ((delims (cdr (assq major-mode vc-comment-alist)))
		   (comment-start-vc (or (car delims) comment-start "#"))
		   (comment-end-vc (or (car (cdr delims)) comment-end ""))
		   (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
					       'header))
		   (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
	      (mapcar (lambda (s)
			(insert comment-start-vc "\t" s "\t"
				comment-end-vc "\n"))
		      hdstrings)
	      (if vc-static-header-alist
		  (mapcar (lambda (f)
			    (if (string-match (car f) buffer-file-name)
				(insert (format (cdr f) (car hdstrings)))))
			  vc-static-header-alist))
	      )
	    )))))

(defun vc-clear-headers (&optional file)
  "Clear all version headers in the current buffer (or FILE).
The headers are reset to their non-expanded form."
  (let* ((filename (or file buffer-file-name))

                                        (if (file-name-absolute-p f)
                                            f
                                          (concat odefault f))))
                                     files)))
                       "done"
		     (pop-to-buffer
		      (set-buffer (get-buffer-create "*vc*")))
		     (erase-buffer)
		     (insert-file-contents tempfile)
		     "failed"))
	       (setq default-directory (file-name-directory changelog))
	       (delete-file tempfile)))))

;; 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.")
(defvar vc-annotate-backend nil "Global variable.")

;; internal buffer-local variables
(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)))

(defun vc-annotate-get-backend (buffer)
  "Return the backend matching \"Annotate\" buffer BUFFER.
Return nil if no match made.  Associations are made based on
`vc-annotate-buffers'."
  (cdr (assoc buffer vc-annotate-buffers)))

(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."
  (set (make-local-variable 'truncate-lines) t)
  (set (make-local-variable 'font-lock-defaults)
       '(vc-annotate-font-lock-keywords t))
  (view-mode 1)
  (vc-annotate-add-menu))

(defun vc-annotate-display-default (&optional 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
if present.  The current time is used as the offset."
  (interactive "e")
  (message "Redisplaying annotation...")
  (vc-annotate-display
   (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
  (message "Redisplaying annotation...done"))

(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

			 (- current oldest)
			 (- current newest))
	       (format "Spanned to %.1f days old" (- current oldest))))))

;; Menu -- Using easymenu.el
(defun vc-annotate-add-menu ()
  "Add the menu 'Annotate' to the menu bar in VC-Annotate mode."
  (let ((menu-elements vc-annotate-menu-elements)
	(menu-def
	 '("VC-Annotate"
	   ["Default" (unless (null vc-annotate-display-mode)
			(setq vc-annotate-display-mode nil)
			(vc-annotate-display-select))
	    :style toggle :selected (null vc-annotate-display-mode)]))
	(oldest-in-map (vc-annotate-car-last-cons vc-annotate-color-map)))
    (while menu-elements
      (let* ((element (car menu-elements))
	     (days (* element oldest-in-map)))
	(setq menu-elements (cdr menu-elements))
	(setq menu-def
	      (append menu-def
		      `([,(format "Span %.1f days" days)
			 (unless (and (numberp vc-annotate-display-mode)
				      (= vc-annotate-display-mode ,days))
			   (vc-annotate-display-select nil ,days))
			 :style toggle :selected
			 (and (numberp vc-annotate-display-mode)
			      (= vc-annotate-display-mode ,days)) ])))))
    (setq menu-def
	  (append menu-def
		  (list
		   ["Span ..."
		    (let ((days
			   (float (string-to-number
				   (read-string "Span how many days? ")))))
		      (vc-annotate-display-select nil days)) t])
		  (list "--")
		  (list
		   ["Span to Oldest"
		    (unless (eq vc-annotate-display-mode 'scale)
		      (vc-annotate-display-select nil 'scale))
		    :style toggle :selected
		    (eq vc-annotate-display-mode 'scale)])
		  (list
		   ["Span Oldest->Newest"
		    (unless (eq vc-annotate-display-mode 'fullscale)
		      (vc-annotate-display-select nil 'fullscale))
		    :style toggle :selected
		    (eq vc-annotate-display-mode 'fullscale)])
		  (list "--")
		  (list ["Annotate previous revision"
			 (call-interactively 'vc-annotate-prev-version)])
		  (list ["Annotate next revision"
			 (call-interactively 'vc-annotate-next-version)])
		  (list ["Annotate revision at line"
			 (vc-annotate-revision-at-line)])
		  (list ["Annotate revision previous to line"
			 (vc-annotate-revision-previous-to-line)])
		  (list ["Annotate latest revision"
			 (vc-annotate-workfile-version)])
		  (list ["Show log of revision at line"
			 (vc-annotate-show-log-revision-at-line)])
		  (list ["Show diff of revision at line"
			 (vc-annotate-show-diff-revision-at-line)])))

    ;; Define the menu
    (if (or (featurep 'easymenu) (load "easymenu" t))
	(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
			  "VC Annotate Display Menu" menu-def))))

(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

;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
;;;;  Execute "annotate" on FILE by using `call-process' and insert
;;;;  the contents in BUFFER.

;;;###autoload
(defun vc-annotate (prefix &optional revision display-mode)
  "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

`vc-annotate-menu-elements' customizes the menu elements of the
mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-very-old-color' defines the mapping of time to
colors. `vc-annotate-background' specifies the background color."
  (interactive "P")
  (vc-ensure-vc-buffer)
  (let* ((temp-buffer-name nil)
         (temp-buffer-show-function 'vc-annotate-display-select)
	 (rev (or revision (vc-workfile-version buffer-file-name)))
	 (bfn buffer-file-name)
         (vc-annotate-version
	  (if prefix (read-string
		      (format "Annotate from version (default %s): " rev)
		      nil nil rev)
	    rev)))
    (if display-mode
	(setq vc-annotate-display-mode display-mode)
      (if prefix
	  (setq vc-annotate-display-mode
		(float (string-to-number
			(read-string "Annotate span days (default 20): "
				     nil nil "20"))))))
    (setq temp-buffer-name (format "*Annotate %s (rev %s)*"
				   (buffer-name) vc-annotate-version))
    (setq vc-annotate-backend (vc-backend buffer-file-name))
    (message "Annotating...")
    (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
	(error "Sorry, annotating is not implemented for %s"
	       vc-annotate-backend))
    (with-output-to-temp-buffer temp-buffer-name
      (vc-call-backend vc-annotate-backend 'annotate-command
		       buffer-file-name
		       (get-buffer temp-buffer-name)
                       vc-annotate-version))
    (save-excursion
      (set-buffer temp-buffer-name)
      (set (make-local-variable 'vc-annotate-parent-file) bfn)
      (set (make-local-variable 'vc-annotate-parent-rev) vc-annotate-version)
      (set (make-local-variable 'vc-annotate-parent-display-mode)
	   vc-annotate-display-mode))

    ;; Don't use the temp-buffer-name until the buffer is created
    ;; (only after `with-output-to-temp-buffer'.)
    (setq vc-annotate-buffers
	  (append vc-annotate-buffers
		  (list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))
  (message "Annotating... done")))

(defun vc-annotate-prev-version (prefix)
  "Visit the annotation of the version previous to this one.

	    (message "Cannot decrement %d versions from version %s"
		     (- 0 revspeccopy) vc-annotate-parent-rev)))
       ((stringp revspec) (setq newrev revspec))
       (t (error "Invalid argument to vc-annotate-warp-version")))
      (when newrev
	(save-window-excursion
	  (find-file vc-annotate-parent-file)
	  (vc-annotate nil newrev vc-annotate-parent-display-mode))
	(kill-buffer (current-buffer)) ;; kill the buffer we started from
	(switch-to-buffer (car (car (last vc-annotate-buffers))))
	(goto-line (min oldline (progn (goto-char (point-max))
				       (previous-line)
				       (line-number-at-pos))))))))

(defun vc-annotate-car-last-cons (a-list)
  "Return car of last cons in association list A-LIST."
  (if (not (eq nil (cdr a-list)))
      (vc-annotate-car-last-cons (cdr a-list))
    (car (car a-list))))

(defun vc-annotate-time-span (a-list span &optional quantize)
  "Apply factor SPAN to the time-span of association list A-LIST.
Return the new alist.
Optionally quantize to the factor of QUANTIZE."

83428:d0eee3282e6b

(defgroup vc nil
  "Version-control system in Emacs."
  :group 'tools)

(defcustom vc-suppress-confirm nil
  "If non-nil, treat user as expert; suppress yes-no prompts on some things."
  :type 'boolean
  :group 'vc)

(defcustom vc-delete-logbuf-window t
  "If non-nil, delete the *VC-log* buffer and window after each logical action.
If nil, bury that buffer instead.
This is most useful if you have multiple windows on a frame and would like to
preserve the setting."
  :type 'boolean
  :group 'vc)

(defcustom vc-initial-comment nil
  "If non-nil, prompt for initial comment when a file is registered."
  :type 'boolean
  :group 'vc)

(defcustom vc-default-init-version "1.1"
  "A string used as the default version number when a new file is registered.
This can be overridden by giving a prefix argument to \\[vc-register].  This
can also be overridden by a particular VC backend."
  :type 'string
  :group 'vc
  :version "20.3")

(defcustom vc-command-messages nil
  "If non-nil, display run messages from back-end commands."
  :type 'boolean
  :group 'vc)

(defcustom vc-checkin-switches nil
  "A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-checkout-switches nil
  "A string or list of strings specifying extra switches for checkout.
These are passed to the checkout program by \\[vc-checkout]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-register-switches nil
  "A string or list of strings; extra switches for registering a file.
These are passed to the checkin program by \\[vc-register]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-dired-listing-switches "-al"
  "Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
  :type 'string
  :group 'vc
  :version "21.1")

(defcustom vc-dired-recurse t
  "If non-nil, show directory trees recursively in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

(defcustom vc-dired-terse-display t
  "If non-nil, show only locked files in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}")
  "List of directory names to be ignored when walking directory trees."
  :type '(repeat string)
  :group 'vc)

(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."

			 string))
  :group 'vc
  :version "21.1")

(defcustom vc-allow-async-revert nil
  "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
if the local changes in the file have not been found and displayed yet."
  :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t))
  :group 'vc
  :version "22.1")

;;;###autoload
(defcustom vc-checkout-hook nil
  "Normal hook (list of functions) run after checking out a file.
See `run-hooks'."
  :type 'hook
  :group 'vc
  :version "21.1")

			 :value "20.5"))
  :group 'vc)

;;;###autoload
(defcustom vc-checkin-hook nil
  "Normal hook (list of functions) run after a checkin is done.
See also `log-edit-done-hook'."
  :type 'hook
  :options '(log-edit-comment-to-change-log)
  :group 'vc)

;;;###autoload
(defcustom vc-before-checkin-hook nil
  "Normal hook (list of functions) run before a file is checked in.
See `run-hooks'."
  :type 'hook
  :group 'vc)

(defcustom vc-logentry-check-hook nil
  "Normal hook run by `vc-backend-logentry-check'.
Use this to impose your own rules on the entry in addition to any the
version control backend imposes itself."
  :type 'hook
  :group 'vc)

    (260. . "#66CC00")
    (280. . "#33CC33")
    (300. . "#00CCFF")
    (320. . "#00CC99")
    (340. . "#0099FF"))
  "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."
  :type 'alist
  :group 'vc)

(defcustom vc-annotate-very-old-color "#0046FF"
  "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 'string
  :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 [menu-bar] (make-sparse-keymap "VC-Annotate"))
    (define-key m "A" 'vc-annotate-revision-previous-to-line)
    (define-key m "D" 'vc-annotate-show-diff-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-version)
    (define-key m "P" 'vc-annotate-prev-version)
    (define-key m "W" 'vc-annotate-workfile-version)
    m)
  "Local keymap used for VC-Annotate mode.")

(defvar vc-annotate-mode-menu nil
  "Local keymap used for VC-Annotate mode's menu bar menu.")

;; 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.
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"


;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
(defvar vc-log-after-operation-hook nil)

;; In a log entry buffer, this is a local variable
;; that points to the buffer for which it was made
;; (either a file, or a VC dired buffer).
(defvar vc-parent-buffer nil)
(put 'vc-parent-buffer 'permanent-local t)

        (vc-next-action-on-file buffer-file-name verbose)
      (error "Buffer %s is not associated with a file" (buffer-name)))))

;; These functions help the vc-next-action entry point

(defun vc-default-init-version (backend) vc-default-init-version)

;;;###autoload
(defun vc-register (&optional set-version comment)
  "Register the current file into a version control system.
With prefix argument SET-VERSION, allow user to specify initial version
level.  If COMMENT is present, use that as an initial comment.

  (vc-start-entry buffer-file-name
                  (if set-version
                      (read-string (format "Initial version level for %s: "
					   (buffer-name)))
		    (vc-call-backend (vc-responsible-backend buffer-file-name)
				     'init-version))
                  (or comment (not vc-initial-comment))
		  nil
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)

  (save-excursion
    (save-restriction
      (widen)
      (if (or (not (vc-check-headers))
	      (y-or-n-p "Version headers already exist.  Insert another set? "))
          (let* ((delims (cdr (assq major-mode vc-comment-alist)))
                 (comment-start-vc (or (car delims) comment-start "#"))
                 (comment-end-vc (or (car (cdr delims)) comment-end ""))
                 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
                                             'header))
                 (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
            (dolist (s hdstrings)
              (insert comment-start-vc "\t" s "\t"
                      comment-end-vc "\n"))
            (if vc-static-header-alist
                (dolist (f vc-static-header-alist)
                  (if (string-match (car f) buffer-file-name)
                      (insert (format (cdr f) (car hdstrings)))))))))))

(defun vc-clear-headers (&optional file)
  "Clear all version headers in the current buffer (or FILE).
The headers are reset to their non-expanded form."
  (let* ((filename (or file buffer-file-name))

                                        (if (file-name-absolute-p f)
                                            f
                                          (concat odefault f))))
                                     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)))))

;; 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."
  (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-display-default (&optional 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
if present.  The current time is used as the offset."
  (interactive "e")
  (message "Redisplaying annotation...")
  (vc-annotate-display
   (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
  (message "Redisplaying annotation...done"))

(defun vc-annotate-car-last-cons (a-list)
  "Return car of last cons in association list A-LIST."
  (caar (last a-list)))

(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

			 (- 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"
    ["Default" (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-car-last-cons vc-annotate-color-map)))
        (mapcar (lambda (element)
                  (let ((days (* element oldest-in-map)))
                    `([,(format "Span %.1f days" days)
                       (unless (and (numberp vc-annotate-display-mode)
                                    (= vc-annotate-display-mode ,days))
                         (vc-annotate-display-select nil ,days))
                       :style toggle :selected
                       (and (numberp vc-annotate-display-mode)
                            (= vc-annotate-display-mode ,days)) ])))
                vc-annotate-menu-elements))
    ["Span ..."
     (let ((days
            (float (string-to-number
                    (read-string "Span how many days? ")))))
       (vc-annotate-display-select nil days)) t]
    "--"
    ["Span to Oldest"
     (unless (eq vc-annotate-display-mode 'scale)
       (vc-annotate-display-select nil 'scale))
     :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))
     :style toggle :selected
     (eq vc-annotate-display-mode 'fullscale)]
    "--"
    ["Annotate previous revision" vc-annotate-prev-version]
    ["Annotate next revision" vc-annotate-next-version]
    ["Annotate revision at line" vc-annotate-revision-at-line]
    ["Annotate revision previous to line" vc-annotate-revision-previous-to-line]
    ["Annotate latest revision" vc-annotate-workfile-version]
    ["Show log of revision at line" vc-annotate-show-log-revision-at-line]
    ["Show diff of revision at line" vc-annotate-show-diff-revision-at-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

;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
;;;;  Execute "annotate" on FILE by using `call-process' and insert
;;;;  the contents in BUFFER.

;;;###autoload
(defun vc-annotate (file rev &optional display-mode buf)
  "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

`vc-annotate-menu-elements' customizes the menu elements of the
mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-very-old-color' defines 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-workfile-version buffer-file-name)))
	     (if (null current-prefix-arg) def
	       (read-string
		(format "Annotate from version (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))
    (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.
    (if buf (with-current-buffer buf
	      (rename-buffer temp-buffer-name t)
	      ;; In case it had to be uniquified.
	      (setq temp-buffer-name (buffer-name))))
    (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
	(error "Sorry, annotating is not implemented for %s"
	       vc-annotate-backend))
    (with-output-to-temp-buffer temp-buffer-name
      (vc-call annotate-command file (get-buffer temp-buffer-name) rev))
    (with-current-buffer temp-buffer-name
      (set (make-local-variable 'vc-annotate-backend) (vc-backend file))
      (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))

  (message "Annotating... done")))

(defun vc-annotate-prev-version (prefix)
  "Visit the annotation of the version previous to this one.

	    (message "Cannot decrement %d versions from version %s"
		     (- 0 revspeccopy) vc-annotate-parent-rev)))
       ((stringp revspec) (setq newrev revspec))
       (t (error "Invalid argument to vc-annotate-warp-version")))
      (when newrev
	(vc-annotate vc-annotate-parent-file newrev
                     vc-annotate-parent-display-mode
                     (current-buffer))
	(goto-line (min oldline (progn (goto-char (point-max))
				       (previous-line)
				       (line-number-at-pos))))))))

(defun vc-annotate-time-span (a-list span &optional quantize)
  "Apply factor SPAN to the time-span of association list A-LIST.
Return the new alist.
Optionally quantize to the factor of QUANTIZE."