Mercurial > emacs

comparison lisp/vc.el @ 83509:24cf4bf418dc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-207 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-208 Sync from erc--emacs--0 * emacs@sv.gnu.org/emacs--devo--0--patch-209 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-210 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-211 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-212 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-213 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-214 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-215 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-81 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-82 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-83 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-549
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 12 Apr 2006 17:40:36 +0000
parents b98066f4aa10 7d69833e0c1a
children 2d2f6f096f6e
comparison
equal deleted inserted replaced
83508:cc8354d6fe87 83509:24cf4bf418dc
582 See `run-hooks'." 582 See `run-hooks'."
583 :type 'hook 583 :type 'hook
584 :group 'vc 584 :group 'vc
585 :version "21.1") 585 :version "21.1")
586 586
587 (defcustom vc-annotate-display-mode nil 587 (defcustom vc-annotate-display-mode 'fullscale
588 "Which mode to color the output of \\[vc-annotate] with by default." 588 "Which mode to color the output of \\[vc-annotate] with by default."
589 :type '(choice (const :tag "Default" nil) 589 :type '(choice (const :tag "By Color Map Range" nil)
590 (const :tag "Scale to Oldest" scale) 590 (const :tag "Scale to Oldest" scale)
591 (const :tag "Scale Oldest->Newest" fullscale) 591 (const :tag "Scale Oldest->Newest" fullscale)
592 (number :tag "Specify Fractional Number of Days" 592 (number :tag "Specify Fractional Number of Days"
593 :value "20.5")) 593 :value "20.5"))
594 :group 'vc) 594 :group 'vc)
615 :type 'hook 615 :type 'hook
616 :group 'vc) 616 :group 'vc)
617 617
618 ;; Annotate customization 618 ;; Annotate customization
619 (defcustom vc-annotate-color-map 619 (defcustom vc-annotate-color-map
620 '(( 20. . "#FFCC00") 620 (if (and (tty-display-color-p) (<= (display-color-cells) 8))
621 ( 40. . "#FF6666") 621 ;; A custom sorted TTY colormap
622 ( 60. . "#FF6600") 622 (let* ((colors
623 ( 80. . "#FF3300") 623 (sort
624 (100. . "#FF00FF") 624 (delq nil
625 (120. . "#FF0000") 625 (mapcar (lambda (x)
626 (140. . "#CCCC00") 626 (if (not (or
627 (160. . "#CC00CC") 627 (string-equal (car x) "white")
628 (180. . "#BC8F8F") 628 (string-equal (car x) "black") ))
629 (200. . "#99CC00") 629 (car x)))
630 (220. . "#999900") 630 (tty-color-alist)))
631 (240. . "#7AC5CD") 631 (lambda (a b)
632 (260. . "#66CC00") 632 (cond
633 (280. . "#33CC33") 633 ((or (string-equal a "red") (string-equal b "blue")) t)
634 (300. . "#00CCFF") 634 ((or (string-equal b "red") (string-equal a "blue")) nil)
635 (320. . "#00CC99") 635 ((string-equal a "yellow") t)
636 (340. . "#0099FF")) 636 ((string-equal b "yellow") nil)
637 ((string-equal a "cyan") t)
638 ((string-equal b "cyan") nil)
639 ((string-equal a "green") t)
640 ((string-equal b "green") nil)
641 ((string-equal a "magenta") t)
642 ((string-equal b "magenta") nil)
643 (t (string< a b))))))
644 (date 20.)
645 (delta (/ (- 360. date) (1- (length colors)))))
646 (mapcar (lambda (x)
647 (prog1
648 (cons date x)
649 (setq date (+ date delta)))) colors))
650 ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
651 '(( 20. . "#FF3F3F")
652 ( 40. . "#FF6C3F")
653 ( 60. . "#FF993F")
654 ( 80. . "#FFC63F")
655 (100. . "#FFF33F")
656 (120. . "#DDFF3F")
657 (140. . "#B0FF3F")
658 (160. . "#83FF3F")
659 (180. . "#56FF3F")
660 (200. . "#3FFF56")
661 (220. . "#3FFF83")
662 (240. . "#3FFFB0")
663 (260. . "#3FFFDD")
664 (280. . "#3FF3FF")
665 (300. . "#3FC6FF")
666 (320. . "#3F99FF")
667 (340. . "#3F6CFF")
668 (360. . "#3F3FFF")))
637 "Association list of age versus color, for \\[vc-annotate]. 669 "Association list of age versus color, for \\[vc-annotate].
638 Ages are given in units of fractional days. Default is eighteen steps 670 Ages are given in units of fractional days. Default is eighteen
639 using a twenty day increment." 671 steps using a twenty day increment, from red to blue. For TTY
672 displays with 8 or fewer colors, the default is red to blue with
673 all other colors between (excluding black and white)."
640 :type 'alist 674 :type 'alist
641 :group 'vc) 675 :group 'vc)
642 676
643 (defcustom vc-annotate-very-old-color "#0046FF" 677 (defcustom vc-annotate-very-old-color "#3F3FFF"
644 "Color for lines older than the current color range in \\[vc-annotate]]." 678 "Color for lines older than the current color range in \\[vc-annotate]]."
645 :type 'string 679 :type 'string
646 :group 'vc) 680 :group 'vc)
647 681
648 (defcustom vc-annotate-background "black" 682 (defcustom vc-annotate-background "black"
850 (defun vc-ensure-vc-buffer () 884 (defun vc-ensure-vc-buffer ()
851 "Make sure that the current buffer visits a version-controlled file." 885 "Make sure that the current buffer visits a version-controlled file."
852 (if vc-dired-mode 886 (if vc-dired-mode
853 (set-buffer (find-file-noselect (dired-get-filename))) 887 (set-buffer (find-file-noselect (dired-get-filename)))
854 (while vc-parent-buffer 888 (while vc-parent-buffer
855 (pop-to-buffer vc-parent-buffer)) 889 (set-buffer vc-parent-buffer))
856 (if (not buffer-file-name) 890 (if (not buffer-file-name)
857 (error "Buffer %s is not associated with a file" (buffer-name)) 891 (error "Buffer %s is not associated with a file" (buffer-name))
858 (if (not (vc-backend buffer-file-name)) 892 (if (not (vc-backend buffer-file-name))
859 (error "File %s is not under version control" buffer-file-name))))) 893 (error "File %s is not under version control" buffer-file-name)))))
860 894
2969 3003
2970 ;; Menu -- Using easymenu.el 3004 ;; Menu -- Using easymenu.el
2971 (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map 3005 (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
2972 "VC Annotate Display Menu" 3006 "VC Annotate Display Menu"
2973 `("VC-Annotate" 3007 `("VC-Annotate"
2974 ["Default" (unless (null vc-annotate-display-mode) 3008 ["By Color Map Range" (unless (null vc-annotate-display-mode)
2975 (setq vc-annotate-display-mode nil) 3009 (setq vc-annotate-display-mode nil)
2976 (vc-annotate-display-select)) 3010 (vc-annotate-display-select))
2977 :style toggle :selected (null vc-annotate-display-mode)] 3011 :style toggle :selected (null vc-annotate-display-mode)]
2978 ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map))) 3012 ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
2979 (mapcar (lambda (element) 3013 (mapcar (lambda (element)
3011 By default, the current buffer is highlighted, unless overridden by 3045 By default, the current buffer is highlighted, unless overridden by
3012 BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to 3046 BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
3013 use; you may override this using the second optional arg MODE." 3047 use; you may override this using the second optional arg MODE."
3014 (interactive) 3048 (interactive)
3015 (if mode (setq vc-annotate-display-mode mode)) 3049 (if mode (setq vc-annotate-display-mode mode))
3016 (when buffer 3050 (pop-to-buffer (or buffer (current-buffer)))
3017 (set-buffer buffer)
3018 (display-buffer buffer))
3019 (if (not vc-annotate-parent-rev)
3020 (vc-annotate-mode))
3021 (cond ((null vc-annotate-display-mode) 3051 (cond ((null vc-annotate-display-mode)
3022 ;; The ratio is global, thus relative to the global color-map. 3052 ;; The ratio is global, thus relative to the global color-map.
3023 (kill-local-variable 'vc-annotate-color-map) 3053 (kill-local-variable 'vc-annotate-color-map)
3024 (vc-annotate-display-default (or vc-annotate-ratio 1.0))) 3054 (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
3025 ;; One of the auto-scaling modes 3055 ;; One of the auto-scaling modes
3085 (if buf (with-current-buffer buf 3115 (if buf (with-current-buffer buf
3086 (rename-buffer temp-buffer-name t) 3116 (rename-buffer temp-buffer-name t)
3087 ;; In case it had to be uniquified. 3117 ;; In case it had to be uniquified.
3088 (setq temp-buffer-name (buffer-name)))) 3118 (setq temp-buffer-name (buffer-name))))
3089 (with-output-to-temp-buffer temp-buffer-name 3119 (with-output-to-temp-buffer temp-buffer-name
3090 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)) 3120 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)
3091 (with-current-buffer temp-buffer-name 3121 ;; we must setup the mode first, and then set our local
3092 (set (make-local-variable 'vc-annotate-backend) (vc-backend file)) 3122 ;; variables before the show-function is called at the exit of
3093 (set (make-local-variable 'vc-annotate-parent-file) file) 3123 ;; with-output-to-temp-buffer
3094 (set (make-local-variable 'vc-annotate-parent-rev) rev) 3124 (with-current-buffer temp-buffer-name
3095 (set (make-local-variable 'vc-annotate-parent-display-mode) 3125 (if (not (equal major-mode 'vc-annotate-mode))
3096 display-mode)) 3126 (vc-annotate-mode))
3097 3127 (set (make-local-variable 'vc-annotate-backend) (vc-backend file))
3098 (message "Annotating... done"))) 3128 (set (make-local-variable 'vc-annotate-parent-file) file)
3129 (set (make-local-variable 'vc-annotate-parent-rev) rev)
3130 (set (make-local-variable 'vc-annotate-parent-display-mode)
3131 display-mode)))
3132 (message "Annotating... done")))
3099 3133
3100 (defun vc-annotate-prev-version (prefix) 3134 (defun vc-annotate-prev-version (prefix)
3101 "Visit the annotation of the version previous to this one. 3135 "Visit the annotation of the version previous to this one.
3102 3136
3103 With a numeric prefix argument, annotate the version that many 3137 With a numeric prefix argument, annotate the version that many
3189 if possible, otherwise echo a warning message. If REVSPEC is a 3223 if possible, otherwise echo a warning message. If REVSPEC is a
3190 string, then it describes a revision number, so warp to that 3224 string, then it describes a revision number, so warp to that
3191 revision." 3225 revision."
3192 (if (not (equal major-mode 'vc-annotate-mode)) 3226 (if (not (equal major-mode 'vc-annotate-mode))
3193 (message "Cannot be invoked outside of a vc annotate buffer") 3227 (message "Cannot be invoked outside of a vc annotate buffer")
3194 (let* ((oldline (line-number-at-pos)) 3228 (let* ((buf (current-buffer))
3229 (oldline (line-number-at-pos))
3195 (revspeccopy revspec) 3230 (revspeccopy revspec)
3196 (newrev nil)) 3231 (newrev nil))
3197 (cond 3232 (cond
3198 ((and (integerp revspec) (> revspec 0)) 3233 ((and (integerp revspec) (> revspec 0))
3199 (setq newrev vc-annotate-parent-rev) 3234 (setq newrev vc-annotate-parent-rev)
3216 ((stringp revspec) (setq newrev revspec)) 3251 ((stringp revspec) (setq newrev revspec))
3217 (t (error "Invalid argument to vc-annotate-warp-version"))) 3252 (t (error "Invalid argument to vc-annotate-warp-version")))
3218 (when newrev 3253 (when newrev
3219 (vc-annotate vc-annotate-parent-file newrev 3254 (vc-annotate vc-annotate-parent-file newrev
3220 vc-annotate-parent-display-mode 3255 vc-annotate-parent-display-mode
3221 (current-buffer)) 3256 buf)
3222 (goto-line (min oldline (progn (goto-char (point-max)) 3257 (goto-line (min oldline (progn (goto-char (point-max))
3223 (previous-line) 3258 (previous-line)
3224 (line-number-at-pos)))))))) 3259 (line-number-at-pos))) buf)))))
3225 3260
3226 (defun vc-annotate-compcar (threshold a-list) 3261 (defun vc-annotate-compcar (threshold a-list)
3227 "Test successive cons cells of A-LIST against THRESHOLD. 3262 "Test successive cons cells of A-LIST against THRESHOLD.
3228 Return the first cons cell with a car that is not less than THRESHOLD, 3263 Return the first cons cell with a car that is not less than THRESHOLD,
3229 nil if no such cell exists." 3264 nil if no such cell exists."
3273 (while (and (< (point) limit) 3308 (while (and (< (point) limit)
3274 (setq difference (vc-annotate-difference vc-annotate-offset))) 3309 (setq difference (vc-annotate-difference vc-annotate-offset)))
3275 (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) 3310 (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
3276 (cons nil vc-annotate-very-old-color))) 3311 (cons nil vc-annotate-very-old-color)))
3277 ;; substring from index 1 to remove any leading `#' in the name 3312 ;; substring from index 1 to remove any leading `#' in the name
3278 (face-name (concat "vc-annotate-face-" (substring (cdr color) 1))) 3313 (face-name (concat "vc-annotate-face-"
3314 (if (string-equal
3315 (substring (cdr color) 0 1) "#")
3316 (substring (cdr color) 1)
3317 (cdr color))))
3279 ;; Make the face if not done. 3318 ;; Make the face if not done.
3280 (face (or (intern-soft face-name) 3319 (face (or (intern-soft face-name)
3281 (let ((tmp-face (make-face (intern face-name)))) 3320 (let ((tmp-face (make-face (intern face-name))))
3282 (set-face-foreground tmp-face (cdr color)) 3321 (set-face-foreground tmp-face (cdr color))
3283 (if vc-annotate-background 3322 (if vc-annotate-background