-;;; vc-annotate.el --- VC Annotate Support
+;;; vc-annotate.el --- VC Annotate Support -*- lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Martin Lorentzson <emwson@emw.ericsson.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; Package: vc
(require 'vc)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defcustom vc-annotate-display-mode 'fullscale
"Which mode to color the output of \\[vc-annotate] with by default."
:value "20.5"))
:group 'vc)
+(defcustom vc-annotate-background-mode
+ (not (or (eq (or frame-background-mode
+ (frame-parameter nil 'background-mode))
+ 'dark)
+ (and (tty-display-color-p) (<= (display-color-cells) 8))))
+ "Non-nil means `vc-annotate-color-map' is applied to the background.
+
+When non-nil, the color range from `vc-annotate-color-map' is applied
+to the background, while the foreground remains default.
+
+When nil, the color range from `vc-annotate-color-map' is applied
+to the foreground, and the color from the option `vc-annotate-background'
+is applied to the background."
+ :type 'boolean
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when (boundp 'vc-annotate-color-map)
+ (with-demoted-errors
+ ;; Update the value of the dependent variable.
+ (custom-reevaluate-setting 'vc-annotate-color-map))))
+ :version "25.1"
+ :group 'vc)
+
(defcustom vc-annotate-color-map
(if (and (tty-display-color-p) (<= (display-color-cells) 8))
;; A custom sorted TTY colormap
(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")))
+ (cond
+ ;; Normal colormap for background colors with dark foreground:
+ ;; hue stepped from 0-240deg, value=1., saturation=0.20
+ (vc-annotate-background-mode
+ '(( 20. . "#FFCCCC")
+ ( 40. . "#FFD8CC")
+ ( 60. . "#FFE4CC")
+ ( 80. . "#FFF0CC")
+ (100. . "#FFFCCC")
+ (120. . "#F6FFCC")
+ (140. . "#EAFFCC")
+ (160. . "#DEFFCC")
+ (180. . "#D2FFCC")
+ (200. . "#CCFFD2")
+ (220. . "#CCFFDE")
+ (240. . "#CCFFEA")
+ (260. . "#CCFFF6")
+ (280. . "#CCFCFF")
+ (300. . "#CCF0FF")
+ (320. . "#CCE4FF")
+ (340. . "#CCD8FF")
+ (360. . "#CCCCFF")))
+ ;; Normal colormap for foreground colors on dark background:
+ ;; hue stepped from 0-240deg, value=1., saturation=0.75
+ (t
+ '(( 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
:type 'alist
:group 'vc)
-(defcustom vc-annotate-very-old-color "#3F3FFF"
+(defcustom vc-annotate-very-old-color (if vc-annotate-background-mode "#CCCCFF" "#3F3FFF")
"Color for lines older than the current color range in \\[vc-annotate]."
:type 'string
:group 'vc)
-(defcustom vc-annotate-background "black"
+(defcustom vc-annotate-background nil
"Background color for \\[vc-annotate].
Default color is used if nil."
:type '(choice (const :tag "Default background" nil) (color))
(let ((bol (point))
(date (vc-call-backend vc-annotate-backend 'annotate-time))
(inhibit-read-only t))
- (assert (>= (point) bol))
+ (cl-assert (>= (point) bol))
(put-text-property bol (point) 'invisible 'vc-annotate-annotation)
date))
(interactive "P")
(let ((newest 0.0)
(oldest 999999.) ;Any CVS users at the founding of Rome?
- (current (vc-annotate-convert-time (current-time)))
+ (current (vc-annotate-convert-time))
date)
(message "Redisplaying annotation...")
;; Run through this file and find the oldest and newest dates annotated.
(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)))
+ (vc-run-delayed (vc-annotate-display-autoscale)))
((eq vc-annotate-display-mode 'fullscale)
- (vc-exec-after `(vc-annotate-display-autoscale t)))
+ (vc-run-delayed (vc-annotate-display-autoscale t)))
((numberp vc-annotate-display-mode) ; A fixed number of days lookback
(vc-annotate-display-default
(/ vc-annotate-display-mode
(t (error "No such display mode: %s"
vc-annotate-display-mode))))
+(defvar vc-sentinel-movepoint)
+
;;;###autoload
(defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk)
"Display the edit history of the current FILE using colors.
`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."
+`vc-annotate-background' specifies the background color.
+`vc-annotate-background-mode' specifies whether the color map
+should be applied to the background or to the foreground."
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
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")))))))
+ (vc-run-delayed
+ ;; 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-char (point-min))
+ (forward-line (1- 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.
(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-convert-time (&optional time)
+ "Convert optional value TIME to a floating-point number of days.
+TIME defaults to the current time."
+ (/ (float-time time) 86400))
(defun vc-annotate-difference (&optional offset)
"Return the time span in days to the next annotation.
(vc-call-backend vc-annotate-backend 'annotate-current-time))
next-time))))
-(defun vc-default-annotate-current-time (backend)
+(defun vc-default-annotate-current-time (_backend)
"Return the current time, encoded as fractional days."
- (vc-annotate-convert-time (current-time)))
+ (vc-annotate-convert-time))
(defvar vc-annotate-offset nil)
;; 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))
+ (cond
+ (vc-annotate-background-mode
+ (set-face-background tmp-face (cdr color)))
+ (t
+ (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.