;;; 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 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
:group 'vc
:version "21.1")
-(defcustom vc-annotate-display-mode nil
+(defcustom vc-annotate-display-mode 'fullscale
"Which mode to color the output of \\[vc-annotate] with by default."
- :type '(choice (const :tag "Default" nil)
+ :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"
;; Annotate customization
(defcustom vc-annotate-color-map
- '(( 20. . "#FFCC00")
- ( 40. . "#FF6666")
- ( 60. . "#FF6600")
- ( 80. . "#FF3300")
- (100. . "#FF00FF")
- (120. . "#FF0000")
- (140. . "#CCCC00")
- (160. . "#CC00CC")
- (180. . "#BC8F8F")
- (200. . "#99CC00")
- (220. . "#999900")
- (240. . "#7AC5CD")
- (260. . "#66CC00")
- (280. . "#33CC33")
- (300. . "#00CCFF")
- (320. . "#00CC99")
- (340. . "#0099FF"))
+ (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."
+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 "#0046FF"
+(defcustom vc-annotate-very-old-color "#3F3FFF"
"Color for lines older than the current color range in \\[vc-annotate]]."
:type 'string
: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)
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
(if vc-dired-mode
(set-buffer (find-file-noselect (dired-get-filename)))
(while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
+ (set-buffer vc-parent-buffer))
(if (not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name))
(if (not (vc-backend buffer-file-name))
(let ((state (vc-state file)))
(cond
((stringp state) (concat "(" state ")"))
- ((eq state 'edited) (concat "(" (vc-user-login-name) ")"))
+ ((eq state 'edited) (concat "(" (vc-user-login-name file) ")"))
((eq state 'needs-merge) "(merge)")
((eq state 'needs-patch) "(patch)")
((eq state 'unlocked-changes) "(stale)"))))
(vc-mode-line new)
(set-buffer-modified-p nil)))))
-;; Only defined in very recent Emacsen
-(defvar small-temporary-file-directory nil)
-
;;;###autoload
(defun vc-update-change-log (&rest args)
"Find change log file and add entries from recent version control logs.
(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)
exec-directory)
nil (list t tempfile) nil
"-c" changelog
- "-u" (concat (vc-user-login-name)
+ "-u" (concat login-name
"\t" full-name
"\t" mailing-address)
(mapcar
'(vc-annotate-font-lock-keywords t))
(view-mode 1))
-(defun vc-annotate-display-default (&optional ratio)
+(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
-if present. The current time is used as the offset."
- (interactive "e")
+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
- (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
+ (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-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
(if (< date oldest)
(setq oldest date))))
(vc-annotate-display
- (vc-annotate-time-span ;return the scaled colormap.
- vc-annotate-color-map
- (/ (- (if full newest current) oldest)
- (vc-annotate-car-last-cons vc-annotate-color-map)))
+ (/ (- (if full newest current) oldest)
+ (vc-annotate-oldest-in-map vc-annotate-color-map))
(if full newest))
(message "Redisplaying annotation...done \(%s\)"
(if full
(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
"VC Annotate Display Menu"
`("VC-Annotate"
- ["Default" (unless (null vc-annotate-display-mode)
+ ["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-car-last-cons vc-annotate-color-map)))
+ ,@(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)
- (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)) ])))
+ `[,(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 ..."
- (let ((days
- (float (string-to-number
- (read-string "Span how many days? ")))))
- (vc-annotate-display-select nil days)) t]
+ (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)
use; you may override this using the second optional arg MODE."
(interactive)
(if mode (setq vc-annotate-display-mode mode))
- (when buffer
- (set-buffer buffer)
- (display-buffer buffer))
- (if (not vc-annotate-parent-rev)
- (vc-annotate-mode))
+ (pop-to-buffer (or buffer (current-buffer)))
(cond ((null vc-annotate-display-mode)
- (vc-annotate-display-default vc-annotate-ratio))
- ;; One of the auto-scaling modes
+ ;; 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-annotate-display-autoscale))
((eq vc-annotate-display-mode 'fullscale)
(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-car-last-cons
- vc-annotate-color-map))))
+ (/ vc-annotate-display-mode
+ (vc-annotate-oldest-in-map vc-annotate-color-map))))
(t (error "No such display mode: %s"
vc-annotate-display-mode))))
-;;;; (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.
(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))
+ (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 (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
(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")))
+ (vc-call 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
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (vc-annotate-mode))
+ (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)))
+ (when current-line
+ (goto-line current-line temp-buffer-name))
+ (message "Annotating... done")))
(defun vc-annotate-prev-version (prefix)
"Visit the annotation of the version previous to this one.
(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
- (save-window-excursion
- (vc-ensure-vc-buffer)
- (setq vc-annotate-backend (vc-backend buffer-file-name)))
(vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
(defun vc-annotate-revision-at-line ()
revision."
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
- (let* ((oldline (line-number-at-pos))
+ (let* ((buf (current-buffer))
+ (oldline (line-number-at-pos))
(revspeccopy revspec)
(newrev nil))
(cond
(when newrev
(vc-annotate vc-annotate-parent-file newrev
vc-annotate-parent-display-mode
- (current-buffer))
+ buf)
(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."
- (caar (last 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."
- ;; Apply span to each car of every cons
- (if (not (eq nil a-list))
- (append (list (cons (* (car (car a-list)) span)
- (cdr (car a-list))))
- (vc-annotate-time-span (nthcdr (or quantize ; optional
- 1) ; Default to cdr
- a-list) span quantize))))
+ (line-number-at-pos))) buf)))))
(defun vc-annotate-compcar (threshold a-list)
"Test successive cons cells of A-LIST against THRESHOLD.
(defvar vc-annotate-offset nil)
-(defun vc-annotate-display (&optional color-map offset)
+(defun vc-annotate-display (ratio &optional offset)
"Highlight `vc-annotate' output in the current buffer.
-COLOR-MAP, if present, overrides `vc-annotate-color-map'.
+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."
- (if (and color-map (not (eq color-map vc-annotate-color-map)))
- (set (make-local-variable 'vc-annotate-color-map) color-map))
+ (if (/= 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))
(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-" (substring (cdr color) 1)))
+ (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))))