diff options
Diffstat (limited to 'lisp/vc')
-rw-r--r-- | lisp/vc/diff-mode.el | 18 | ||||
-rw-r--r-- | lisp/vc/ediff-init.el | 30 | ||||
-rw-r--r-- | lisp/vc/ediff-util.el | 10 | ||||
-rw-r--r-- | lisp/vc/emerge.el | 14 | ||||
-rw-r--r-- | lisp/vc/smerge-mode.el | 3 | ||||
-rw-r--r-- | lisp/vc/vc-annotate.el | 104 | ||||
-rw-r--r-- | lisp/vc/vc-bzr.el | 7 | ||||
-rw-r--r-- | lisp/vc/vc-hg.el | 52 | ||||
-rw-r--r-- | lisp/vc/vc-hooks.el | 13 | ||||
-rw-r--r-- | lisp/vc/vc.el | 15 |
10 files changed, 191 insertions, 75 deletions
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 923de9a0ca6..4908c5f4961 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -302,14 +302,9 @@ well." (defvar diff-added-face 'diff-added) (defface diff-changed - ;; We normally apply a `shadow'-based face on the `diff-context' - ;; face, and keep `diff-changed' the default. - '((((class color grayscale) (min-colors 88))) - ;; If the terminal lacks sufficient colors for shadowing, - ;; highlight changed lines explicitly. - (((class color)) - :foreground "yellow")) + '((t nil)) "`diff-mode' face used to highlight changed lines." + :version "24.5" :group 'diff-mode) (define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") (defvar diff-changed-face 'diff-changed) @@ -343,8 +338,12 @@ well." (defvar diff-function-face 'diff-function) (defface diff-context - '((((class color grayscale) (min-colors 88)) :inherit shadow)) + '((((class color grayscale) (min-colors 88) (background light)) + :foreground "#333333") + (((class color grayscale) (min-colors 88) (background dark)) + :foreground "#dddddd")) "`diff-mode' face used to highlight context and other side-information." + :version "24.5" :group 'diff-mode) (define-obsolete-face-alias 'diff-context-face 'diff-context "22.1") (defvar diff-context-face 'diff-context) @@ -1916,7 +1915,7 @@ For use in `add-log-current-defun-function'." ;;; Fine change highlighting. -(defface diff-refine-change +(defface diff-refine-changed '((((class color) (min-colors 88) (background light)) :background "#ffff55") (((class color) (min-colors 88) (background dark)) @@ -1924,6 +1923,7 @@ For use in `add-log-current-defun-function'." (t :inverse-video t)) "Face used for char-based changes shown by `diff-refine-hunk'." :group 'diff-mode) +(define-obsolete-face-alias 'diff-refine-change 'diff-refine-changed "24.5") (defface diff-refine-removed '((default diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index dd0d76485bf..589ea454965 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -949,7 +949,9 @@ this variable represents.") (defface ediff-current-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "VioletRed")) + (((class color) (min-colors 16)) (:foreground "Black" :background "VioletRed")) (((class color)) (:foreground "black" :background "magenta3")) @@ -1057,7 +1059,9 @@ this variable represents.") (defface ediff-fine-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "Green")) + (((class color) (min-colors 16)) (:foreground "Black" :background "Green")) (((class color)) (:foreground "red3" :background "green")) @@ -1091,6 +1095,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "green3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1115,7 +1121,9 @@ this variable represents.") (defface ediff-even-diff-B (if (featurep 'emacs) - `((((class color) (min-colors 16)) + `((((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) (:foreground "blue3" :background "Grey" :weight bold)) @@ -1138,6 +1146,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "yellow3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1164,6 +1174,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "cyan3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1197,6 +1209,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "green3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1222,6 +1236,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "White" :background "gray40")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1246,6 +1262,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "yellow3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1268,7 +1286,9 @@ this variable represents.") (defface ediff-odd-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "gray40")) + (((class color) (min-colors 16)) (:foreground "cyan3" :background "gray40")) (((class color)) (:foreground "green3" :background "black" :weight bold)) @@ -1326,7 +1346,7 @@ this variable represents.") (ediff-defvar-local ediff-current-diff-overlay-Ancestor nil "Overlay for the current difference region in the ancestor buffer.") -(defvar ediff-toggle-read-only-function 'toggle-read-only +(defvar ediff-toggle-read-only-function 'read-only-mode "Function to be used to toggle read-only status of the buffer. If nil, Ediff tries using the command bound to C-x C-q.") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index dbf52479527..9ca9effbfd4 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1027,8 +1027,8 @@ of the current buffer." (file-writable-p file))) (toggle-ro-cmd (cond (ediff-toggle-read-only-function) ((ediff-file-checked-out-p file) - 'toggle-read-only) - (file-writable 'toggle-read-only) + 'read-only-mode) + (file-writable 'read-only-mode) (t (key-binding "\C-x\C-q"))))) ;; If the file is checked in, make sure we don't make buffer modifiable ;; without warning the user. The user can fool our checks by making the @@ -1039,7 +1039,7 @@ of the current buffer." ;; non-interactively, in which case don't ask questions ctl-buf) (cond ((not buffer-read-only) - (setq toggle-ro-cmd 'toggle-read-only)) + (setq toggle-ro-cmd 'read-only-mode)) ((and (or (beep 1) t) ; always beep (y-or-n-p (format @@ -1054,13 +1054,13 @@ of the current buffer." (ediff-change-saved-variable 'buffer-read-only nil buf-type))) (t - (setq toggle-ro-cmd 'toggle-read-only) + (setq toggle-ro-cmd 'read-only-mode) (beep 1) (beep 1) (message "Boy, this is risky! Don't modify this file...") (sit-for 3)))) ; let the user see the warning (if (and toggle-ro-cmd - (string-match "toggle-read-only" (symbol-name toggle-ro-cmd))) + (string-match "read-only-mode" (symbol-name toggle-ro-cmd))) (save-excursion (save-window-excursion (select-window (ediff-get-visible-buffer-window buf)) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index d4638616dd7..b17d11d34a4 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -2883,17 +2883,11 @@ keymap. Leaves merge in fast mode." (setq vars (cdr vars)) (setq values (cdr values)))) -;; Make a temporary file that only we have access to. -;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix. +;; When the pointless option emerge-temp-file-prefix goes, +;; make this function obsolete too, and just use make-temp-file. (defun emerge-make-temp-file (prefix) - (let (f (old-modes (default-file-modes))) - (unwind-protect - (progn - ;; This has no effect, since make-temp-file sets umask = 700. - (set-default-file-modes emerge-temp-file-mode) - (setq f (make-temp-file (concat emerge-temp-file-prefix prefix)))) - (set-default-file-modes old-modes)) - f)) + "Make a private temporary file based on `emerge-temp-file-prefix'." + (make-temp-file (concat emerge-temp-file-prefix prefix))) ;;; Functions that query the user before he can write out the current buffer. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index cc9c4673345..771281555ab 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -116,9 +116,10 @@ Used in `smerge-diff-base-mine' and related functions." (define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1") (defvar smerge-markers-face 'smerge-markers) -(defface smerge-refined-change +(defface smerge-refined-changed '((t nil)) "Face used for char-based changes shown by `smerge-refine'.") +(define-obsolete-face-alias 'smerge-refined-change 'smerge-refined-changed "24.5") (defface smerge-refined-removed '((default diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 424b48a4ffa..a9085bc901f 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -40,6 +40,29 @@ :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) + (ignore-errors + ;; Update the value of the dependent variable. + (custom-reevaluate-setting 'vc-annotate-color-map)))) + :version "24.5" + :group 'vc) + (defcustom vc-annotate-color-map (if (and (tty-display-color-p) (<= (display-color-cells) 8)) ;; A custom sorted TTY colormap @@ -71,25 +94,49 @@ (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 @@ -98,12 +145,12 @@ all other colors between (excluding black and white)." :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)) @@ -347,7 +394,9 @@ 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." +`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) @@ -666,10 +715,13 @@ The annotations are relative to the current time, unless overridden by OFFSET." ;; 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. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 0730a9c72ce..4693998dfaf 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1132,11 +1132,12 @@ stream. Standard error output is discarded." (file &optional keep noquery reset-vc-info)) (defun vc-bzr-shelve (name) - "Create a shelve." + "Shelve the changes of the selected files." (interactive "sShelf name: ") - (let ((root (vc-bzr-root default-directory))) + (let ((root (vc-bzr-root default-directory)) + (fileset (vc-deduce-fileset))) (when root - (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) + (vc-bzr-command "shelve" nil 0 (nth 1 fileset) "--all" "-m" name) (vc-resynch-buffer root t t)))) (defun vc-bzr-shelve-show (name) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index b800c64c869..df61006ad51 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -82,8 +82,8 @@ ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK ;; TAG SYSTEM -;; - create-tag (dir name branchp) NEEDED -;; - retrieve-tag (dir name update) NEEDED +;; - create-tag (dir name branchp) OK +;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? ;; - repository-hostname (dirname) ?? @@ -146,12 +146,19 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :group 'vc-hg) (defcustom vc-hg-root-log-format - '("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n" - "^\\([0-9]+\\):\\([^:]*\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" + `(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}" + ":{bookmarks}:{tags}:{author|person}" + " {date|shortdate} {desc|firstline}\\n") + ,(concat "^\\(?:[+@o x|-]*\\)" ;Graph data. + "\\([0-9]+\\):\\([^:]*\\)" + ":\\([^:]*\\):\\([^:]*\\):\\(.*?\\)" + "[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)") ((1 'log-view-message-face) - (2 'change-log-list) - (3 'change-log-name) - (4 'change-log-date))) + (2 'change-log-file) + (3 'change-log-list) + (4 'change-log-conditionals) + (5 'change-log-name) + (6 'change-log-date))) "Mercurial log template for `vc-hg-print-log' short format. This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE is the \"--template\" argument string to pass to Mercurial, @@ -160,7 +167,7 @@ output, and KEYWORDS is a list of `font-lock-keywords' for highlighting the Log View buffer." :type '(list string string (repeat sexp)) :group 'vc-hg - :version "24.1") + :version "24.5") ;;; Properties of the backend @@ -244,6 +251,9 @@ highlighting the Log View buffer." (autoload 'vc-setup-buffer "vc-dispatcher") +(defvar vc-hg-log-graph nil + "If non-nil, use `--graph' in the short log output.") + (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit) "Print commit log associated with FILES into specified BUFFER. If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. @@ -261,7 +271,9 @@ If LIMIT is non-nil, show no more than this many entries." (nconc (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) - (when shortlog (list "--template" (car vc-hg-root-log-format))) + (when shortlog `(,@(if vc-hg-log-graph '("--graph")) + "--template" + ,(car vc-hg-root-log-format))) vc-hg-log-switches))))) (defvar log-view-message-re) @@ -376,8 +388,26 @@ Optional arg REVISION is a revision to annotate from." (if (match-beginning 3) (match-string-no-properties 1) (cons (match-string-no-properties 1) - (expand-file-name (match-string-no-properties 4) - (vc-hg-root default-directory))))))) + (expand-file-name (match-string-no-properties 4) + (vc-hg-root default-directory))))))) + +;;; Tag system + +(defun vc-hg-create-tag (dir name branchp) + "Attach the tag NAME to the state of the working copy." + (let ((default-directory dir)) + (and (vc-hg-command nil 0 nil "status") + (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) + +(defun vc-hg-retrieve-tag (dir name update) + "Retrieve the version tagged by NAME of all registered files at or below DIR." + (let ((default-directory dir)) + (vc-hg-command nil 0 nil "update" name) + ;; FIXME: update buffers if `update' is true + ;; TODO: update *vc-change-log* buffer so can see @ if --graph + )) + +;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) (let ((newrev (1- (string-to-number rev)))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index fb10edca06d..df660d193e2 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -190,6 +190,11 @@ individually should stay local." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +;;; We signal this error when we try to do something a VC backend +;;; doesn't support. Two arguments: the method that's not supported +;;; and the backend +(define-error 'vc-not-supported "VC method not implemented for backend") + (defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. @@ -268,10 +273,10 @@ It is usually called via the `vc-call' macro." (setq f (vc-find-backend-function backend function-name)) (push (cons function-name f) (get backend 'vc-functions))) (cond - ((null f) - (error "Sorry, %s is not implemented for %s" function-name backend)) - ((consp f) (apply (car f) (cdr f) args)) - (t (apply f args))))) + ((null f) + (signal 'vc-not-supported (list function-name backend))) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4a536900eb3..5491d67e700 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1879,6 +1879,19 @@ saving the buffer." (called-interactively-p 'interactive)))))) ;;;###autoload +(defun vc-root-dir () + "Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified." + (let ((backend (vc-deduce-backend))) + (if backend + (condition-case err + (vc-call-backend backend 'root default-directory) + (vc-not-supported + (unless (eq (cadr err) 'root) + (signal (car err) (cdr err))) + nil))))) + +;;;###autoload (defun vc-revision-other-window (rev) "Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -2450,7 +2463,7 @@ depending on the underlying version-control system." (error "Please revert all modified workfiles before rollback"))) ;; Accumulate changes associated with the fileset (vc-setup-buffer "*vc-diff*") - (not-modified) + (set-buffer-modified-p nil) (message "Finding changes...") (let* ((tip (vc-working-revision (car files))) ;; FIXME: `previous-revision' should take the fileset. |