summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el17
-rw-r--r--lisp/vc/compare-w.el84
-rw-r--r--lisp/vc/diff-mode.el28
-rw-r--r--lisp/vc/ediff-init.el41
-rw-r--r--lisp/vc/ediff-util.el10
-rw-r--r--lisp/vc/emerge.el14
-rw-r--r--lisp/vc/smerge-mode.el13
-rw-r--r--lisp/vc/vc-annotate.el117
-rw-r--r--lisp/vc/vc-arch.el652
-rw-r--r--lisp/vc/vc-bzr.el63
-rw-r--r--lisp/vc/vc-cvs.el159
-rw-r--r--lisp/vc/vc-dav.el30
-rw-r--r--lisp/vc/vc-dir.el36
-rw-r--r--lisp/vc/vc-dispatcher.el6
-rw-r--r--lisp/vc/vc-filewise.el84
-rw-r--r--lisp/vc/vc-git.el147
-rw-r--r--lisp/vc/vc-hg.el129
-rw-r--r--lisp/vc/vc-hooks.el243
-rw-r--r--lisp/vc/vc-mtn.el27
-rw-r--r--lisp/vc/vc-rcs.el280
-rw-r--r--lisp/vc/vc-sccs.el138
-rw-r--r--lisp/vc/vc-src.el313
-rw-r--r--lisp/vc/vc-svn.el111
-rw-r--r--lisp/vc/vc.el628
24 files changed, 1517 insertions, 1853 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 8e44c024dc4..cd6fcaec28e 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1097,12 +1097,17 @@ file were isearch was started."
(ignore-errors
(version< (substring b (length name))
(substring a (length name))))))))
- (files (if isearch-forward files (reverse files))))
- (find-file-noselect
- (if wrap
- (car files)
- (cadr (member (file-name-nondirectory (buffer-file-name buffer))
- files))))))
+ (files (if isearch-forward files (reverse files)))
+ (file (if wrap
+ (car files)
+ (cadr (member (file-name-nondirectory (buffer-file-name buffer))
+ files)))))
+ ;; If there are no files that match the default pattern ChangeLog.[0-9],
+ ;; return the current buffer to force isearch wrapping to its beginning.
+ ;; If file is nil, multi-isearch-search-fun will signal "end of multi".
+ (if (file-exists-p file)
+ (find-file-noselect file)
+ (current-buffer))))
(defun change-log-fill-forward-paragraph (n)
"Cut paragraphs so filling preserves open parentheses at beginning of lines."
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index 25d4cf77f53..454139e9025 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -30,6 +30,8 @@
;;; Code:
+(require 'diff-mode) ; For diff faces.
+
(defgroup compare-windows nil
"Compare text between windows."
:prefix "compare-"
@@ -128,11 +130,19 @@ out all highlighting later with the command `compare-windows-dehighlight'."
:group 'compare-windows
:version "22.1")
-(defface compare-windows
- '((t :inherit lazy-highlight))
- "Face for highlighting of compare-windows difference regions."
+(defface compare-windows-removed
+ '((t :inherit diff-removed))
+ "Face for highlighting of compare-windows removed regions."
:group 'compare-windows
- :version "22.1")
+ :version "25.1")
+
+(defface compare-windows-added
+ '((t :inherit diff-added))
+ "Face for highlighting of compare-windows added regions."
+ :group 'compare-windows
+ :version "25.1")
+
+(define-obsolete-face-alias 'compare-windows 'compare-windows-added "25.1")
(defvar compare-windows-overlay1 nil)
(defvar compare-windows-overlay2 nil)
@@ -140,9 +150,44 @@ out all highlighting later with the command `compare-windows-dehighlight'."
(defvar compare-windows-overlays2 nil)
(defvar compare-windows-sync-point nil)
+(defcustom compare-windows-get-window-function 'compare-windows-get-recent-window
+ "Function that provides the window to compare with."
+ :type '(choice
+ (function-item :tag "Most recently used window"
+ compare-windows-get-recent-window)
+ (function-item :tag "Next window"
+ compare-windows-get-next-window)
+ (function :tag "Your function"))
+ :group 'compare-windows
+ :version "25.0")
+
+(defun compare-windows-get-recent-window ()
+ "Return the most recently used window.
+First try to get the most recently used window on a visible frame,
+then try to get a window on an iconified frame, and finally
+consider all existing frames."
+ (or (get-mru-window 'visible t t)
+ (get-mru-window 0 t t)
+ (get-mru-window t t t)
+ (error "No other window")))
+
+(defun compare-windows-get-next-window ()
+ "Return the window next in the cyclic ordering of windows.
+In the selected frame contains only one window, consider windows
+on all visible frames."
+ (let ((w2 (next-window)))
+ (if (eq w2 (selected-window))
+ (setq w2 (next-window (selected-window) nil 'visible)))
+ (if (eq w2 (selected-window))
+ (error "No other window"))
+ w2))
+
;;;###autoload
(defun compare-windows (ignore-whitespace)
- "Compare text in current window with text in next window.
+ "Compare text in current window with text in another window.
+The option `compare-windows-get-window-function' defines how
+to get another window.
+
Compares the text starting at point in each window,
moving over text in each one as far as they match.
@@ -179,11 +224,7 @@ on third call it again advances points to the next difference and so on."
'compare-windows-sync-regexp
compare-windows-sync)))
(setq p1 (point) b1 (current-buffer))
- (setq w2 (next-window))
- (if (eq w2 (selected-window))
- (setq w2 (next-window (selected-window) nil 'visible)))
- (if (eq w2 (selected-window))
- (error "No other window"))
+ (setq w2 (funcall compare-windows-get-window-function))
(setq p2 (window-point w2)
b2 (window-buffer w2))
(setq opoint2 p2)
@@ -212,7 +253,7 @@ on third call it again advances points to the next difference and so on."
;; optionally skip over it.
(and skip-func-1
(save-excursion
- (let (p1a p2a w1 w2 result1 result2)
+ (let (p1a p2a result1 result2)
(setq result1 (funcall skip-func-1 opoint1))
(setq p1a (point))
(set-buffer b2)
@@ -255,12 +296,15 @@ on third call it again advances points to the next difference and so on."
(recenter (car compare-windows-recenter))
(with-selected-window w2 (recenter (cadr compare-windows-recenter))))
;; If points are still not synchronized, then ding
- (when (and (= p1 opoint1) (= p2 opoint2))
- ;; Display error message when current points in two windows
- ;; are unmatched and next matching points can't be found.
- (compare-windows-dehighlight)
- (ding)
- (message "No more matching points"))))))
+ (if (and (= p1 opoint1) (= p2 opoint2))
+ (progn
+ ;; Display error message when current points in two windows
+ ;; are unmatched and next matching points can't be found.
+ (compare-windows-dehighlight)
+ (ding)
+ (message "No more matches with %s" b2))
+ (message "Diff -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2)))
+ (message "Match -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2))))
;; Move forward over whatever might be called whitespace.
;; compare-windows-whitespace is a regexp that matches whitespace.
@@ -303,7 +347,7 @@ on third call it again advances points to the next difference and so on."
(defun compare-windows-sync-default-function ()
(if (not compare-windows-sync-point)
(let* ((w1 (selected-window))
- (w2 (next-window w1))
+ (w2 (funcall compare-windows-get-window-function))
(b2 (window-buffer w2))
(point-max2 (with-current-buffer b2 (point-max)))
(op2 (window-point w2))
@@ -360,13 +404,13 @@ on third call it again advances points to the next difference and so on."
(if compare-windows-overlay1
(move-overlay compare-windows-overlay1 beg1 end1 b1)
(setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
- (overlay-put compare-windows-overlay1 'face 'compare-windows)
+ (overlay-put compare-windows-overlay1 'face 'compare-windows-added)
(overlay-put compare-windows-overlay1 'priority 1000))
(overlay-put compare-windows-overlay1 'window w1)
(if compare-windows-overlay2
(move-overlay compare-windows-overlay2 beg2 end2 b2)
(setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
- (overlay-put compare-windows-overlay2 'face 'compare-windows)
+ (overlay-put compare-windows-overlay2 'face 'compare-windows-removed)
(overlay-put compare-windows-overlay2 'priority 1000))
(overlay-put compare-windows-overlay2 'window w2)
(if (not (eq compare-windows-highlight 'persistent))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 3d985d9ca4d..f3455efb294 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 "25.1"
: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 "25.1"
:group 'diff-mode)
(define-obsolete-face-alias 'diff-context-face 'diff-context "22.1")
(defvar diff-context-face 'diff-context)
@@ -1221,6 +1220,9 @@ else cover the whole buffer."
(?- (cl-incf minus))
(?! (cl-incf bang))
((or ?\\ ?#) nil)
+ (?\n (if diff-valid-unified-empty-line
+ (cl-incf space)
+ (setq space 0 plus 0 minus 0 bang 0)))
(_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
@@ -1815,6 +1817,16 @@ With a prefix argument, try to REVERSE the hunk."
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
+(defun diff-kill-applied-hunks ()
+ "Kill all hunks that have already been applied starting at point."
+ (interactive)
+ (while (not (eobp))
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil nil)))
+ (if (and line-offset switched)
+ (diff-hunk-kill)
+ (diff-hunk-next)))))
+
(defalias 'diff-mouse-goto-source 'diff-goto-source)
(defun diff-goto-source (&optional other-file event)
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index dd0d76485bf..9669e2c2313 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'cl-lib)
+
;; Start compiler pacifier
(defvar ediff-metajob-name)
(defvar ediff-meta-buffer)
@@ -118,11 +120,8 @@ It needs to be killed when we quit the session.")
(?C . ediff-buffer-C)))
;;; Macros
-(defmacro ediff-odd-p (arg)
- `(eq (logand ,arg 1) 1))
-
-(defmacro ediff-buffer-live-p (buf)
- `(and ,buf (get-buffer ,buf) (buffer-name (get-buffer ,buf))))
+(defsubst ediff-buffer-live-p (buf)
+ (and buf (get-buffer buf) (buffer-name (get-buffer buf))))
(defmacro ediff-get-buffer (arg)
`(cond ((eq ,arg 'A) ediff-buffer-A)
@@ -949,7 +948,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 +1058,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 +1094,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 +1120,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 +1145,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 +1173,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 +1208,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 +1235,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 +1261,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 +1285,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 +1345,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.")
@@ -1436,7 +1455,7 @@ This default should work without changes."
;; The value of dif-num is always 1- the one that user sees.
;; This is why even face is used when dif-num is odd.
(ediff-get-symbol-from-alist
- buf-type (if (ediff-odd-p dif-num)
+ buf-type (if (cl-oddp dif-num)
ediff-even-diff-face-alist
ediff-odd-diff-face-alist)
))
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 771281555ab..0b7b70219c0 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1132,6 +1132,19 @@ repeating the command will highlight other two parts."
(unless smerge-use-changed-face
'((smerge . refine) (face . smerge-refined-added))))))
+(defun smerge-swap ()
+ "Swap the \"Mine\" and the \"Other\" chunks.
+Can be used before things like `smerge-keep-all' or `smerge-resolve' where the
+ordering can have some subtle influence on the result, such as preferring the
+spacing of the \"Other\" chunk."
+ (interactive)
+ (smerge-match-conflict)
+ (goto-char (match-beginning 3))
+ (let ((txt3 (delete-and-extract-region (point) (match-end 3))))
+ (insert (delete-and-extract-region (match-beginning 1) (match-end 1)))
+ (goto-char (match-beginning 1))
+ (insert txt3)))
+
(defun smerge-diff (n1 n2)
(smerge-match-conflict)
(smerge-ensure-match n1)
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 424b48a4ffa..e270ec401ba 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)
+ (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
@@ -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))
@@ -206,7 +253,7 @@ cover the range from the oldest annotation to the newest."
(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.
@@ -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)
@@ -615,11 +664,10 @@ nil if no such cell exists."
(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.
@@ -634,7 +682,7 @@ or OFFSET if present."
(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)
@@ -666,10 +714,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-arch.el b/lisp/vc/vc-arch.el
deleted file mode 100644
index 2bc8b7b4339..00000000000
--- a/lisp/vc/vc-arch.el
+++ /dev/null
@@ -1,652 +0,0 @@
-;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*-
-
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
-
-;; Author: FSF (see vc.el for full credits)
-;; Maintainer: Stefan Monnier <monnier@gnu.org>
-;; Package: vc
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; The home page of the Arch version control system is at
-;;
-;; http://www.gnuarch.org/
-;;
-;; This is derived from vc-mcvs.el as follows:
-;; - cp vc-mcvs.el vc-arch.el and then M-% mcvs RET arch RET
-;;
-;; Then of course started the hacking.
-;;
-;; What has been partly tested:
-;; - Open a file.
-;; - C-x v = without any prefix arg.
-;; - C-x v v to commit a change to a single file.
-
-;; Bugs:
-
-;; - *vc-log*'s initial content lacks the `Summary:' lines.
-;; - All files under the tree are considered as "under Arch's control"
-;; without regards to =tagging-method and such.
-;; - Files are always considered as `edited'.
-;; - C-x v l does not work.
-;; - C-x v i does not work.
-;; - C-x v ~ does not work.
-;; - C-x v u does not work.
-;; - C-x v s does not work.
-;; - C-x v r does not work.
-;; - VC directory listings do not work.
-;; - And more...
-
-;;; Code:
-
-(eval-when-compile (require 'vc))
-
-;;; Properties of the backend
-
-(defun vc-arch-revision-granularity () 'repository)
-(defun vc-arch-checkout-model (_files) 'implicit)
-
-;;;
-;;; Customization options
-;;;
-
-(defgroup vc-arch nil
- "VC Arch backend."
- :version "24.1"
- :group 'vc)
-
-;; It seems Arch diff does not accept many options, so this is not
-;; very useful. It exists mainly so that the VC backends are all
-;; consistent with regards to their treatment of diff switches.
-(defcustom vc-arch-diff-switches t
- "String or list of strings specifying switches for Arch diff under VC.
-If nil, use the value of `vc-diff-switches'. If t, use no switches."
- :type '(choice (const :tag "Unspecified" nil)
- (const :tag "None" t)
- (string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :version "23.1"
- :group 'vc-arch)
-
-(define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1")
-
-(defcustom vc-arch-program
- (let ((candidates '("tla" "baz")))
- (while (and candidates (not (executable-find (car candidates))))
- (setq candidates (cdr candidates)))
- (or (car candidates) "tla"))
- "Name of the Arch executable."
- :type 'string
- :group 'vc-arch)
-
-;; Clear up the cache to force vc-call to check again and discover
-;; new functions when we reload this file.
-(put 'Arch 'vc-functions nil)
-
-;;;###autoload (defun vc-arch-registered (file)
-;;;###autoload (if (vc-find-root file "{arch}/=tagging-method")
-;;;###autoload (progn
-;;;###autoload (load "vc-arch" nil t)
-;;;###autoload (vc-arch-registered file))))
-
-(defun vc-arch-add-tagline ()
- "Add an `arch-tag' to the end of the current file."
- (interactive)
- (comment-normalize-vars)
- (goto-char (point-max))
- (forward-comment -1)
- (skip-chars-forward " \t\n")
- (cond
- ((not (bolp)) (insert "\n\n"))
- ((not (eq ?\n (char-before (1- (point))))) (insert "\n")))
- (let ((beg (point))
- (idfile (and buffer-file-name
- (expand-file-name
- (concat ".arch-ids/"
- (file-name-nondirectory buffer-file-name)
- ".id")
- (file-name-directory buffer-file-name)))))
- (insert "arch-tag: ")
- (if (and idfile (file-exists-p idfile))
- ;; If the file is unreadable, we do want to get an error here.
- (progn
- (insert-file-contents idfile)
- (forward-line 1)
- (delete-file idfile))
- (condition-case nil
- (call-process "uuidgen" nil t)
- (file-error (insert (format "%s <%s> %s"
- (current-time-string)
- user-mail-address
- (+ (nth 2 (current-time))
- (buffer-size)))))))
- (comment-region beg (point))))
-
-(defconst vc-arch-tagline-re "^\\W*arch-tag:[ \t]*\\(.*[^ \t\n]\\)")
-
-(defmacro vc-with-current-file-buffer (file &rest body)
- (declare (indent 2) (debug t))
- `(let ((-kill-buf- nil)
- (-file- ,file))
- (with-current-buffer (or (find-buffer-visiting -file-)
- (setq -kill-buf- (generate-new-buffer " temp")))
- ;; Avoid find-file-literally since it can do many undesirable extra
- ;; things (among which, call us back into an infinite loop).
- (if -kill-buf- (insert-file-contents -file-))
- (unwind-protect
- (progn ,@body)
- (if (buffer-live-p -kill-buf-) (kill-buffer -kill-buf-))))))
-
-(defun vc-arch-file-source-p (file)
- "Can return nil, `maybe' or a non-nil value.
-Only the value `maybe' can be trusted :-(."
- ;; FIXME: Check the tag and name of parent dirs.
- (unless (string-match "\\`[,+]" (file-name-nondirectory file))
- (or (string-match "\\`{arch}/"
- (file-relative-name file (vc-arch-root file)))
- (file-exists-p
- ;; Check the presence of an ID file.
- (expand-file-name
- (concat ".arch-ids/" (file-name-nondirectory file) ".id")
- (file-name-directory file)))
- ;; Check the presence of a tagline.
- (vc-with-current-file-buffer file
- (save-excursion
- (goto-char (point-max))
- (or (re-search-backward vc-arch-tagline-re (- (point) 1000) t)
- (progn
- (goto-char (point-min))
- (re-search-forward vc-arch-tagline-re (+ (point) 1000) t)))))
- ;; FIXME: check =tagging-method to see whether untagged files might
- ;; be source or not.
- (with-current-buffer
- (find-file-noselect (expand-file-name "{arch}/=tagging-method"
- (vc-arch-root file)))
- (let ((untagged-source t)) ;Default is `names'.
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^[ \t]*\\(\\(tagline\\|implicit\\|names\\)\\|explicit\\)" nil t)
- (setq untagged-source (match-end 2)))
- (if (re-search-forward "^[ \t]*untagged-source[ \t]+\\(\\(source\\)\\|precious\\|backup\\|junk\\|unrecognized\\)" nil t)
- (setq untagged-source (match-end 2))))
- (if untagged-source 'maybe))))))
-
-(defun vc-arch-file-id (file)
- ;; Don't include the kind of ID this is because it seems to be too messy.
- (let ((idfile (expand-file-name
- (concat ".arch-ids/" (file-name-nondirectory file) ".id")
- (file-name-directory file))))
- (if (file-exists-p idfile)
- (with-temp-buffer
- (insert-file-contents idfile)
- (looking-at ".*[^ \n\t]")
- (match-string 0))
- (with-current-buffer (find-file-noselect file)
- (save-excursion
- (goto-char (point-max))
- (if (or (re-search-backward vc-arch-tagline-re (- (point) 1000) t)
- (progn
- (goto-char (point-min))
- (re-search-forward vc-arch-tagline-re (+ (point) 1000) t)))
- (match-string 1)
- (concat "./" (file-relative-name file (vc-arch-root file)))))))))
-
-(defun vc-arch-tagging-method (file)
- (with-current-buffer
- (find-file-noselect
- (expand-file-name "{arch}/=tagging-method" (vc-arch-root file)))
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- "^[ \t]*\\(tagline\\|implicit\\|names\\|explicit\\)" nil t)
- (intern (match-string 1))
- 'names))))
-
-(defun vc-arch-root (file)
- "Return the root directory of an Arch project, if any."
- (or (vc-file-getprop file 'arch-root)
- ;; Check the =tagging-method, in case someone naively manually
- ;; creates a {arch} directory somewhere.
- (let ((root (vc-find-root file "{arch}/=tagging-method")))
- (when root
- (vc-file-setprop
- file 'arch-root root)))))
-
-(defun vc-arch-find-admin-dir (file)
- "Return the administrative directory of FILE."
- (expand-file-name "{arch}" (vc-arch-root file)))
-
-(defun vc-arch-register (files &optional rev _comment)
- (if rev (error "Explicit initial revision not supported for Arch"))
- (dolist (file files)
- (let ((tagmet (vc-arch-tagging-method file)))
- (if (and (memq tagmet '(tagline implicit)) comment-start)
- (with-current-buffer (find-file-noselect file)
- (if (buffer-modified-p)
- (error "Save %s first" (buffer-name)))
- (vc-arch-add-tagline)
- (save-buffer)))))
- (vc-arch-command nil 0 files "add"))
-
-(defun vc-arch-registered (file)
- ;; Don't seriously check whether it's source or not. Checking would
- ;; require running TLA, so it's better to not do it, so it also works if
- ;; TLA is not installed.
- (and (vc-arch-root file)
- (vc-arch-file-source-p file)))
-
-(defun vc-arch-default-version (file)
- (or (vc-file-getprop (vc-arch-root file) 'arch-default-version)
- (let* ((root (vc-arch-root file))
- (f (expand-file-name "{arch}/++default-version" root)))
- (if (file-readable-p f)
- (vc-file-setprop
- root 'arch-default-version
- (with-temp-buffer
- (insert-file-contents f)
- ;; Strip the terminating newline.
- (buffer-substring (point-min) (1- (point-max)))))))))
-
-(defun vc-arch-workfile-unchanged-p (_file)
- "Stub: arch workfiles are always considered to be in a changed state,"
- nil)
-
-(defun vc-arch-state (file)
- ;; There's no checkout operation and merging is not done from VC
- ;; so the only operation that's state dependent that VC supports is commit
- ;; which is only activated if the file is `edited'.
- (let* ((root (vc-arch-root file))
- (ver (vc-arch-default-version file))
- (pat (concat "\\`" (subst-char-in-string ?/ ?% ver)))
- (dir (expand-file-name ",,inode-sigs/"
- (expand-file-name "{arch}" root)))
- (sigfile nil))
- (dolist (f (if (file-directory-p dir) (directory-files dir t pat)))
- (if (or (not sigfile) (file-newer-than-file-p f sigfile))
- (setq sigfile f)))
- (if (not sigfile)
- 'edited ;We know nothing.
- (let ((id (vc-arch-file-id file)))
- (setq id (replace-regexp-in-string "[ \t]" "_" id))
- (with-current-buffer (find-file-noselect sigfile)
- (goto-char (point-min))
- (while (and (search-forward id nil 'move)
- (save-excursion
- (goto-char (- (match-beginning 0) 2))
- ;; For `names', the lines start with `?./foo/bar'.
- ;; For others there's 2 chars before the ./foo/bar.
- (or (not (or (bolp) (looking-at "\n?")))
- ;; Ignore E_ entries used for foo.id files.
- (looking-at "E_")))))
- (if (eobp)
- ;; ID not found.
- (if (equal (file-name-nondirectory sigfile)
- (subst-char-in-string
- ?/ ?% (vc-arch-working-revision file)))
- 'added
- ;; Might be `added' or `up-to-date' as well.
- ;; FIXME: Check in the patch logs to find out.
- 'edited)
- ;; Found the ID, let's check the inode.
- (if (not (re-search-forward
- "\t.*mtime=\\([0-9]+\\):size=\\([0-9]+\\)"
- (line-end-position) t))
- ;; Buh? Unexpected format.
- 'edited
- (let ((ats (file-attributes file)))
- (if (and (eq (nth 7 ats) (string-to-number (match-string 2)))
- (equal (format-time-string "%s" (nth 5 ats))
- (match-string 1)))
- 'up-to-date
- 'edited)))))))))
-
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code))
-
-(defun vc-arch-dir-status (dir callback)
- "Run 'tla inventory' for DIR and pass results to CALLBACK.
-CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
-`vc-dir-refresh'."
- (let ((default-directory dir))
- (vc-arch-command t 'async nil "changes"))
- ;; The updating could be done asynchronously.
- (vc-run-delayed
- (vc-arch-after-dir-status callback)))
-
-(defun vc-arch-after-dir-status (callback)
- (let* ((state-map '(("M " . edited)
- ("Mb" . edited) ;binary
- ("D " . removed)
- ("D/" . removed) ;directory
- ("A " . added)
- ("A/" . added) ;directory
- ("=>" . renamed)
- ("/>" . renamed) ;directory
- ("lf" . symlink-to-file)
- ("fl" . file-to-symlink)
- ("--" . permissions-changed)
- ("-/" . permissions-changed) ;directory
- ))
- (state-map-regexp (regexp-opt (mapcar 'car state-map) t))
- (entry-regexp (concat "^" state-map-regexp " \\(.*\\)$"))
- result)
- (goto-char (point-min))
- ;;(message "Got %s" (buffer-string))
- (while (re-search-forward entry-regexp nil t)
- (let* ((state-string (match-string 1))
- (state (cdr (assoc state-string state-map)))
- (filename (match-string 2)))
- (push (list filename state) result)))
-
- (funcall callback result nil)))
-
-(defun vc-arch-working-revision (file)
- (let* ((root (expand-file-name "{arch}" (vc-arch-root file)))
- (defbranch (vc-arch-default-version file)))
- (when (and defbranch (string-match "\\`\\(.+@[^/\n]+\\)/\\(\\(\\(.*?\\)\\(?:--.*\\)?\\)--.*\\)\\'" defbranch))
- (let* ((archive (match-string 1 defbranch))
- (category (match-string 4 defbranch))
- (branch (match-string 3 defbranch))
- (version (match-string 2 defbranch))
- (sealed nil) (rev-nb 0)
- (rev nil)
- logdir tmp)
- (setq logdir (expand-file-name category root))
- (setq logdir (expand-file-name branch logdir))
- (setq logdir (expand-file-name version logdir))
- (setq logdir (expand-file-name archive logdir))
- (setq logdir (expand-file-name "patch-log" logdir))
- (dolist (file (if (file-directory-p logdir) (directory-files logdir)))
- ;; Revision names go: base-0, patch-N, version-0, versionfix-M.
- (when (and (eq (aref file 0) ?v) (not sealed))
- (setq sealed t rev-nb 0))
- (if (and (string-match "-\\([0-9]+\\)\\'" file)
- (setq tmp (string-to-number (match-string 1 file)))
- (or (not sealed) (eq (aref file 0) ?v))
- (>= tmp rev-nb))
- (setq rev-nb tmp rev file)))
- ;; Use "none-000" if the tree hasn't yet been committed on the
- ;; default branch. We'll then get "Arch:000[branch]" on the mode-line.
- (concat defbranch "--" (or rev "none-000"))))))
-
-
-(defcustom vc-arch-mode-line-rewrite
- '(("\\`.*--\\(.*--.*\\)--\\(v?\\).*-\\([0-9]+\\)\\'" . "\\2\\3[\\1]"))
- "Rewrite rules to shorten Arch's revision names on the mode-line."
- :type '(repeat (cons regexp string))
- :group 'vc-arch)
-
-(defun vc-arch-mode-line-string (file)
- "Return a string for `vc-mode-line' to put in the mode line for FILE."
- (let ((rev (vc-working-revision file)))
- (dolist (rule vc-arch-mode-line-rewrite)
- (if (string-match (car rule) rev)
- (setq rev (replace-match (cdr rule) t nil rev))))
- (format "Arch%c%s"
- (pcase (vc-state file)
- ((or `up-to-date `needs-update) ?-)
- (`added ?@)
- (t ?:))
- rev)))
-
-(defun vc-arch-diff3-rej-p (rej)
- (let ((attrs (file-attributes rej)))
- (and attrs (< (nth 7 attrs) 60)
- (with-temp-buffer
- (insert-file-contents rej)
- (goto-char (point-min))
- (looking-at "Conflicts occurred, diff3 conflict markers left in file\\.")))))
-
-(defun vc-arch-delete-rej-if-obsolete ()
- "For use in `after-save-hook'."
- (save-excursion
- (let ((rej (concat buffer-file-name ".rej")))
- (when (and buffer-file-name (vc-arch-diff3-rej-p rej))
- (unless (re-search-forward "^<<<<<<< " nil t)
- ;; The .rej file is obsolete.
- (condition-case nil (delete-file rej) (error nil))
- ;; Remove the hook so that it is not called multiple times.
- (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t))))))
-
-(defun vc-arch-find-file-hook ()
- (let ((rej (concat buffer-file-name ".rej")))
- (when (and buffer-file-name (file-exists-p rej))
- (if (vc-arch-diff3-rej-p rej)
- (save-excursion
- (goto-char (point-min))
- (if (not (re-search-forward "^<<<<<<< " nil t))
- ;; The .rej file is obsolete.
- (condition-case nil (delete-file rej) (error nil))
- (smerge-mode 1)
- (add-hook 'after-save-hook
- 'vc-arch-delete-rej-if-obsolete nil t)
- (message "There are unresolved conflicts in this file")))
- (message "There are unresolved conflicts in %s"
- (file-name-nondirectory rej))))))
-
-(autoload 'vc-switches "vc")
-
-(defun vc-arch-checkin (files rev comment)
- (if rev (error "Committing to a specific revision is unsupported"))
- ;; FIXME: This implementation probably only works for singleton filesets
- (let ((summary (file-relative-name (car files) (vc-arch-root (car files)))))
- ;; Extract a summary from the comment.
- (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment)
- (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment))
- (setq summary (match-string 1 comment))
- (setq comment (substring comment (match-end 0))))
- (vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--"
- (vc-switches 'Arch 'checkin))))
-
-(defun vc-arch-diff (files &optional oldvers newvers buffer)
- "Get a difference report using Arch between two versions of FILES."
- ;; FIXME: This implementation only works for singleton filesets. To make
- ;; it work for more cases, we have to either call `file-diffs' manually on
- ;; each and every `file' in the fileset, or use `changes --diffs' (and
- ;; variants) and maybe filter the output with `filterdiff' to only include
- ;; the files in which we're interested.
- (let ((file (car files)))
- (if (and newvers
- (vc-up-to-date-p file)
- (equal newvers (vc-working-revision file)))
- ;; Newvers is the base revision and the current file is unchanged,
- ;; so we can diff with the current file.
- (setq newvers nil))
- (if newvers
- (error "Diffing specific revisions not implemented")
- (let* (process-file-side-effects
- (async (not vc-disable-async-diff))
- ;; Run the command from the root dir.
- (default-directory (vc-arch-root file))
- (status
- (vc-arch-command
- (or buffer "*vc-diff*")
- (if async 'async 1)
- nil "file-diffs"
- (vc-switches 'Arch 'diff)
- (file-relative-name file)
- (if (equal oldvers (vc-working-revision file))
- nil
- oldvers))))
- (if async 1 status))))) ; async diff, pessimistic assumption.
-
-(defun vc-arch-delete-file (file)
- (vc-arch-command nil 0 file "rm"))
-
-(defun vc-arch-rename-file (old new)
- (vc-arch-command nil 0 new "mv" (file-relative-name old)))
-
-(defalias 'vc-arch-responsible-p 'vc-arch-root)
-
-(defun vc-arch-command (buffer okstatus file &rest flags)
- "A wrapper around `vc-do-command' for use in vc-arch.el."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
-
-(defun vc-arch-init-revision () nil)
-
-;;; Completion of versions and revisions.
-
-(defun vc-arch--version-completion-table (root string)
- (delq nil
- (mapcar
- (lambda (d)
- (when (string-match "/\\([^/]+\\)/\\([^/]+\\)\\'" d)
- (concat (match-string 2 d) "/" (match-string 1 d))))
- (let ((default-directory root))
- (file-expand-wildcards
- (concat "*/*/"
- (if (string-match "/" string)
- (concat (substring string (match-end 0))
- "*/" (substring string 0 (match-beginning 0)))
- (concat "*/" string))
- "*"))))))
-
-(defun vc-arch-revision-completion-table (files)
- (lambda (string pred action)
- ;; FIXME: complete revision patches as well.
- (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
- (table (vc-arch--version-completion-table root string)))
- (complete-with-action action table string pred))))
-
-;;; Trimming revision libraries.
-
-;; This code is not directly related to VC and there are many variants of
-;; this functionality available as scripts, but I like this version better,
-;; so maybe others will like it too.
-
-(defun vc-arch-trim-find-least-useful-rev (revs)
- (let* ((first (pop revs))
- (second (pop revs))
- (third (pop revs))
- ;; We try to give more importance to recent revisions. The idea is
- ;; that it's OK if checking out a revision 1000-patch-old is ten
- ;; times slower than checking out a revision 100-patch-old. But at
- ;; the same time a 2-patch-old rev isn't really ten times more
- ;; important than a 20-patch-old, so we use an arbitrary constant
- ;; "100" to reduce this effect for recent revisions. Making this
- ;; constant a float has the side effect of causing the subsequent
- ;; computations to be done as floats as well.
- (max (+ 100.0 (car (or (car (last revs)) third))))
- (cost (lambda () (/ (- (car third) (car first)) (- max (car second)))))
- (minrev second)
- (mincost (funcall cost)))
- (while revs
- (setq first second)
- (setq second third)
- (setq third (pop revs))
- (when (< (funcall cost) mincost)
- (setq minrev second)
- (setq mincost (funcall cost))))
- minrev))
-
-(defun vc-arch-trim-make-sentinel (revs)
- (if (null revs) (lambda (_proc _msg) (message "VC-Arch trimming ... done"))
- (lambda (_proc _msg)
- (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
- (rename-file (car revs) (concat (car revs) "*rm*"))
- (let ((proc (start-process "vc-arch-trim" nil
- "rm" "-rf" (concat (car revs) "*rm*"))))
- (set-process-sentinel proc (vc-arch-trim-make-sentinel (cdr revs)))))))
-
-(defun vc-arch-trim-one-revlib (dir)
- "Delete half of the revisions in the revision library."
- (interactive "Ddirectory: ")
- (let ((garbage (directory-files dir 'full "\\`,," 'nosort)))
- (when garbage
- (funcall (vc-arch-trim-make-sentinel garbage) nil nil)))
- (let ((revs
- (sort (delq nil
- (mapcar
- (lambda (f)
- (when (string-match "-\\([0-9]+\\)\\'" f)
- (cons (string-to-number (match-string 1 f)) f)))
- (directory-files dir nil nil 'nosort)))
- 'car-less-than-car))
- (subdirs nil))
- (when (cddr revs)
- (dotimes (_i (/ (length revs) 2))
- (let ((minrev (vc-arch-trim-find-least-useful-rev revs)))
- (setq revs (delq minrev revs))
- (push minrev subdirs)))
- (funcall (vc-arch-trim-make-sentinel
- (mapcar (lambda (x) (expand-file-name (cdr x) dir)) subdirs))
- nil nil))))
-
-(defun vc-arch-trim-revlib ()
- "Delete half of the revisions in the revision library."
- (interactive)
- (let ((rl-dir (with-output-to-string
- (call-process vc-arch-program nil standard-output nil
- "my-revision-library"))))
- (while (string-match "\\(.*\\)\n" rl-dir)
- (let ((dir (match-string 1 rl-dir)))
- (setq rl-dir
- (if (and (file-directory-p dir) (file-writable-p dir))
- dir
- (substring rl-dir (match-end 0))))))
- (unless (file-writable-p rl-dir)
- (error "No writable revlib directory found"))
- (message "Revlib at %s" rl-dir)
- (let* ((archives (directory-files rl-dir 'full "[^.]\\|..."))
- (categories
- (apply 'append
- (mapcar (lambda (dir)
- (when (file-directory-p dir)
- (directory-files dir 'full "[^.]\\|...")))
- archives)))
- (branches
- (apply 'append
- (mapcar (lambda (dir)
- (when (file-directory-p dir)
- (directory-files dir 'full "[^.]\\|...")))
- categories)))
- (versions
- (apply 'append
- (mapcar (lambda (dir)
- (when (file-directory-p dir)
- (directory-files dir 'full "--.*--")))
- branches))))
- (mapc 'vc-arch-trim-one-revlib versions))
- ))
-
-(defvar vc-arch-extra-menu-map
- (let ((map (make-sparse-keymap)))
- (define-key map [add-tagline]
- '(menu-item "Add tagline" vc-arch-add-tagline))
- map))
-
-(defun vc-arch-extra-menu () vc-arch-extra-menu-map)
-
-
-;;; Less obvious implementations.
-
-(defun vc-arch-find-revision (file rev buffer)
- (let ((out (make-temp-file "vc-out")))
- (unwind-protect
- (progn
- (with-temp-buffer
- (vc-arch-command (current-buffer) 1 nil "file-diffs" file rev)
- (call-process-region (point-min) (point-max)
- "patch" nil nil nil "-R" "-o" out file))
- (with-current-buffer buffer
- (insert-file-contents out)))
- (delete-file out))))
-
-(provide 'vc-arch)
-
-;;; vc-arch.el ends here
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 66c7ac4a349..de101649802 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -493,12 +493,7 @@ in the branch repository (or whose status not be determined)."
(add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
(message "There are unresolved conflicts in this file")))
-(defun vc-bzr-workfile-unchanged-p (file)
- (eq 'unchanged (car (vc-bzr-status file))))
-
(defun vc-bzr-working-revision (file)
- ;; Together with the code in vc-state-heuristic, this makes it possible
- ;; to get the initial VC state of a Bzr file even if Bzr is not installed.
(let* ((rootdir (vc-bzr-root file))
(branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
rootdir))
@@ -580,10 +575,6 @@ in the branch repository (or whose status not be determined)."
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional _file)
- "Always return nil, as Bzr cannot register explicit versions."
- nil)
-
(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
@@ -594,11 +585,8 @@ in the branch repository (or whose status not be determined)."
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev _comment)
- "Register FILES under bzr.
-Signal an error unless REV is nil.
-COMMENT is ignored."
- (if rev (error "Can't register explicit revision with bzr"))
+(defun vc-bzr-register (files &optional _comment)
+ "Register FILES under bzr. COMMENT is ignored."
(vc-bzr-command "add" nil 0 files))
;; Could run `bzr status' in the directory and see if it succeeds, but
@@ -608,18 +596,6 @@ COMMENT is ignored."
The criterion is that there is a `.bzr' directory in the same
or a superior directory.")
-(defun vc-bzr-could-register (file)
- "Return non-nil if FILE could be registered under bzr."
- (and (vc-bzr-responsible-p file) ; shortcut
- (condition-case ()
- (with-temp-buffer
- (vc-bzr-command "add" t 0 file "--dry-run")
- ;; The command succeeds with no output if file is
- ;; registered (in bzr 0.8).
- (goto-char (point-min))
- (looking-at "added "))
- (error))))
-
(defun vc-bzr-unregister (file)
"Unregister FILE from bzr."
(vc-bzr-command "remove" nil 0 file "--keep"))
@@ -634,10 +610,8 @@ or a superior directory.")
"" (replace-regexp-in-string
"\n[ \t]?" " " str)))))
-(defun vc-bzr-checkin (files rev comment)
- "Check FILES in to bzr with log message COMMENT.
-REV non-nil gets an error."
- (if rev (error "Can't check in a specific revision with bzr"))
+(defun vc-bzr-checkin (files comment)
+ "Check FILES in to bzr with log message COMMENT."
(apply 'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
@@ -657,7 +631,7 @@ REV non-nil gets an error."
(expand-file-name ".bzrignore"
(vc-bzr-root file)))
-(defun vc-bzr-checkout (_file &optional _editable rev)
+(defun vc-bzr-checkout (_file &optional rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
@@ -793,7 +767,7 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
+(defun vc-bzr-diff (files &optional rev1 rev2 buffer async)
"VC bzr backend for diff."
(let* ((switches (vc-switches 'bzr 'diff))
(args
@@ -809,7 +783,7 @@ If LIMIT is non-nil, show no more than this many entries."
(or rev2 "")))))))
;; `bzr diff' exits with code 1 if diff is non-empty.
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*")
- (if vc-disable-async-diff 1 'async) files
+ (if async 1 'async) files
args)))
@@ -993,9 +967,9 @@ stream. Standard error output is discarded."
(forward-line))
(funcall update-function result)))
-(defun vc-bzr-dir-status (dir update-function)
+(defun vc-bzr-dir-status-files (dir files update-function)
"Return a list of conses (file . state) for DIR."
- (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S")
+ (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
(vc-run-delayed
(vc-bzr-after-dir-status update-function
;; "bzr status" results are relative to
@@ -1007,13 +981,6 @@ stream. Standard error output is discarded."
;; frob the results accordingly.
(file-relative-name dir (vc-bzr-root dir)))))
-(defun vc-bzr-dir-status-files (dir files _default-state update-function)
- "Return a list of conses (file . state) for DIR."
- (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
- (vc-run-delayed
- (vc-bzr-after-dir-status update-function
- (file-relative-name dir (vc-bzr-root dir)))))
-
(defvar vc-bzr-shelve-map
(let ((map (make-sparse-keymap)))
;; Turn off vc-dir marking
@@ -1132,11 +1099,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)
@@ -1166,10 +1134,7 @@ stream. Standard error output is discarded."
"Create a stash with the current tree state."
(interactive)
(vc-bzr-command "shelve" nil 0 nil "--all" "-m"
- (let ((ct (current-time)))
- (concat
- (format-time-string "Snapshot on %Y-%m-%d" ct)
- (format-time-string " at %H:%M" ct))))
+ (format-time-string "Snapshot on %Y-%m-%d at %H:%M"))
(vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep")
(vc-resynch-buffer (vc-bzr-root default-directory) t t))
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index f7684a3b82c..c1d32cea605 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -48,9 +48,9 @@
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
- ;; (If vc-mistrust-permissions was t, we actually shouldn't
- ;; trust this, but there is no other way to learn this from
- ;; CVS at the moment (version 1.9).)
+ ;; (We actually shouldn't trust this, but there is
+ ;; no other way to learn this from CVS at the
+ ;; moment (version 1.9).)
(string-match "r-..-..-." (nth 8 attrib)))
'announce
'implicit))))))
@@ -110,7 +110,7 @@ This is only meaningful if you don't use the implicit checkout model
:version "21.1"
:group 'vc-cvs)
-(defcustom vc-cvs-stay-local 'only-file
+(defcustom vc-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
@@ -222,7 +222,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
(defun vc-cvs-state (file)
"CVS-specific version of `vc-state'."
- (if (vc-stay-local-p file 'CVS)
+ (if (vc-cvs-stay-local-p file)
(let ((state (vc-file-getprop file 'vc-state)))
;; If we should stay local, use the heuristic but only if
;; we don't have a more precise state already available.
@@ -282,7 +282,7 @@ committed and support display of sticky tags."
(autoload 'vc-switches "vc")
-(defun vc-cvs-register (files &optional _rev comment)
+(defun vc-cvs-register (files &optional comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
@@ -321,20 +321,38 @@ its parents."
(directory-file-name dir))))
(eq dir t)))
-(defun vc-cvs-checkin (files rev comment)
+;; vc-cvs-checkin used to take a 'rev' second argument that allowed
+;; checking in onto a specified branch tip rather than the current
+;; default branch, but nothing in the entire rest of VC exercised
+;; this code. Removing it simplifies the backend interface for all
+;; modes.
+;;
+;; Here's the setup code preserved in amber, in case the logic needs
+;; to be broken out into a method someday; (if rev (concat "-r" rev))
+;; used to be part of the switches passed to vc-cvs-command.
+;;
+;; (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
+;; (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
+;; (error "%s is not a valid symbolic tag name" rev)
+;; ;; If the input revision is a valid symbolic tag name, we create it
+;; ;; as a branch, commit and switch to it.
+;; (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
+;; (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
+;; (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
+;; files)))
+;;
+;; The following postamble cleaned up after the branch change:
+;;
+;; ;; if this was an explicit check-in (does not include creation of
+;; ;; a branch), remove the sticky tag.
+;; (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
+;; (vc-cvs-command nil 0 files "update" "-A"))))
+;; files)))
+;;
+(defun vc-cvs-checkin (files comment)
"CVS-specific version of `vc-backend-checkin'."
- (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
- (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
- (error "%s is not a valid symbolic tag name" rev)
- ;; If the input revision is a valid symbolic tag name, we create it
- ;; as a branch, commit and switch to it.
- (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
- (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
- (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
- files)))
(let ((status (apply 'vc-cvs-command nil 1 files
- "ci" (if rev (concat "-r" rev))
- (concat "-m" comment)
+ "ci" (concat "-m" comment)
(vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
@@ -365,12 +383,7 @@ its parents."
;; tell it from the permissions of the file (see
;; vc-cvs-checkout-model).
(mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
- files)
-
- ;; if this was an explicit check-in (does not include creation of
- ;; a branch), remove the sticky tag.
- (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
- (vc-cvs-command nil 0 files "update" "-A"))))
+ files)))
(defun vc-cvs-find-revision (file rev buffer)
(apply 'vc-cvs-command
@@ -382,9 +395,8 @@ its parents."
"-p"
(vc-switches 'CVS 'checkout)))
-(defun vc-cvs-checkout (file &optional editable rev)
+(defun vc-cvs-checkout (file &optional rev)
"Checkout a revision of FILE into the working area.
-EDITABLE non-nil means that the file should be writable.
REV is the revision to check out."
(message "Checking out %s..." file)
;; Change buffers to get local value of vc-checkout-switches.
@@ -392,7 +404,7 @@ REV is the revision to check out."
(if (and (file-exists-p file) (not rev))
;; If no revision was specified, just make the file writable
;; if necessary (using `cvs-edit' if requested).
- (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
+ (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
@@ -400,7 +412,7 @@ REV is the revision to check out."
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-cvs-command nil 0 file
- (and editable "-w")
+ "-w"
"update"
(when rev
(unless (eq rev t)
@@ -428,6 +440,35 @@ REV is the revision to check out."
;; Make the file read-only by switching off all w-bits
(set-file-modes file (logand (file-modes file) 3950)))))
+(defun vc-cvs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from branch or revision "
+ "(default news on current branch): ")
+ (list file)
+ 'CVS))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-cvs-merge-news file)))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second revision: "
+ (list file) 'CVS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-cvs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))
+ (setq status (vc-cvs-merge file first-revision second-revision))))
+ status))
+
(defun vc-cvs-merge (file first-revision &optional second-revision)
"Merge changes into current working copy of FILE.
The changes are between FIRST-REVISION and SECOND-REVISION."
@@ -515,7 +556,7 @@ Remaining arguments are ignored."
;; It's just the catenation of the individual logs.
(vc-cvs-command
buffer
- (if (vc-stay-local-p files 'CVS) 'async 0)
+ (if (vc-cvs-stay-local-p files) 'async 0)
files "log")
(with-current-buffer buffer
(vc-run-delayed (vc-rcs-print-log-cleanup)))
@@ -528,11 +569,10 @@ Remaining arguments are ignored."
(autoload 'vc-version-backup-file "vc")
(declare-function vc-coding-system-for-diff "vc" (file))
-(defun vc-cvs-diff (files &optional oldvers newvers buffer)
+(defun vc-cvs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using CVS between two revisions of FILE."
(let* (process-file-side-effects
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'CVS)))
+ (async (and async (vc-cvs-stay-local-p files)))
(invoke-cvs-diff-list nil)
status)
;; Look through the file list and see if any files have backups
@@ -584,7 +624,7 @@ Remaining arguments are ignored."
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
(vc-cvs-command buffer
- (if (vc-stay-local-p file 'CVS)
+ (if (vc-cvs-stay-local-p file)
'async 0)
file "annotate"
(if revision (concat "-r" revision)))
@@ -605,7 +645,7 @@ Optional arg REVISION is a revision to annotate from."
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+ (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-cvs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
@@ -721,7 +761,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
(defun vc-cvs-make-version-backups-p (file)
"Return non-nil if version backups should be made for FILE."
- (vc-stay-local-p file 'CVS))
+ (vc-cvs-stay-local-p file))
(defun vc-cvs-check-headers ()
"Check if the current file has any headers in it."
@@ -745,8 +785,34 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS."
(append vc-cvs-global-switches
flags))))
-(defun vc-cvs-stay-local-p (file) ;Back-compatibility.
- (vc-stay-local-p file 'CVS))
+(defun vc-cvs-stay-local-p (file)
+ "Return non-nil if VC should stay local when handling FILE.
+If FILE is a list of files, return non-nil if any of them
+individually should stay local."
+ (if (listp file)
+ (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file))
+ (let* ((sym (vc-make-backend-sym 'CVS 'stay-local))
+ (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
+ (if (symbolp stay-local) stay-local
+ (let ((dirname (if (file-directory-p file)
+ (directory-file-name file)
+ (file-name-directory file))))
+ (eq 'yes
+ (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
+ (vc-file-setprop
+ dirname 'vc-cvs-stay-local-p
+ (let ((hostname (vc-cvs-repository-hostname dirname)))
+ (if (not hostname)
+ 'no
+ (let ((default t))
+ (if (eq (car-safe stay-local) 'except)
+ (setq default nil stay-local (cdr stay-local)))
+ (when (consp stay-local)
+ (setq stay-local
+ (mapconcat 'identity stay-local "\\|")))
+ (if (if (string-match stay-local hostname)
+ default (not default))
+ 'yes 'no))))))))))))
(defun vc-cvs-repository-hostname (dirname)
"Hostname of the CVS server associated to workarea DIRNAME."
@@ -1003,13 +1069,14 @@ state."
(if basedir result
(funcall update-function result))))
-(defun vc-cvs-dir-status (dir update-function)
- "Create a list of conses (file . state) for DIR."
- ;; FIXME check all files in DIR instead?
- (let ((local (vc-stay-local-p dir 'CVS)))
- (if (and local (not (eq local 'only-file)))
+(defun vc-cvs-dir-status-files (dir files update-function)
+ "Create a list of conses (file . state) for FILES in DIR.
+Query all files in DIR if files is nil."
+ (let ((local (vc-cvs-stay-local-p dir)))
+ (if (and (not files) local (not (eq local 'only-file)))
(vc-cvs-dir-status-heuristic dir update-function)
- (vc-cvs-command (current-buffer) 'async dir "-f" "status")
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
+ (vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
;; Alternative implementation: use the "update" command instead of
;; the "status" command.
;; (vc-cvs-command (current-buffer) 'async
@@ -1018,12 +1085,6 @@ state."
(vc-run-delayed
(vc-cvs-after-dir-status update-function)))))
-(defun vc-cvs-dir-status-files (dir files _default-state update-function)
- "Create a list of conses (file . state) for DIR."
- (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
- (vc-run-delayed
- (vc-cvs-after-dir-status update-function)))
-
(defun vc-cvs-file-to-string (file)
"Read the content of FILE and return it as a string."
(condition-case nil
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 9b67d74c779..f107764f404 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -77,19 +77,17 @@ See `vc-checkout-model' for a list of possible values."
"Return the current workfile version of URL."
"Unknown")
-(defun vc-dav-register (url &optional rev comment)
+(defun vc-dav-register (url &optional _comment)
"Register URL in the DAV backend."
;; Do we need to do anything here? FIXME?
)
-(defun vc-dav-checkin (url rev comment)
- "Commit changes in URL to WebDAV.
-If REV is non-nil, that should become the new revision number.
-COMMENT is used as a check-in comment."
+(defun vc-dav-checkin (url comment)
+ "Commit changes in URL to WebDAV. COMMENT is used as a check-in comment."
;; This should PUT the resource and release any locks that we hold.
)
-(defun vc-dav-checkout (url &optional editable rev destfile)
+(defun vc-dav-checkout (url &optional rev destfile)
"Check out revision REV of URL into the working area.
If EDITABLE is non-nil URL should be writable by the user and if
@@ -119,7 +117,7 @@ only needs to update the status of URL within the backend.
"Insert the revision log of URL into the *vc* buffer."
)
-(defun vc-dav-diff (url &optional rev1 rev2)
+(defun vc-dav-diff (url &optional rev1 rev2 buffer async)
"Insert the diff for URL into the *vc-diff* buffer.
If REV1 and REV2 are non-nil report differences from REV1 to REV2.
If REV1 is nil, use the current workfile version as the older version.
@@ -135,10 +133,6 @@ It should return a status of either 0 (no differences found), or
;;; Optional functions
-;; Should be faster than vc-dav-state - but how?
-(defun vc-dav-state-heuristic (url)
- "Estimate the version control state of URL at visiting time."
- (vc-dav-state url))
;; This should use url-dav-get-properties with a depth of `1' to get
;; all the properties.
@@ -146,27 +140,13 @@ It should return a status of either 0 (no differences found), or
"find the version control state of all files in DIR in a fast way."
)
-(defun vc-dav-workfile-unchanged-p (url)
- "Return non-nil if URL is unchanged from its current workfile version."
- ;; Probably impossible with webdav
- )
-
(defun vc-dav-responsible-p (url)
"Return non-nil if DAV considers itself `responsible' for URL."
;; Check for DAV support on the web server.
t)
-(defun vc-dav-could-register (url)
- "Return non-nil if URL could be registered under this backend."
- ;; Check for DAV support on the web server.
- t)
-
;;; Unimplemented functions
;;
-;; vc-dav-latest-on-branch-p(URL)
-;; Return non-nil if the current workfile version of FILE is the
-;; latest on its branch. There are no branches in webdav yet.
-;;
;; vc-dav-mode-line-string(url)
;; Return a dav-specific mode line string for URL. Are there any
;; specific states that we want exposed?
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index be3b1fa94b5..c90bf1c2343 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -169,6 +169,9 @@ See `run-hooks'."
(define-key map [ise]
'(menu-item "Isearch Files..." vc-dir-isearch
:help "Incremental search a string in the marked files"))
+ (define-key map [display]
+ '(menu-item "Display in Other Window" vc-dir-display-file
+ :help "Display the file on the current line, in another window"))
(define-key map [open-other]
'(menu-item "Open in Other Window" vc-dir-find-file-other-window
:help "Find the file on the current line, in another window"))
@@ -273,6 +276,7 @@ See `run-hooks'."
(define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility
(define-key map "\C-m" 'vc-dir-find-file)
(define-key map "o" 'vc-dir-find-file-other-window)
+ (define-key map "\C-o" 'vc-dir-display-file)
(define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
(define-key map [down-mouse-3] 'vc-dir-menu)
(define-key map [mouse-2] 'vc-dir-toggle-mark)
@@ -755,6 +759,13 @@ that share the same state."
(if event (posn-set-point (event-end event)))
(find-file-other-window (vc-dir-current-file)))
+(defun vc-dir-display-file (&optional event)
+ "Display the file on the current line, in another window."
+ (interactive (list last-nonmenu-event))
+ (if event (posn-set-point (event-end event)))
+ (display-buffer (find-file-noselect (vc-dir-current-file))
+ t))
+
(defun vc-dir-isearch ()
"Search for a string through all marked buffers using Isearch."
(interactive)
@@ -1014,7 +1025,7 @@ specific headers."
(vc-call-backend backend 'dir-extra-headers dir)
"\n"))
-(defun vc-dir-refresh-files (files default-state)
+(defun vc-dir-refresh-files (files)
"Refresh some files in the *VC-dir* buffer."
(let ((def-dir default-directory)
(backend vc-dir-backend))
@@ -1032,7 +1043,7 @@ specific headers."
(setq default-directory def-dir)
(erase-buffer)
(vc-call-backend
- backend 'dir-status-files def-dir files default-state
+ backend 'dir-status-files def-dir files
(lambda (entries &optional more-to-come)
;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
;; If MORE-TO-COME is true, then more updates will come from
@@ -1097,7 +1108,7 @@ Throw an error if another update process is in progress."
(setq default-directory def-dir)
(erase-buffer)
(vc-call-backend
- backend 'dir-status def-dir
+ backend 'dir-status-files def-dir nil
(lambda (entries &optional more-to-come)
;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
;; If MORE-TO-COME is true, then more updates will come from
@@ -1110,8 +1121,7 @@ Throw an error if another update process is in progress."
vc-ewoc 'vc-dir-fileinfo->needs-update)))
(if remaining
(vc-dir-refresh-files
- (mapcar 'vc-dir-fileinfo->name remaining)
- 'up-to-date)
+ (mapcar 'vc-dir-fileinfo->name remaining))
(setq mode-line-process nil))))))))))))
(defun vc-dir-show-fileentry (file)
@@ -1125,18 +1135,18 @@ outside of VC) and one wants to do some operation on it."
"Hide items that are in STATE from display.
See `vc-state' for valid values of STATE.
-If STATE is nil, default it to up-to-date.
+If STATE is nil, hide both `up-to-date' and `ignored' items.
Interactively, if `current-prefix-arg' is non-nil, set STATE to
-state of item at point. Otherwise, set STATE to up-to-date."
+state of item at point, if any."
(interactive (list
(and current-prefix-arg
;; Command is prefixed. Infer STATE from point.
(let ((node (ewoc-locate vc-ewoc)))
(and node (vc-dir-fileinfo->state (ewoc-data node)))))))
- ;; If STATE is un-specified, use up-to-date.
- (setq state (or state 'up-to-date))
- (message "Hiding items in state \"%s\"" state)
+ (if state
+ (message "Hiding items in state \"%s\"" state)
+ (message "Hiding up-to-date and ignored items"))
(let ((crt (ewoc-nth vc-ewoc -1))
(first (ewoc-nth vc-ewoc 0)))
;; Go over from the last item to the first and remove the
@@ -1157,8 +1167,10 @@ state of item at point. Otherwise, set STATE to up-to-date."
;; Next item is a directory.
(vc-dir-fileinfo->directory (ewoc-data next))))
;; Remove files in specified STATE. STATE can be a
- ;; symbol or a user-name.
- (equal (vc-dir-fileinfo->state data) state))
+ ;; symbol, a user-name, or nil.
+ (if state
+ (equal (vc-dir-fileinfo->state data) state)
+ (memq (vc-dir-fileinfo->state data) '(up-to-date ignored))))
(ewoc-delete vc-ewoc crt))
(setq crt prev)))))
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 4fd9691d2a2..e1bf05c8916 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -429,7 +429,7 @@ If the current buffer is a Dired buffer, revert it."
;; even if the dispatcher client mode has messed with file contents (as in,
;; for example, VCS keyword expansion).
-(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win))
+(declare-function view-mode-exit "view" (&optional exit-only exit-action all-win))
(defun vc-position-context (posn)
"Save a bit of the text around POSN in the current buffer.
@@ -543,7 +543,7 @@ editing!"
(if (file-writable-p file)
(and view-mode
(let ((view-old-buffer-read-only nil))
- (view-mode-exit)))
+ (view-mode-exit t)))
(and (not view-mode)
(not (eq (get major-mode 'mode-class) 'special))
(view-mode-enter))))
@@ -702,7 +702,7 @@ the buffer contents as a comment."
;; Now make sure we see the expanded headers
(when log-fileset
(mapc
- (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+ (lambda (file) (vc-resynch-buffer file t t))
log-fileset))
(when (vc-dispatcher-browsing)
(vc-dir-move-to-goal-column))
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
new file mode 100644
index 00000000000..75ac2561e8b
--- /dev/null
+++ b/lisp/vc/vc-filewise.el
@@ -0,0 +1,84 @@
+;;; vc-filewise.el --- common functions for file-oriented back ends.
+
+;; Copyright (C) 1992-1996, 1998-2014 Free Software Foundation, Inc.
+
+;; Author: FSF (see vc.el for full credits)
+;; Maintainer: Andre Spiegel <spiegel@gnu.org>
+;; Package: vc
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Common functions for file-oriented back ends - SCCS, RCS, SRC, CVS
+;;
+;; The main purpose of this file is so none of this code has to live
+;; in the always-resident vc-hooks. A secondary purpose is to remove
+;; code specific to this class of back ends from vc.el.
+
+;;; Code:
+
+(eval-when-compile (require 'vc))
+
+(defun vc-master-name (file)
+ "Return the master name of FILE.
+If the file is not registered, or the master name is not known, return nil."
+ (or (vc-file-getprop file 'vc-name)
+ ;; force computation of the property by calling
+ ;; vc-BACKEND-registered explicitly
+ (let ((backend (vc-backend file)))
+ (if (and backend
+ (vc-filewise-registered backend file))
+ (vc-file-getprop file 'vc-name)))))
+
+(defun vc-rename-master (oldmaster newfile templates)
+ "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
+ (let* ((dir (file-name-directory (expand-file-name oldmaster)))
+ (newdir (or (file-name-directory newfile) ""))
+ (newbase (file-name-nondirectory newfile))
+ (masters
+ ;; List of potential master files for `newfile'
+ (mapcar
+ (lambda (s) (vc-possible-master s newdir newbase))
+ templates)))
+ (when (or (file-symlink-p oldmaster)
+ (file-symlink-p (file-name-directory oldmaster)))
+ (error "This is unsafe in the presence of symbolic links"))
+ (rename-file
+ oldmaster
+ (catch 'found
+ ;; If possible, keep the master file in the same directory.
+ (dolist (f masters)
+ (when (and f (string= (file-name-directory (expand-file-name f)) dir))
+ (throw 'found f)))
+ ;; If not, just use the first possible place.
+ (dolist (f masters)
+ (and f (or (not (setq dir (file-name-directory f)))
+ (file-directory-p dir))
+ (throw 'found f)))
+ (error "New file lacks a version control directory")))))
+
+(defun vc-filewise-registered (backend file)
+ "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
+ (let ((sym (vc-make-backend-sym backend 'master-templates)))
+ (unless (get backend 'vc-templates-grabbed)
+ (put backend 'vc-templates-grabbed t))
+ (let ((result (vc-check-master-templates file (symbol-value sym))))
+ (if (stringp result)
+ (vc-file-setprop file 'vc-name result)
+ nil)))) ; Not registered
+
+(provide 'vc-filewise)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 4c64d8374cb..1700bef10b0 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -50,32 +50,27 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
+;; - dir-status-files (dir files uf) OK
;; * working-revision (file) OK
-;; - latest-on-branch-p (file) NOT NEEDED
;; * checkout-model (files) OK
-;; - workfile-unchanged-p (file) OK
;; - mode-line-string (file) OK
;; STATE-CHANGING FUNCTIONS
;; * create-repo () OK
;; * register (files &optional rev comment) OK
-;; - init-revision (file) NOT NEEDED
;; - responsible-p (file) OK
-;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
;; - receive-file (file rev) NOT NEEDED
;; - unregister (file) OK
;; * checkin (files rev comment) OK
;; * find-revision (file rev buffer) OK
-;; * checkout (file &optional editable rev) OK
+;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
-;; - rollback (files) COULD BE SUPPORTED
-;; - merge (file rev1 rev2) It would be possible to merge
+;; - merge-file (file rev1 rev2) It would be possible to merge
;; changes into a single file, but
;; when committing they wouldn't
;; be identified as a merge
;; by git, so it's probably
;; not a good idea.
-;; - merge-news (file) see `merge'
+;; - merge-news (file) see `merge-file'
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -83,7 +78,7 @@
;; - show-log-entry (revision) OK
;; - comment-history (file) ??
;; - update-changelog (files) COULD BE SUPPORTED
-;; * diff (file &optional rev1 rev2 buffer) OK
+;; * diff (file &optional rev1 rev2 buffer async) OK
;; - revision-completion-table (files) OK
;; - annotate-command (file buf &optional rev) OK
;; - annotate-time () OK
@@ -94,14 +89,13 @@
;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
;; - make-version-backups-p (file) NOT NEEDED
-;; - repository-hostname (dirname) NOT NEEDED
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () COULD BE SUPPORTED
-;; - clear-headers () NOT NEEDED
;; - delete-file (file) OK
;; - rename-file (old new) OK
-;; - find-file-hook () NOT NEEDED
+;; - find-file-hook () OK
+;; - conflicted-files OK
;;; Code:
@@ -247,9 +241,6 @@ matching the resulting Git log output, and KEYWORDS is a list of
str)
(vc-git--rev-parse "HEAD"))))
-(defun vc-git-workfile-unchanged-p (file)
- (eq 'up-to-date (vc-git-state file)))
-
(defun vc-git-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file))
@@ -479,15 +470,11 @@ or an empty string if none."
(vc-run-delayed
(vc-git-after-dir-status-stage stage files update-function)))
-(defun vc-git-dir-status (_dir update-function)
+(defun vc-git-dir-status-files (_dir files update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
- (vc-git-dir-status-goto-stage 'update-index nil update-function))
-
-(defun vc-git-dir-status-files (_dir files _default-state update-function)
- "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
(defvar vc-git-stash-map
@@ -603,7 +590,7 @@ The car of the list is the current branch."
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional _rev _comment)
+(defun vc-git-register (files &optional _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
@@ -663,7 +650,7 @@ If toggling on, also insert its message into the buffer."
"Major mode for editing Git log messages.
It is based on `log-edit-mode', and has Git-specific extensions.")
-(defun vc-git-checkin (files _rev comment)
+(defun vc-git-checkin (files comment)
(let* ((file1 (or (car files) default-directory))
(root (vc-git-root file1))
(default-directory (expand-file-name root))
@@ -707,7 +694,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(expand-file-name ".gitignore"
(vc-git-root file)))
-(defun vc-git-checkout (file &optional _editable rev)
+(defun vc-git-checkout (file &optional rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
@@ -768,6 +755,47 @@ This prompts for a branch to merge from."
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
+(defun vc-git-conflicted-files (directory)
+ "Return the list of files with conflicts in DIRECTORY."
+ (let* ((status
+ (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (lines (when status (split-string status "\n" 'omit-nulls)))
+ files)
+ (dolist (line lines files)
+ (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?"
+ line)
+ (let ((state (match-string 1 line))
+ (file (match-string 2 line)))
+ ;; See git-status(1).
+ (when (member state '("AU" "UD" "UA" ;; "DD"
+ "DU" "AA" "UU"))
+ (push (expand-file-name file directory) files)))))))
+
+(defun vc-git-resolve-when-done ()
+ "Call \"git add\" if the conflict markers have been removed."
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward "^<<<<<<< " nil t)
+ (vc-git-command nil 0 buffer-file-name "add")
+ ;; Remove the hook so that it is not called multiple times.
+ (remove-hook 'after-save-hook 'vc-git-resolve-when-done t))))
+
+(defun vc-git-find-file-hook ()
+ "Activate `smerge-mode' if there is a conflict."
+ (when (and buffer-file-name
+ ;; FIXME
+ ;; 1) the net result is to call git twice per file.
+ ;; 2) v-g-c-f is documented to take a directory.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html
+ (vc-git-conflicted-files buffer-file-name)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^<<<<<<< " nil 'noerror)))
+ (vc-file-setprop buffer-file-name 'vc-state 'conflict)
+ (smerge-start-session)
+ (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local)
+ (message "There are unresolved conflicts in this file")))
+
;;; HISTORY FUNCTIONS
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -841,7 +869,7 @@ If LIMIT is non-nil, show no more than this many entries."
(if (not (eq vc-log-view-type 'long))
(cadr vc-git-root-log-format)
"^commit *\\([0-9a-z]+\\)"))
- ;; Allow expanding short log entries
+ ;; Allow expanding short log entries.
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
@@ -898,16 +926,73 @@ or BRANCH^ (where \"^\" can be repeated)."
(indent-region (point-min) (point-max) 2)
(buffer-string))))
+
+(defun vc-git-region-history (file buffer lfrom lto)
+ (vc-git-command buffer 'async nil "log" "-p" ;"--follow" ;FIXME: not supported?
+ (format "-L%d,%d:%s" lfrom lto (file-relative-name file))))
+
+(require 'diff-mode)
+
+(defvar vc-git-region-history-mode-map
+ (let ((map (make-composed-keymap
+ nil (make-composed-keymap
+ (list diff-mode-map vc-git-log-view-mode-map)))))
+ map))
+
+(defvar vc-git--log-view-long-font-lock-keywords nil)
+(defvar font-lock-keywords)
+(defvar vc-git-region-history-font-lock-keywords
+ `((vc-git-region-history-font-lock)))
+
+(defun vc-git-region-history-font-lock (limit)
+ (let ((in-diff (save-excursion
+ (beginning-of-line)
+ (or (looking-at "^\\(?:diff\\|commit\\)\\>")
+ (re-search-backward "^\\(?:diff\\|commit\\)\\>" nil t))
+ (eq ?d (char-after (match-beginning 0))))))
+ (while
+ (let ((end (save-excursion
+ (if (re-search-forward "\n\\(diff\\|commit\\)\\>"
+ limit t)
+ (match-beginning 1)
+ limit))))
+ (let ((font-lock-keywords (if in-diff diff-font-lock-keywords
+ vc-git--log-view-long-font-lock-keywords)))
+ (font-lock-fontify-keywords-region (point) end))
+ (goto-char end)
+ (prog1 (< (point) limit)
+ (setq in-diff (eq ?d (char-after))))))
+ nil))
+
+(define-derived-mode vc-git-region-history-mode
+ vc-git-log-view-mode "Git-Region-History"
+ "Major mode to browse Git's \"log -p\" output."
+ (setq-local vc-git--log-view-long-font-lock-keywords
+ log-view-font-lock-keywords)
+ (setq-local font-lock-defaults
+ (cons 'vc-git-region-history-font-lock-keywords
+ (cdr font-lock-defaults))))
+
+
(autoload 'vc-switches "vc")
-(defun vc-git-diff (files &optional rev1 rev2 buffer)
+(defun vc-git-diff (files &optional rev1 rev2 buffer async)
"Get a difference report using Git between two revisions of FILES."
(let (process-file-side-effects)
- (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
- (if (and rev1 rev2) "diff-tree" "diff-index")
- "--exit-code"
- (append (vc-switches 'git 'diff)
- (list "-p" (or rev1 "HEAD") rev2 "--")))))
+ (if vc-git-diff-switches
+ (apply #'vc-git-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ files
+ (if (and rev1 rev2) "diff-tree" "diff-index")
+ "--exit-code"
+ (append (vc-switches 'git 'diff)
+ (list "-p" (or rev1 "HEAD") rev2 "--")))
+ (vc-git-command (or buffer "*vc-diff*") 1 files
+ "difftool" "--exit-code" "--no-prompt" "-x"
+ (concat "diff "
+ (mapconcat 'identity
+ (vc-switches nil 'diff) " "))
+ (or rev1 "HEAD") rev2 "--"))))
(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c8b811feecc..e65009db2ef 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -43,29 +43,22 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
-;; - dir-status (dir update-function) OK
-;; - dir-status-files (dir files ds uf) OK
+;; - dir-status-files (dir files uf) OK
;; - dir-extra-headers (dir) OK
;; - dir-printer (fileinfo) OK
;; * working-revision (file) OK
-;; - latest-on-branch-p (file) ??
;; * checkout-model (files) OK
-;; - workfile-unchanged-p (file) OK
;; - mode-line-string (file) NOT NEEDED
;; STATE-CHANGING FUNCTIONS
;; * register (files &optional rev comment) OK
;; * create-repo () OK
-;; - init-revision () NOT NEEDED
;; - responsible-p (file) OK
-;; - could-register (file) OK
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
;; - unregister (file) OK
;; * checkin (files rev comment) OK
;; * find-revision (file rev buffer) OK
-;; * checkout (file &optional editable rev) OK
+;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
-;; - rollback (files) ?? PROBABLY NOT NEEDED
;; - merge (file rev1 rev2) NEEDED
;; - merge-news (file) NEEDED
;; - steal-lock (file &optional revision) NOT NEEDED
@@ -82,15 +75,13 @@
;; - 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) ??
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () ??
-;; - clear-headers () ??
;; - delete-file (file) TEST IT
;; - rename-file (old new) OK
;; - find-file-hook () added for bug#10709
@@ -195,6 +186,7 @@ highlighting the Log View buffer."
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
+ (setq file (expand-file-name file))
(let*
((status nil)
(default-directory (file-name-directory file))
@@ -211,34 +203,28 @@ highlighting the Log View buffer."
(append
(list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
process-environment)))
- (if (file-remote-p file)
- (process-file
- "env" nil t nil
- "HGPLAIN=1" vc-hg-program
- "--config" "alias.status=status"
- "--config" "defaults.status="
- "status" "-A" (file-relative-name file))
- (process-file
- vc-hg-program nil t nil
- "--config" "alias.status=status"
- "--config" "defaults.status="
- "status" "-A" (file-relative-name file))))
+ (process-file
+ vc-hg-program nil t nil
+ "--config" "alias.status=status"
+ "--config" "defaults.status="
+ "status" "-A" (file-relative-name file)))
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(error nil)))))))
- (when (eq 0 status)
- (when (null (string-match ".*: No such file or directory$" out))
- (let ((state (aref out 0)))
- (cond
- ((eq state ?=) 'up-to-date)
- ((eq state ?A) 'added)
- ((eq state ?M) 'edited)
- ((eq state ?I) 'ignored)
- ((eq state ?R) 'removed)
- ((eq state ?!) 'missing)
- ((eq state ??) 'unregistered)
- ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
- (t 'up-to-date)))))))
+ (when (and (eq 0 status)
+ (> (length out) 0)
+ (null (string-match ".*: No such file or directory$" out)))
+ (let ((state (aref out 0)))
+ (cond
+ ((eq state ?=) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
+ (t 'up-to-date))))))
(defun vc-hg-working-revision (file)
"Hg-specific version of `vc-working-revision'."
@@ -327,7 +313,7 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-hg-diff (files &optional oldvers newvers buffer)
+(defun vc-hg-diff (files &optional oldvers newvers buffer async)
"Get a difference report using hg between two revisions of FILES."
(let* ((firstfile (car files))
(working (and firstfile (vc-working-revision firstfile))))
@@ -335,7 +321,10 @@ If LIMIT is non-nil, show no more than this many entries."
(setq oldvers nil))
(when (and (not oldvers) newvers)
(setq oldvers working))
- (apply #'vc-hg-command (or buffer "*vc-diff*") nil files "diff"
+ (apply #'vc-hg-command
+ (or buffer "*vc-diff*")
+ (if async 'async nil)
+ files "diff"
(append
(vc-switches 'hg 'diff)
(when oldvers
@@ -396,8 +385,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))))
@@ -430,10 +437,8 @@ Optional arg REVISION is a revision to annotate from."
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional _rev _comment)
- "Register FILES under hg.
-REV is ignored.
-COMMENT is ignored."
+(defun vc-hg-register (files &optional _comment)
+ "Register FILES under hg. COMMENT is ignored."
(vc-hg-command nil 0 files "add"))
(defun vc-hg-create-repo ()
@@ -442,24 +447,13 @@ COMMENT is ignored."
(defalias 'vc-hg-responsible-p 'vc-hg-root)
-;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-could-register (file)
- "Return non-nil if FILE could be registered under hg."
- (and (vc-hg-responsible-p file) ; shortcut
- (condition-case ()
- (with-temp-buffer
- (vc-hg-command t nil file "add" "--dry-run"))
- ;; The command succeeds with no output if file is
- ;; registered.
- (error))))
-
(defun vc-hg-unregister (file)
"Unregister FILE from hg."
(vc-hg-command nil 0 file "forget"))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files _rev comment)
+(defun vc-hg-checkin (files comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
@@ -481,7 +475,7 @@ REV is ignored."
(vc-hg-root file)))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional _editable rev)
+(defun vc-hg-checkout (file &optional rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
@@ -522,10 +516,6 @@ REV is the revision to check out into WORKFILE."
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-workfile-unchanged-p (file)
- (eq 'up-to-date (vc-hg-state file)))
-
-;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-revert (file &optional contents-done)
(unless contents-done
(with-temp-buffer (vc-hg-command t 0 file "revert"))))
@@ -622,15 +612,12 @@ REV is the revision to check out into WORKFILE."
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
-(defun vc-hg-dir-status (dir update-function)
- (vc-hg-command (current-buffer) 'async dir "status" "-C")
- (vc-run-delayed
- (vc-hg-after-dir-status update-function)))
-
-(defun vc-hg-dir-status-files (dir files _default-state update-function)
- (apply 'vc-hg-command (current-buffer) 'async dir "status" "-mardui" "-C" files)
+(defun vc-hg-dir-status-files (dir files update-function)
+ (apply 'vc-hg-command (current-buffer) 'async dir "status"
+ (concat "-mardu" (if files "i"))
+ "-C" files)
(vc-run-delayed
- (vc-hg-after-dir-status update-function)))
+ (vc-hg-after-dir-status update-function)))
(defun vc-hg-dir-extra-header (name &rest commands)
(concat (propertize name 'face 'font-lock-type-face)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index fb10edca06d..5448f38f042 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -32,6 +32,69 @@
(eval-when-compile (require 'cl-lib))
+;; Faces
+
+(defgroup vc-state-faces nil
+ "Faces used in the mode line by the VC state indicator."
+ :group 'vc-faces
+ :group 'mode-line
+ :version "25.1")
+
+(defface vc-state-base-face
+ '((default))
+ "Base face for VC state indicator."
+ :group 'vc-faces
+ :group 'mode-line
+ :version "25.1")
+
+(defface vc-up-to-date-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is up to date."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-needs-update-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file needs update."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-locked-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file locked."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-locally-added-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is locally added."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-conflict-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file contains merge conflicts."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-removed-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file was removed from the VC system."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-missing-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is missing from the file system."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-edited-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is up to date."
+ :version "25.1"
+ :group 'vc-faces)
+
;; Customization Variables (the rest is in vc.el)
(defcustom vc-ignore-dir-regexp
@@ -44,8 +107,8 @@ interpreted as hostnames."
:type 'regexp
:group 'vc)
-(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
- ;; RCS, CVS, SVN and SCCS come first because they are per-dir
+(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn)
+ ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir
;; rather than per-tree. RCS comes first because of the multibackend
;; support intended to use RCS for local commits (with a remote CVS server).
"List of version control backends for which VC will be used.
@@ -55,13 +118,14 @@ Removing an entry from the list prevents VC from being activated
when visiting a file managed by that backend.
An empty list disables VC altogether."
:type '(repeat symbol)
- :version "23.1"
+ :version "25.1"
:group 'vc)
;; Note: we don't actually have a darcs back end yet.
-;; Also, Meta-CVS (corresponding to MCVS) is unsupported.
+;; Also, Meta-CVS (corresponding to MCVS) and Arch are unsupported.
+;; The Arch back end will be retrieved and fixed if it is ever required.
(defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS"
- ".svn" ".git" ".hg" ".bzr"
+ ".src" ".svn" ".git" ".hg" ".bzr"
"_MTN" "_darcs" "{arch}"))
"List of directory names to be ignored when walking directory trees."
:type '(repeat string)
@@ -100,87 +164,6 @@ Otherwise, not displayed."
:type 'boolean
:group 'vc)
-(defcustom vc-keep-workfiles t
- "Whether to keep work files on disk after commits, on a locking VCS.
-This variable has no effect on modern merging-based version
-control systems."
- :type 'boolean
- :group 'vc)
-
-;; If you fix bug#11490, probably you can set this back to nil.
-(defcustom vc-mistrust-permissions t
- "If non-nil, don't assume permissions/ownership track version-control status.
-If nil, do rely on the permissions.
-See also variable `vc-consult-headers'."
- :version "24.3" ; nil->t, bug#11490
- :type 'boolean
- :group 'vc)
-
-(defun vc-mistrust-permissions (file)
- "Internal access function to variable `vc-mistrust-permissions' for FILE."
- (or (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions
- (vc-backend-subdirectory-name file)))))
-
-(defcustom vc-stay-local 'only-file
- "Non-nil means use local operations when possible for remote repositories.
-This avoids slow queries over the network and instead uses heuristics
-and past information to determine the current status of a file.
-
-If value is the symbol `only-file', `vc-dir' will connect to the
-server, but heuristics will be used to determine the status for
-all other VC operations.
-
-The value can also be a regular expression or list of regular
-expressions to match against the host name of a repository; then VC
-only stays local for hosts that match it. Alternatively, the value
-can be a list of regular expressions where the first element is the
-symbol `except'; then VC always stays local except for hosts matched
-by these regular expressions."
- :type '(choice
- (const :tag "Always stay local" t)
- (const :tag "Only for file operations" only-file)
- (const :tag "Don't stay local" nil)
- (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
- (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
- (regexp :format " stay local,\n%t: %v" :tag "if it matches")
- (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "23.1"
- :group 'vc)
-
-(defun vc-stay-local-p (file &optional backend)
- "Return non-nil if VC should stay local when handling FILE.
-This uses the `repository-hostname' backend operation.
-If FILE is a list of files, return non-nil if any of them
-individually should stay local."
- (if (listp file)
- (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file))
- (setq backend (or backend (vc-backend file)))
- (let* ((sym (vc-make-backend-sym backend 'stay-local))
- (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
- (if (symbolp stay-local) stay-local
- (let ((dirname (if (file-directory-p file)
- (directory-file-name file)
- (file-name-directory file))))
- (eq 'yes
- (or (vc-file-getprop dirname 'vc-stay-local-p)
- (vc-file-setprop
- dirname 'vc-stay-local-p
- (let ((hostname (vc-call-backend
- backend 'repository-hostname dirname)))
- (if (not hostname)
- 'no
- (let ((default t))
- (if (eq (car-safe stay-local) 'except)
- (setq default nil stay-local (cdr stay-local)))
- (when (consp stay-local)
- (setq stay-local
- (mapconcat 'identity stay-local "\\|")))
- (if (if (string-match stay-local hostname)
- default (not default))
- 'yes 'no))))))))))))
-
;;; This is handled specially now.
;; Tell Emacs about this new kind of minor mode
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
@@ -190,6 +173,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 +256,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.
@@ -386,19 +374,6 @@ If the argument is a list, the files must all have the same back end."
"Return where the repository for the current directory is kept."
(symbol-name (vc-backend file)))
-(defun vc-name (file)
- "Return the master name of FILE.
-If the file is not registered, or the master name is not known, return nil."
- ;; TODO: This should ultimately become obsolete, at least up here
- ;; in vc-hooks.
- (or (vc-file-getprop file 'vc-name)
- ;; force computation of the property by calling
- ;; vc-BACKEND-registered explicitly
- (let ((backend (vc-backend file)))
- (if (and backend
- (vc-call-backend backend 'registered file))
- (vc-file-getprop file 'vc-name)))))
-
(defun vc-checkout-model (backend files)
"Indicate how FILES are checked out.
@@ -509,51 +484,12 @@ status of this file. Otherwise, the value returned is one of:
"Quickly recompute the `state' of FILE."
(vc-file-setprop
file 'vc-state
- (vc-call-backend backend 'state-heuristic file)))
+ (vc-call-backend backend 'state file)))
(defsubst vc-up-to-date-p (file)
"Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
(eq (vc-state file) 'up-to-date))
-(defun vc-default-state-heuristic (backend file)
- "Default implementation of vc-BACKEND-state-heuristic.
-It simply calls the real state computation function `vc-BACKEND-state'
-and does not employ any heuristic at all."
- (vc-call-backend backend 'state file))
-
-(defun vc-workfile-unchanged-p (file)
- "Return non-nil if FILE has not changed since the last checkout."
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- ;; This is a shortcut for determining when the workfile is
- ;; unchanged. It can fail under some circumstances; see the
- ;; discussion in bug#694.
- (if (and checkout-time
- ;; Tramp and Ange-FTP return this when they don't know the time.
- (not (equal lastmod '(0 0))))
- (equal checkout-time lastmod)
- (let ((unchanged (vc-call workfile-unchanged-p file)))
- (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
- unchanged))))
-
-(defun vc-default-workfile-unchanged-p (backend file)
- "Check if FILE is unchanged by diffing against the repository version.
-Return non-nil if FILE is unchanged."
- (zerop (condition-case err
- ;; If the implementation supports it, let the output
- ;; go to *vc*, not *vc-diff*, since this is an internal call.
- (vc-call-backend backend 'diff (list file) nil nil "*vc*")
- (wrong-number-of-arguments
- ;; If this error came from the above call to vc-BACKEND-diff,
- ;; try again without the optional buffer argument (for
- ;; backward compatibility). Otherwise, resignal.
- (if (or (not (eq (cadr err)
- (indirect-function
- (vc-find-backend-function backend 'diff))))
- (not (eq (cl-caddr err) 4)))
- (signal (car err) (cdr err))
- (vc-call-backend backend 'diff (list file)))))))
-
(defun vc-working-revision (file &optional backend)
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
@@ -579,9 +515,10 @@ If FILE is not registered, this function always returns nil."
(put backend 'vc-templates-grabbed t))
(let ((result (vc-check-master-templates file (symbol-value sym))))
(if (stringp result)
- (vc-file-setprop file 'vc-name result)
+ (vc-file-setprop file 'vc-master-name result)
nil)))) ; Not registered
+;;;###autoload
(defun vc-possible-master (s dirname basename)
(cond
((stringp s) (format s dirname basename))
@@ -795,33 +732,42 @@ This function assumes that the file is registered."
(let* ((backend-name (symbol-name backend))
(state (vc-state file backend))
(state-echo nil)
+ (face nil)
(rev (vc-working-revision file backend)))
(propertize
(cond ((or (eq state 'up-to-date)
(eq state 'needs-update))
(setq state-echo "Up to date file")
+ (setq face 'vc-up-to-date-state)
(concat backend-name "-" rev))
((stringp state)
(setq state-echo (concat "File locked by" state))
+ (setq face 'vc-locked-state)
(concat backend-name ":" state ":" rev))
((eq state 'added)
(setq state-echo "Locally added file")
+ (setq face 'vc-locally-added-state)
(concat backend-name "@" rev))
((eq state 'conflict)
(setq state-echo "File contains conflicts after the last merge")
+ (setq face 'vc-conflict-state)
(concat backend-name "!" rev))
((eq state 'removed)
(setq state-echo "File removed from the VC system")
+ (setq face 'vc-removed-state)
(concat backend-name "!" rev))
((eq state 'missing)
(setq state-echo "File tracked by the VC system, but missing from the file system")
+ (setq face 'vc-missing-state)
(concat backend-name "?" rev))
(t
;; Not just for the 'edited state, but also a fallback
;; for all other states. Think about different symbols
;; for 'needs-update and 'needs-merge.
(setq state-echo "Locally modified file")
+ (setq face 'vc-edited-state)
(concat backend-name ":" rev)))
+ 'face face
'help-echo (concat state-echo " under the " backend-name
" version control system"))))
@@ -922,7 +868,6 @@ current, and kill the buffer that visits the link."
(let ((map (make-sparse-keymap)))
(define-key map "a" 'vc-update-change-log)
(define-key map "b" 'vc-switch-backend)
- (define-key map "c" 'vc-rollback)
(define-key map "d" 'vc-dir)
(define-key map "g" 'vc-annotate)
(define-key map "G" 'vc-ignore)
@@ -941,6 +886,7 @@ current, and kill the buffer that visits the link."
(define-key map "=" 'vc-diff)
(define-key map "D" 'vc-root-diff)
(define-key map "~" 'vc-revision-other-window)
+ (define-key map "[delete]" 'vc-delete-file)
map))
(fset 'vc-prefix-map vc-prefix-map)
(define-key ctl-x-map "v" 'vc-prefix-map)
@@ -991,13 +937,6 @@ current, and kill the buffer that visits the link."
'(menu-item "Insert Header" vc-insert-headers
:help "Insert headers into a file for use with a version control system.
"))
- (bindings--define-key map [undo]
- '(menu-item "Undo Last Check-In" vc-rollback
- :enable (let ((backend (if buffer-file-name
- (vc-backend buffer-file-name))))
- (or (not backend)
- (vc-find-backend-function backend 'rollback)))
- :help "Remove the most recent changeset committed to the repository"))
(bindings--define-key map [vc-revert]
'(menu-item "Revert to Base Version" vc-revert
:help "Revert working copies of the selected file set to their repository contents"))
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index ea071c8586a..d1736a42a3d 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -79,7 +79,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-mtn-checkout-model (_files) 'implicit)
(defun vc-mtn-root (file)
- (setq file (if (file-directory-p file)
+ (setq file (expand-file-name file)
+ file (if (file-directory-p file)
(file-name-as-directory file)
(file-name-directory file)))
(or (vc-file-getprop file 'vc-mtn-root)
@@ -126,10 +127,11 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
((match-end 2) (push (list (match-string 3) 'added) result))))
(funcall update-function result)))
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
+;; dir-status-files called from vc-dir, which loads vc,
+;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-mtn-dir-status (dir update-function)
+(defun vc-mtn-dir-status-files (dir _files update-function)
(vc-mtn-command (current-buffer) 'async dir "status")
(vc-run-delayed
(vc-mtn-after-dir-status update-function)))
@@ -154,9 +156,6 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)")
(match-string 1))))
-(defun vc-mtn-workfile-unchanged-p (file)
- (not (eq (vc-mtn-state file) 'edited)))
-
;; Mode-line rewrite code copied from vc-arch.el.
(defcustom vc-mtn-mode-line-rewrite
@@ -179,15 +178,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(_ ?:))
branch)))
-(defun vc-mtn-register (files &optional _rev _comment)
+(defun vc-mtn-register (files &optional _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
-(defun vc-mtn-could-register (file) (vc-mtn-root file))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-mtn-checkin (files _rev comment)
+(defun vc-mtn-checkin (files comment)
(apply 'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
@@ -197,16 +195,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-mtn-find-revision (file rev buffer)
(vc-mtn-command buffer 0 file "cat" "-r" rev))
-;; (defun vc-mtn-checkout (file &optional editable rev)
+;; (defun vc-mtn-checkout (file &optional rev)
;; )
(defun vc-mtn-revert (file &optional contents-done)
(unless contents-done
(vc-mtn-command nil 0 file "revert")))
-;; (defun vc-mtn-rollback (files)
-;; )
-
(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
"Print commit logs associated with FILES into specified BUFFER.
_SHORTLOG is ignored.
@@ -241,9 +236,11 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-mtn-diff (files &optional rev1 rev2 buffer)
+(defun vc-mtn-diff (files &optional rev1 rev2 buffer async)
"Get a difference report using monotone between two revisions of FILES."
- (apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff"
+ (apply 'vc-mtn-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ files "diff"
(append
(vc-switches 'mtn 'diff)
(if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2)))))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 6b064260f95..cb3d36f13fb 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -149,70 +149,18 @@ For a description of possible values, see `vc-check-master-templates'."
'vc-working-revision))))
(if (not (eq state 'up-to-date))
state
- (if (vc-workfile-unchanged-p file)
+ (if (vc-rcs-workfile-unchanged-p file)
'up-to-date
(if (eq (vc-rcs-checkout-model (list file)) 'locking)
'unlocked-changes
'edited))))))
-(defun vc-rcs-state-heuristic (file)
- "State heuristic for RCS."
- (let (vc-rcs-headers-result)
- (if (and vc-consult-headers
- (setq vc-rcs-headers-result
- (vc-rcs-consult-headers file))
- (eq vc-rcs-headers-result 'rev-and-lock))
- (let ((state (vc-file-getprop file 'vc-state)))
- ;; If the headers say that the file is not locked, the
- ;; permissions can tell us whether locking is used for
- ;; the file or not.
- (if (and (eq state 'up-to-date)
- (not (vc-mistrust-permissions file))
- (file-exists-p file))
- (cond
- ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'implicit)
- (setq state
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking))))
- state)
- (if (not (vc-mistrust-permissions file))
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (cond ((and permissions (string-match ".r-..-..-." permissions))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- 'up-to-date)
- ((and permissions (string-match ".rw..-..-." permissions))
- (if (eq (vc-rcs-checkout-model file) 'locking)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- (t
- ;; Strange permissions. Fall through to
- ;; expensive state computation.
- (vc-rcs-state file))))
- (vc-rcs-state file)))))
-
(autoload 'vc-expand-dirs "vc")
-(defun vc-rcs-dir-status (dir update-function)
- ;; FIXME: this function should be rewritten or `vc-expand-dirs'
- ;; should be changed to take a backend parameter. Using
- ;; `vc-expand-dirs' is not TRTD because it returns files from
- ;; multiple backends. It should also return 'unregistered files.
-
- ;; Doing individual vc-state calls is painful but there
- ;; is no better way in RCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(defun vc-rcs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'RCS)
@@ -229,6 +177,8 @@ For a description of possible values, see `vc-check-master-templates'."
(vc-rcs-fetch-master-state file)
(vc-file-getprop file 'vc-working-revision))))
+(autoload 'vc-master-name "vc-filewise")
+
(defun vc-rcs-latest-on-branch-p (file &optional version)
"Return non-nil if workfile version of FILE is the latest on its branch.
When VERSION is given, perform check for that version."
@@ -238,15 +188,15 @@ When VERSION is given, perform check for that version."
(if (vc-rcs-trunk-p version)
(progn
;; Compare VERSION to the head version number.
- (vc-insert-file (vc-name file) "^[0-9]")
+ (vc-insert-file (vc-master-name file) "^[0-9]")
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
;; If we are not on the trunk, we need to examine the
;; whole current branch.
- (vc-insert-file (vc-name file) "^desc")
+ (vc-insert-file (vc-master-name file) "^desc")
(vc-rcs-find-most-recent-rev (vc-branch-part version))))))
(defun vc-rcs-workfile-unchanged-p (file)
- "RCS-specific implementation of `vc-workfile-unchanged-p'."
+ "Has FILE remained unchanged since last checkout?"
;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
;; do a double take and remember the fact for the future
(let* ((version (concat "-r" (vc-working-revision file)))
@@ -274,18 +224,13 @@ When VERSION is given, perform check for that version."
(autoload 'vc-switches "vc")
-(defun vc-rcs-register (files &optional rev comment)
+(defun vc-rcs-register (files &optional comment)
"Register FILES into the RCS version-control system.
-REV is the optional revision number for the files. COMMENT can be used
-to provide an initial description for each FILES.
+Automatically retrieve a read-only version of the file with keywords expanded.
+COMMENT can be used to provide an initial description for each FILES.
Passes either `vc-rcs-register-switches' or `vc-register-switches'
-to the RCS command.
-
-Automatically retrieve a read-only version of the file with keywords
-expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
+to the RCS command."
(let (subdir name)
- ;; When REV is specified, we need to force using "-t-".
- (when rev (unless comment (setq comment "")))
(dolist (file files)
(and (not (file-exists-p
(setq subdir (expand-file-name "RCS"
@@ -297,7 +242,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(apply #'vc-do-command "*vc*" 0 "ci" file
;; if available, use the secure registering option
(and (vc-rcs-release-p "5.6.4") "-i")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
+ "-u"
(and comment (concat "-t-" comment))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
@@ -309,9 +254,9 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(match-string 1))))
;; if we couldn't find the master name,
;; run vc-rcs-registered to get it
- ;; (will be stored into the vc-name property)
+ ;; (will be stored into the vc-master-name property)
(vc-rcs-registered file)
- (vc-file-setprop file 'vc-name
+ (vc-file-setprop file 'vc-master-name
(if (file-name-absolute-p name)
name
(expand-file-name
@@ -334,7 +279,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
(let ((checkout-model (vc-rcs-checkout-model (list file))))
- (vc-rcs-register file rev "")
+ (vc-rcs-register file "")
(when (eq checkout-model 'implicit)
(vc-rcs-set-non-strict-locking file))
(vc-rcs-set-default-branch file (concat rev ".1"))))
@@ -343,7 +288,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-name file))
+ (let* ((master (vc-master-name file))
(dir (file-name-directory master))
(backup-info (find-backup-file-name master)))
(if (not backup-info)
@@ -358,27 +303,31 @@ whether to remove it."
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir))))
-(defun vc-rcs-checkin (files rev comment)
+;; It used to be possible to pass in a value for the variable rev, but
+;; nothing in the rest of VC used this capability. Removing it makes the
+;; backend interface simpler for all modes.
+;;
+(defun vc-rcs-checkin (files comment)
"RCS-specific version of `vc-backend-checkin'."
- (let ((switches (vc-switches 'RCS 'checkin)))
+ (let (rev (switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
- (dolist (file (vc-expand-dirs files))
+ (dolist (file (vc-expand-dirs files 'RCS))
(let ((old-version (vc-working-revision file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
- (and (not rev)
- default-branch
+ (and default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(setq switches (cons "-f" switches)))
- (if (and (not rev) old-version)
- (setq rev (vc-branch-part old-version)))
- (apply #'vc-do-command "*vc*" 0 "ci" (vc-name file)
+ (if old-version
+ (setq rev (vc-branch-part old-version))
+ (error "can't find current branch"))
+ (apply #'vc-do-command "*vc*" 0 "ci" (vc-master-name file)
;; if available, use the secure check-in option
(and (vc-rcs-release-p "5.6.4") "-j")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
+ (concat "-u" rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-working-revision nil)
@@ -407,21 +356,21 @@ whether to remove it."
(if (not (vc-rcs-release-p "5.6.2"))
;; exit status of 1 is also accepted.
;; It means that the lock was removed before.
- (vc-do-command "*vc*" 1 "rcs" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcs" (vc-master-name file)
(concat "-u" old-version)))))))))
(defun vc-rcs-find-revision (file rev buffer)
(apply #'vc-do-command
- (or buffer "*vc*") 0 "co" (vc-name file)
+ (or buffer "*vc*") 0 "co" (vc-master-name file)
"-q" ;; suppress diagnostic output
(concat "-p" rev)
(vc-switches 'RCS 'checkout)))
-(defun vc-rcs-checkout (file &optional editable rev)
+(defun vc-rcs-checkout (file &optional rev)
"Retrieve a copy of a saved version of FILE. If FILE is a directory,
attempt the checkout for all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-checkout (vc-expand-dirs (list file)))
+ (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -444,11 +393,11 @@ attempt the checkout for all registered files beneath it."
(vc-rcs-set-default-branch file nil))
;; now do the checkout
(apply #'vc-do-command
- "*vc*" 0 "co" (vc-name file)
+ "*vc*" 0 "co" (vc-master-name file)
;; If locking is not strict, force to overwrite
;; the writable workfile.
(if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
- (if editable "-l")
+ "-l"
(if (stringp rev)
;; a literal revision was specified
(concat "-r" rev)
@@ -483,56 +432,44 @@ attempt the checkout for all registered files beneath it."
new-version)))))
(message "Checking out %s...done" file))))))
-(defun vc-rcs-rollback (files)
- "Roll back, undoing the most recent checkins of FILES. Directories are
-expanded to all registered subfiles in them."
- (if (not files)
- (error "RCS backend doesn't support directory-level rollback"))
- (dolist (file (vc-expand-dirs files))
- (let* ((discard (vc-working-revision file))
- (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard)))
- (config (current-window-configuration))
- (done nil))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s." discard file)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-o" discard))
- ;; Check out the most recent remaining version. If it
- ;; fails, because the whole branch got deleted, do a
- ;; double-take and check out the version where the branch
- ;; started.
- (while (not done)
- (condition-case err
- (progn
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
- (concat "-u" previous))
- (setq done t))
- (error (set-buffer "*vc*")
- (goto-char (point-min))
- (if (search-forward "no side branches present for" nil t)
- (progn (setq previous (vc-branch-part previous))
- (vc-rcs-set-default-branch file previous)
- ;; vc-do-command popped up a window with
- ;; the error message. Get rid of it, by
- ;; restoring the old window configuration.
- (set-window-configuration config))
- ;; No, it was some other error: re-signal it.
- (signal (car err) (cdr err)))))))))
-
(defun vc-rcs-revert (file &optional _contents-done)
"Revert FILE to the version it was based on. If FILE is a directory,
revert all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
+ (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
+(defun vc-rcs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file " from branch or revision: ")
+ (list file)
+ 'RCS))
+ second-revision)
+ (cond
+ ((string= first-revision "")
+ (error "A starting RCS revision is required"))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second RCS revision: "
+ (list file) 'RCS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-rcs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))))
+ (vc-rcs-merge file first-revision second-revision)))
+
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
- (vc-do-command "*vc*" 1 "rcsmerge" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcsmerge" (vc-master-name file)
"-kk" ; ignore keyword conflicts
(concat "-r" first-version)
(if second-version (concat "-r" second-version))))
@@ -542,17 +479,32 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
If FILE is a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
- (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
+ (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev))))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev))
+ ;; Must clear any headers here because they wouldn't
+ ;; show that the file is locked now.
+ (let* ((filename (or file buffer-file-name))
+ (visited (find-buffer-visiting filename)))
+ (if visited
+ (let ((context (vc-buffer-context)))
+ ;; save-excursion may be able to relocate point and mark
+ ;; properly. If it fails, vc-restore-buffer-context
+ ;; will give it a second try.
+ (save-excursion
+ (vc-rcs-clear-headers))
+ (vc-restore-buffer-context context))
+ (set-buffer (find-file-noselect filename))
+ (vc-rcs-clear-headers)
+ (kill-buffer filename)))))
(defun vc-rcs-modify-change-comment (files rev comment)
"Modify the change comments change on FILES on a specified REV. If FILE is a
directory the operation is applied to all registered files beneath it."
- (dolist (file (vc-expand-dirs files))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file)
+ (dolist (file (vc-expand-dirs files 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file)
(concat "-m" rev ":" comment))))
@@ -578,16 +530,16 @@ Remaining arguments are ignored.
If FILE is a directory the operation is applied to all registered
files beneath it."
(vc-do-command (or buffer "*vc*") 0 "rlog"
- (mapcar 'vc-name (vc-expand-dirs files)))
+ (mapcar 'vc-master-name (vc-expand-dirs files 'RCS)))
(with-current-buffer (or buffer "*vc*")
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
-(defun vc-rcs-diff (files &optional oldvers newvers buffer)
+(defun vc-rcs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using RCS between two sets of files."
(apply #'vc-do-command (or buffer "*vc-diff*")
- 1 ;; Always go synchronous, the repo is local
- "rcsdiff" (vc-expand-dirs files)
+ (if async 'async 1)
+ "rcsdiff" (vc-expand-dirs files 'RCS)
(append (list "-q"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))
@@ -811,7 +763,7 @@ Optional arg REVISION is a revision to annotate from."
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+ (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-rcs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
@@ -841,7 +793,7 @@ systime, or nil if there is none. Also, reposition point."
(vc-file-tree-walk
dir
(lambda (f)
- (vc-do-command "*vc*" 0 "rcs" (vc-name f) (concat "-n" name ":")))))))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name f) (concat "-n" name ":")))))))
;;;
@@ -961,7 +913,7 @@ Uses `rcs2log' which only works for RCS and CVS."
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
(defun vc-rcs-clear-headers ()
- "Implementation of vc-clear-headers for RCS."
+ "Clear RCS header value parts."
(let ((case-fold-search nil))
(goto-char (point-min))
(while (re-search-forward
@@ -970,11 +922,11 @@ Uses `rcs2log' which only works for RCS and CVS."
nil t)
(replace-match "$\\1$"))))
-(autoload 'vc-rename-master "vc")
+(autoload 'vc-rename-master "vc-filewise")
(defun vc-rcs-rename-file (old new)
;; Just move the master file (using vc-rcs-master-templates).
- (vc-rename-master (vc-name old) new vc-rcs-master-templates))
+ (vc-rename-master (vc-master-name old) new vc-rcs-master-templates))
(defun vc-rcs-find-file-hook ()
;; If the file is locked by some other user, make
@@ -993,7 +945,7 @@ Uses `rcs2log' which only works for RCS and CVS."
This likely means that FILE has been changed with respect
to its master version."
(let ((file-time (nth 5 (file-attributes file)))
- (master-time (nth 5 (file-attributes (vc-name file)))))
+ (master-time (nth 5 (file-attributes (vc-master-name file)))))
(or (> (nth 0 file-time) (nth 0 master-time))
(and (= (nth 0 file-time) (nth 0 master-time))
(> (nth 1 file-time) (nth 1 master-time))))))
@@ -1020,10 +972,10 @@ This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
(with-temp-buffer
- (if (or (not (vc-insert-file (vc-name file) "^[0-9]"))
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
(progn (goto-char (point-min))
(not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-name file)))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
(let ((workfile-is-latest nil)
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
(vc-file-setprop file 'vc-rcs-default-branch default-branch)
@@ -1043,7 +995,7 @@ file."
default-branch)
(setq working-revision default-branch))
;; else, search for the head of the default branch
- (t (vc-insert-file (vc-name file) "^desc")
+ (t (vc-insert-file (vc-master-name file) "^desc")
(setq working-revision
(vc-rcs-find-most-recent-rev default-branch))
(setq workfile-is-latest t)))
@@ -1096,7 +1048,7 @@ Returns: nil if no headers were found
'rev-and-lock if revision and lock info was found"
(cond
((not (get-file-buffer file)) nil)
- ((let (status version locking-user)
+ ((let (status version)
(with-current-buffer (get-file-buffer file)
(save-excursion
(goto-char (point-min))
@@ -1122,11 +1074,11 @@ Returns: nil if no headers were found
(cond
;; unlocked revision
((looking-at "\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
;; revision is locked by some user
((looking-at "\\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
;; everything else: false
(nil)))
@@ -1144,39 +1096,19 @@ Returns: nil if no headers were found
(goto-char (point-min))
(if (re-search-forward (concat "\\$" "Locker:") nil t)
(cond ((looking-at " \\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
((looking-at " *\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
(t
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock)))
(setq status 'rev)))
;; else: nothing found
;; -------------------
(t nil))))
(if status (vc-file-setprop file 'vc-working-revision version))
- (and (eq status 'rev-and-lock)
- (vc-file-setprop file 'vc-state
- (cond
- ((eq locking-user 'none) 'up-to-date)
- ((string= locking-user (vc-user-login-name file))
- 'edited)
- (t locking-user)))
- ;; If the file has headers, we don't want to query the
- ;; master file, because that would eliminate all the
- ;; performance gain the headers brought us. We therefore
- ;; use a heuristic now to find out whether locking is used
- ;; for this file. If we trust the file permissions, and the
- ;; file is not locked, then if the file is read-only we
- ;; assume that locking is used for the file, otherwise
- ;; locking is not used.
- (not (vc-mistrust-permissions file))
- (vc-up-to-date-p file)
- (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- (vc-file-setprop file 'vc-checkout-model 'implicit)))
status))))
(defun vc-release-greater-or-equal (r1 r2)
@@ -1234,7 +1166,7 @@ variable `vc-rcs-release' is set to the returned value."
(set-file-modes file (logior (file-modes file) 128)))
(defun vc-rcs-set-default-branch (file branch)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-b" branch))
(vc-file-setprop file 'vc-rcs-default-branch branch))
(defun vc-rcs-parse (&optional buffer)
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index fb7d9596822..cfd3cccf9b1 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -124,7 +124,7 @@ For a description of possible values, see `vc-check-master-templates'."
(working-revision (vc-working-revision file))
(locking-user (cdr (assoc working-revision locks))))
(if (not locking-user)
- (if (vc-workfile-unchanged-p file)
+ (if (vc-sccs-workfile-unchanged-p file)
'up-to-date
'unlocked-changes)
(if (string= locking-user (vc-user-login-name file))
@@ -132,41 +132,12 @@ For a description of possible values, see `vc-check-master-templates'."
locking-user)))
'up-to-date))))
-(defun vc-sccs-state-heuristic (file)
- "SCCS-specific state heuristic."
- (if (not (vc-mistrust-permissions file))
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore the
- ;; group-read and other-read bits, since paranoid users turn them off.
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (if (string-match ".r-..-..-." permissions)
- 'up-to-date
- (if (string-match ".rw..-..-." permissions)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- ;; Strange permissions.
- ;; Fall through to real state computation.
- (vc-sccs-state file))))
- (vc-sccs-state file)))
-
(autoload 'vc-expand-dirs "vc")
-(defun vc-sccs-dir-status (dir update-function)
- ;; FIXME: this function should be rewritten, using `vc-expand-dirs'
- ;; is not TRTD because it returns files from multiple backends.
- ;; It should also return 'unregistered files.
-
- ;; Doing lots of individual VC-state calls is painful, but
- ;; there is no better option in SCCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(defun vc-sccs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'SCCS)
@@ -174,6 +145,8 @@ For a description of possible values, see `vc-check-master-templates'."
(push (list frel state) result))))
(funcall update-function result)))
+(autoload 'vc-master-name "vc-filewise")
+
(defun vc-sccs-working-revision (file)
"SCCS-specific version of `vc-working-revision'."
(with-temp-buffer
@@ -181,7 +154,7 @@ For a description of possible values, see `vc-check-master-templates'."
;; To find this number, search the entire delta table,
;; rather than just the first entry, because the
;; first entry might be a deleted ("R") revision.
- (vc-insert-file (vc-name file) "^\001e\n\001[^s]")
+ (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]")
(vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
;; Cf vc-sccs-find-revision.
@@ -189,13 +162,13 @@ For a description of possible values, see `vc-check-master-templates'."
"Write the SCCS version of input file FILE to output file OUTFILE.
Optional string REV is a revision."
(with-temp-buffer
- (apply 'vc-sccs-do-command t 0 "get" (vc-name file)
+ (apply 'vc-sccs-do-command t 0 "get" (vc-master-name file)
(append '("-s" "-p" "-k") ; -k: no keyword expansion
(if rev (list (concat "-r" rev)))))
(write-region nil nil outfile nil 'silent)))
(defun vc-sccs-workfile-unchanged-p (file)
- "SCCS-specific implementation of `vc-workfile-unchanged-p'."
+ "Has FILE remained unchanged since last checkout?"
(let ((tempfile (make-temp-file "vc-sccs")))
(unwind-protect
(progn
@@ -220,31 +193,26 @@ Optional string REV is a revision."
(autoload 'vc-switches "vc")
-(defun vc-sccs-register (files &optional rev comment)
+(defun vc-sccs-register (files &optional comment)
"Register FILES into the SCCS version-control system.
-REV is the optional revision number for the file. COMMENT can be used
-to provide an initial description of FILES.
+Automatically retrieve a read-only version of the files with keywords expanded.
+COMMENT can be used to provide an initial description of FILES.
Passes either `vc-sccs-register-switches' or `vc-register-switches'
-to the SCCS command.
-
-Automatically retrieve a read-only version of the files with keywords
-expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
+to the SCCS command."
(dolist (file files)
(let* ((dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file))
(project-file (vc-sccs-search-project-dir dirname basename)))
- (let ((vc-name
+ (let ((vc-master-name
(or project-file
(format (car vc-sccs-master-templates) dirname basename))))
- (apply 'vc-sccs-do-command nil 0 "admin" vc-name
- (and rev (not (string= rev "")) (concat "-r" rev))
+ (apply 'vc-sccs-do-command nil 0 "admin" vc-master-name
"-fb"
(concat "-i" (file-relative-name file))
(and comment (concat "-y" comment))
(vc-switches 'SCCS 'register)))
(delete-file file)
- (if vc-keep-workfiles
- (vc-sccs-do-command nil 0 "get" (vc-name file))))))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file)))))
(defun vc-sccs-responsible-p (file)
"Return non-nil if SCCS thinks it would be responsible for registering FILE."
@@ -253,19 +221,17 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
(file-name-nondirectory file)))))
-(defun vc-sccs-checkin (files rev comment)
+(defun vc-sccs-checkin (files comment)
"SCCS-specific version of `vc-backend-checkin'."
- (dolist (file (vc-expand-dirs files))
- (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file)
- (if rev (concat "-r" rev))
+ (dolist (file (vc-expand-dirs files 'SCCS))
+ (apply 'vc-sccs-do-command nil 0 "delta" (vc-master-name file)
(concat "-y" comment)
(vc-switches 'SCCS 'checkin))
- (if vc-keep-workfiles
- (vc-sccs-do-command nil 0 "get" (vc-name file)))))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file))))
(defun vc-sccs-find-revision (file rev buffer)
(apply 'vc-sccs-do-command
- buffer 0 "get" (vc-name file)
+ buffer 0 "get" (vc-master-name file)
"-s" ;; suppress diagnostic output
"-p"
(and rev
@@ -273,13 +239,13 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(vc-sccs-lookup-triple file rev)))
(vc-switches 'SCCS 'checkout)))
-(defun vc-sccs-checkout (file &optional editable rev)
+(defun vc-sccs-checkout (file &optional rev)
"Retrieve a copy of a saved revision of SCCS controlled FILE.
If FILE is a directory, all version-controlled files beneath are checked out.
EDITABLE non-nil means that the file should be writable and
locked. REV is the revision to check out."
(if (file-directory-p file)
- (mapc 'vc-sccs-checkout (vc-expand-dirs (list file)))
+ (mapc 'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -299,35 +265,19 @@ locked. REV is the revision to check out."
(and rev (or (string= rev "")
(not (stringp rev)))
(setq rev nil))
- (apply 'vc-sccs-do-command nil 0 "get" (vc-name file)
- (if editable "-e")
+ (apply 'vc-sccs-do-command nil 0 "get" (vc-master-name file)
+ "-e"
(and rev (concat "-r" (vc-sccs-lookup-triple file rev)))
switches))))
(message "Checking out %s...done" file))))
-(defun vc-sccs-rollback (files)
- "Roll back, undoing the most recent checkins of FILES. Directories
-are expanded to all version-controlled subfiles."
- (setq files (vc-expand-dirs files))
- (if (not files)
- (error "SCCS backend doesn't support directory-level rollback"))
- (dolist (file files)
- (let ((discard (vc-working-revision file)))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s..." discard file)
- (vc-sccs-do-command nil 0 "rmdel"
- (vc-name file) (concat "-r" discard))
- (vc-sccs-do-command nil 0 "get" (vc-name file) nil))))
-
(defun vc-sccs-revert (file &optional _contents-done)
"Revert FILE to the version it was based on. If FILE is a directory,
revert all subfiles."
(if (file-directory-p file)
- (mapc 'vc-sccs-revert (vc-expand-dirs (list file)))
- (vc-sccs-do-command nil 0 "unget" (vc-name file))
- (vc-sccs-do-command nil 0 "get" (vc-name file))
+ (mapc 'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS))
+ (vc-sccs-do-command nil 0 "unget" (vc-master-name file))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file))
;; Checking out explicit revisions is not supported under SCCS, yet.
;; We always "revert" to the latest revision; therefore
;; vc-working-revision is cleared here so that it gets recomputed.
@@ -336,16 +286,16 @@ revert all subfiles."
(defun vc-sccs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV."
(if (file-directory-p file)
- (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file)))
+ (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS))
(vc-sccs-do-command nil 0 "unget"
- (vc-name file) "-n" (if rev (concat "-r" rev)))
+ (vc-master-name file) "-n" (if rev (concat "-r" rev)))
(vc-sccs-do-command nil 0 "get"
- (vc-name file) "-g" (if rev (concat "-r" rev)))))
+ (vc-master-name file) "-g" (if rev (concat "-r" rev)))))
(defun vc-sccs-modify-change-comment (files rev comment)
"Modify (actually, append to) the change comments for FILES on a specified REV."
- (dolist (file (vc-expand-dirs files))
- (vc-sccs-do-command nil 0 "cdc" (vc-name file)
+ (dolist (file (vc-expand-dirs files 'SCCS))
+ (vc-sccs-do-command nil 0 "cdc" (vc-master-name file)
(concat "-y" comment) (concat "-r" rev))))
@@ -356,8 +306,8 @@ revert all subfiles."
(defun vc-sccs-print-log (files buffer &optional _shortlog _start-revision-ignored limit)
"Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored."
- (setq files (vc-expand-dirs files))
- (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))
+ (setq files (vc-expand-dirs files 'SCCS))
+ (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-master-name files))
(when limit 'limit-unsupported))
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -366,9 +316,9 @@ Remaining arguments are ignored."
(defvar w32-quote-process-args)
;; FIXME use sccsdiff if present?
-(defun vc-sccs-diff (files &optional oldvers newvers buffer)
+(defun vc-sccs-diff (files &optional oldvers newvers buffer _async)
"Get a difference report using SCCS between two filesets."
- (setq files (vc-expand-dirs files))
+ (setq files (vc-expand-dirs files 'SCCS))
(setq oldvers (vc-sccs-lookup-triple (car files) oldvers))
(setq newvers (vc-sccs-lookup-triple (car files) newvers))
(or buffer (setq buffer "*vc-diff*"))
@@ -472,16 +422,16 @@ Remaining arguments are ignored."
(goto-char (point-min))
(re-search-forward "%[A-Z]%" nil t)))
-(autoload 'vc-rename-master "vc")
+(autoload 'vc-rename-master "vc-filewise")
(defun vc-sccs-rename-file (old new)
;; Move the master file (using vc-rcs-master-templates).
- (vc-rename-master (vc-name old) new vc-sccs-master-templates)
+ (vc-rename-master (vc-master-name old) new vc-sccs-master-templates)
;; Update the tag file.
(with-current-buffer
(find-file-noselect
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name old))))
+ (file-name-directory (vc-master-name old))))
(goto-char (point-min))
;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
(while (re-search-forward (concat ":" (regexp-quote old) "$") nil t)
@@ -525,7 +475,7 @@ find any project directory."
(defun vc-sccs-lock-file (file)
"Generate lock file name corresponding to FILE."
- (let ((master (vc-name file)))
+ (let ((master (vc-master-name file)))
(and
master
(string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master)
@@ -547,7 +497,7 @@ The result is a list of the form ((REVISION . USER) (REVISION . USER) ...)."
(with-current-buffer
(find-file-noselect
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name file))))
+ (file-name-directory (vc-master-name file))))
(goto-char (point-max))
(insert name "\t:\t" file "\t" rev "\n")
(basic-save-buffer)
@@ -563,7 +513,7 @@ If NAME is nil or a revision number string it's just passed through."
(with-temp-buffer
(vc-insert-file
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name file))))
+ (file-name-directory (vc-master-name file))))
(vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
(provide 'vc-sccs)
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
new file mode 100644
index 00000000000..50c0a7ef1b0
--- /dev/null
+++ b/lisp/vc/vc-src.el
@@ -0,0 +1,313 @@
+;;; vc-src.el --- support for SRC version-control -*- lexical-binding:t -*-
+
+;; Copyright (C) 1992-2014 Free Software Foundation, Inc.
+
+;; Author: FSF (see vc.el for full credits)
+;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
+;; Package: vc
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See vc.el. SRC requires an underlying RCS version of 4.0 or greater.
+
+;; FUNCTION NAME STATUS
+;; BACKEND PROPERTIES
+;; * revision-granularity OK
+;; STATE-QUERYING FUNCTIONS
+;; * registered (file) OK
+;; * state (file) OK
+;; - dir-status-files (dir files uf) OK
+;; - dir-extra-headers (dir) NOT NEEDED
+;; - dir-printer (fileinfo) ??
+;; * working-revision (file) OK
+;; * checkout-model (files) OK
+;; - mode-line-string (file) NOT NEEDED
+;; STATE-CHANGING FUNCTIONS
+;; * register (files &optional rev comment) OK
+;; * create-repo () OK
+;; * responsible-p (file) OK
+;; - receive-file (file rev) NOT NEEDED
+;; - unregister (file) NOT NEEDED
+;; * checkin (files comment) OK
+;; * find-revision (file rev buffer) OK
+;; * checkout (file &optional rev) OK
+;; * revert (file &optional contents-done) OK
+;; - merge (file rev1 rev2) NOT NEEDED
+;; - merge-news (file) NOT NEEDED
+;; - steal-lock (file &optional revision) NOT NEEDED
+;; HISTORY FUNCTIONS
+;; * print-log (files buffer &optional shortlog start-revision limit) OK
+;; - log-view-mode () ??
+;; - show-log-entry (revision) NOT NEEDED
+;; - comment-history (file) NOT NEEDED
+;; - update-changelog (files) NOT NEEDED
+;; * diff (files &optional rev1 rev2 buffer) OK
+;; - revision-completion-table (files) ??
+;; - annotate-command (file buf &optional rev) ??
+;; - annotate-time () ??
+;; - annotate-current-time () NOT NEEDED
+;; - annotate-extract-revision-at-line () ??
+;; TAG SYSTEM
+;; - create-tag (dir name branchp) ??
+;; - retrieve-tag (dir name update) ??
+;; MISCELLANEOUS
+;; - make-version-backups-p (file) ??
+;; - previous-revision (file rev) ??
+;; - next-revision (file rev) ??
+;; - check-headers () ??
+;; - delete-file (file) ??
+;; * rename-file (old new) OK
+;; - find-file-hook () NOT NEEDED
+
+
+;;; Code:
+
+;;;
+;;; Customization options
+;;;
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'vc))
+
+(defgroup vc-src nil
+ "VC SRC backend."
+ :version "25.1"
+ :group 'vc)
+
+(defcustom vc-src-release nil
+ "The release number of your SRC installation, as a string.
+If nil, VC itself computes this value when it is first needed."
+ :type '(choice (const :tag "Auto" nil)
+ (string :tag "Specified")
+ (const :tag "Unknown" unknown))
+ :group 'vc-src)
+
+(defcustom vc-src-program "src"
+ "Name of the SRC executable (excluding any arguments)."
+ :type 'string
+ :group 'vc-src)
+
+(defcustom vc-src-diff-switches nil
+ "String or list of strings specifying switches for SRC diff under VC.
+If nil, use the value of `vc-diff-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-src)
+
+;; This needs to be autoloaded because vc-src-registered uses it (via
+;; vc-default-registered), and vc-hooks needs to be able to check
+;; for a registered backend without loading every backend.
+;;;###autoload
+(defcustom vc-src-master-templates
+ (purecopy '("%s.src/%s,v"))
+ "Where to look for SRC master files.
+For a description of possible values, see `vc-check-master-templates'."
+ :type '(choice (const :tag "Use standard SRC file names"
+ '("%s.src/%s,v"))
+ (repeat :tag "User-specified"
+ (choice string
+ function)))
+ :group 'vc-src)
+
+
+;;; Properties of the backend
+
+(defun vc-src-revision-granularity () 'file)
+(defun vc-src-checkout-model (_files) 'implicit)
+
+;;;
+;;; State-querying functions
+;;;
+
+;; The autoload cookie below places vc-src-registered directly into
+;; loaddefs.el, so that vc-src.el does not need to be loaded for
+;; every file that is visited.
+;;;###autoload
+(progn
+(defun vc-src-registered (f) (vc-default-registered 'src f)))
+
+(defun vc-src-state (file)
+ "SRC-specific version of `vc-state'."
+ (let*
+ ((status nil)
+ (default-directory (file-name-directory file))
+ (out
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (setq status
+ ;; Ignore all errors.
+ (condition-case nil
+ (process-file
+ vc-src-program nil t nil
+ "status" "-a" (file-relative-name file))
+ (error nil)))))))
+ (when (eq 0 status)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about A and L codes?
+ ((eq state ?.) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ (t 'up-to-date)))))))
+
+(autoload 'vc-expand-dirs "vc")
+
+(defun vc-src-dir-status-files (dir files update-function)
+ ;; FIXME: Use one src status -a call for this
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
+ (let ((state (vc-state file))
+ (frel (file-relative-name file)))
+ (when (and (eq (vc-backend file) 'SRC)
+ (not (eq state 'up-to-date)))
+ (push (list frel state) result))))
+ (funcall update-function result)))
+
+(defun vc-src-command (buffer file-or-list &rest flags)
+ "A wrapper around `vc-do-command' for use in vc-src.el.
+This function differs from vc-do-command in that it invokes `vc-src-program'."
+ (let (file-list)
+ (cond ((stringp file-or-list)
+ (setq file-list (list "--" file-or-list)))
+ (file-or-list
+ (setq file-list (cons "--" file-or-list))))
+ (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags)))
+
+(defun vc-src-working-revision (file)
+ "SRC-specific version of `vc-working-revision'."
+ (or (ignore-errors
+ (with-output-to-string
+ (vc-src-command standard-output file "list" "-f{1}" "@")))
+ "0"))
+
+;;;
+;;; State-changing functions
+;;;
+
+(defun vc-src-create-repo ()
+ "Create a new SRC repository."
+ ;; SRC is totally file-oriented, so all we have to do is make the directory.
+ (make-directory ".src"))
+
+(autoload 'vc-switches "vc")
+
+(defun vc-src-register (files &optional _comment)
+ "Register FILES under src. COMMENT is ignored."
+ (vc-src-command nil files "add"))
+
+(defun vc-src-responsible-p (file)
+ "Return non-nil if SRC thinks it would be responsible for registering FILE."
+ (file-directory-p (expand-file-name ".src"
+ (if (file-directory-p file)
+ file
+ (file-name-directory file)))))
+
+(defun vc-src-checkin (files comment)
+ "SRC-specific version of `vc-backend-checkin'.
+REV is ignored."
+ (vc-src-command nil files "commit" "-m" comment))
+
+(defun vc-src-find-revision (file rev buffer)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if rev
+ (vc-src-command buffer file "cat" rev)
+ (vc-src-command buffer file "cat"))))
+
+(defun vc-src-checkout (file &optional rev)
+ "Retrieve a revision of FILE.
+REV is the revision to check out into WORKFILE."
+ (if rev
+ (vc-src-command nil file "co" rev)
+ (vc-src-command nil file "co")))
+
+(defun vc-src-revert (file &optional _contents-done)
+ "Revert FILE to the version it was based on. If FILE is a directory,
+revert all registered files beneath it."
+ (if (file-directory-p file)
+ (mapc 'vc-src-revert (vc-expand-dirs (list file) 'SRC))
+ (vc-src-command nil file "co")))
+
+(defun vc-src-modify-change-comment (files rev comment)
+ "Modify the change comments change on FILES on a specified REV. If FILE is a
+directory the operation is applied to all registered files beneath it."
+ (dolist (file (vc-expand-dirs files 'SRC))
+ (vc-src-command nil file "amend" "-m" comment rev)))
+
+;; History functions
+
+(defcustom vc-src-log-switches nil
+ "String or list of strings specifying switches for src log under VC."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-src)
+
+(defun vc-src-print-log (files buffer &optional shortlog _start-revision limit)
+ "Print commit log associated with FILES into specified BUFFER.
+If SHORTLOG is non-nil, use the list method.
+If START-REVISION is non-nil, it is the newest revision to show.
+If LIMIT is non-nil, show no more than this many entries."
+ ;; FIXME: Implement the range restrictions.
+ ;; `vc-do-command' creates the buffer, but we need it before running
+ ;; the command.
+ (vc-setup-buffer buffer)
+ ;; If the buffer exists from a previous invocation it might be
+ ;; read-only.
+ (let ((inhibit-read-only t))
+ (with-current-buffer
+ buffer
+ (apply 'vc-src-command buffer files (if shortlog "list" "log")
+ (nconc
+ ;;(when start-revision (list (format "%s-1" start-revision)))
+ (when limit (list "-l" (format "%s" limit)))
+ vc-src-log-switches)))))
+
+(defun vc-src-diff (files &optional oldvers newvers buffer _async)
+ "Get a difference report using src between two revisions of FILES."
+ (let* ((firstfile (car files))
+ (working (and firstfile (vc-working-revision firstfile))))
+ (when (and (equal oldvers working) (not newvers))
+ (setq oldvers nil))
+ (when (and (not oldvers) newvers)
+ (setq oldvers working))
+ (apply #'vc-src-command (or buffer "*vc-diff*") files "diff"
+ (when oldvers
+ (if newvers
+ (list (concat oldvers "-" newvers))
+ (list oldvers))))))
+
+;; Miscellaneous
+
+(defun vc-src-rename-file (old new)
+ "Rename file from OLD to NEW using `src mv'."
+ (vc-src-command nil 0 new "mv" old))
+
+(provide 'vc-src)
+
+;;; vc-src.el ends here
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index c7568e456f5..5c87cab2d92 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -135,6 +135,7 @@ If you want to force an empty list of arguments, use t."
(defun vc-svn-registered (file)
"Check if FILE is SVN registered."
+ (setq file (expand-file-name file))
(when (vc-svn-root file)
(with-temp-buffer
(cd (file-name-directory file))
@@ -153,34 +154,14 @@ If you want to force an empty list of arguments, use t."
(let ((parsed (vc-svn-parse-status file)))
(and parsed (not (memq parsed '(ignored unregistered))))))))))
-(defun vc-svn-state (file &optional localp)
+(defun vc-svn-state (file)
"SVN-specific version of `vc-state'."
(let (process-file-side-effects)
- (setq localp (or localp (vc-stay-local-p file 'SVN)))
(with-temp-buffer
(cd (file-name-directory file))
- (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
+ (vc-svn-command t 0 file "status" "-v")
(vc-svn-parse-status file))))
-;; NB this does not handle svn properties, which can be changed
-;; without changing the file timestamp.
-;; Note that unlike vc-cvs-state-heuristic, this is not called from
-;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via
-;; vc-after-save (bug#7850). Therefore the fact that it ignores
-;; properties is irrelevant. If you want to make vc-svn-state call
-;; this, it should be extended to handle svn properties.
-(defun vc-svn-state-heuristic (file)
- "SVN-specific state heuristic."
- ;; If the file has not changed since checkout, consider it `up-to-date'.
- ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic.
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- (cond
- ((equal checkout-time lastmod) 'up-to-date)
- ((string= (vc-working-revision file) "0") 'added)
- ((null checkout-time) 'unregistered)
- (t 'edited))))
-
;; FIXME it would be better not to have the "remote" argument,
;; but to distinguish the two output formats based on content.
(defun vc-svn-after-dir-status (callback &optional remote)
@@ -215,29 +196,19 @@ If you want to force an empty list of arguments, use t."
(setq result (cons (list filename state) result)))))
(funcall callback result)))
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
+;; dir-status-files called from vc-dir, which loads vc,
+;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-svn-dir-status (dir callback)
+(autoload 'vc-expand-dirs "vc")
+
+(defun vc-svn-dir-status-files (_dir files callback)
"Run 'svn status' for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
- ;; FIXME should this rather be all the files in dir?
- ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up
- ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR
- ;; which is VERY SLOW for big trees and it makes emacs
- ;; completely unresponsive during that time.
- (let* ((local (and nil (vc-stay-local-p dir 'SVN)))
- (remote (or t (not local) (eq local 'only-file))))
- (vc-svn-command (current-buffer) 'async nil "status"
- (if remote "-u"))
- (vc-run-delayed
- (vc-svn-after-dir-status callback remote))))
-
-(defun vc-svn-dir-status-files (_dir files _default-state callback)
- (apply 'vc-svn-command (current-buffer) 'async nil "status" files)
- (vc-run-delayed
- (vc-svn-after-dir-status callback)))
+ ;; FIXME shouldn't this rather default to all the files in dir?
+ (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files)
+ (vc-run-delayed (vc-svn-after-dir-status callback)))
(defun vc-svn-dir-extra-headers (_dir)
"Generate extra status headers for a Subversion working copy."
@@ -300,7 +271,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(autoload 'vc-switches "vc")
-(defun vc-svn-register (files &optional _rev _comment)
+(defun vc-svn-register (files &optional _comment)
"Register FILES into the SVN version-control system.
The COMMENT argument is ignored This does an add but not a commit.
Passes either `vc-svn-register-switches' or `vc-register-switches'
@@ -312,13 +283,8 @@ to the SVN command."
(defalias 'vc-svn-responsible-p 'vc-svn-root)
-(defalias 'vc-svn-could-register 'vc-svn-root
- "Return non-nil if FILE could be registered in SVN.
-This is only possible if SVN is responsible for FILE's directory.")
-
-(defun vc-svn-checkin (files rev comment &optional _extra-args-ignored)
+(defun vc-svn-checkin (files comment &optional _extra-args-ignored)
"SVN-specific version of `vc-backend-checkin'."
- (if rev (error "Committing to a specific revision is unsupported in SVN"))
(let ((status (apply
'vc-svn-command nil 1 files "ci"
(nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
@@ -376,14 +342,14 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY."
"Return the administrative directory of FILE."
(expand-file-name vc-svn-admin-directory (vc-svn-root file)))
-(defun vc-svn-checkout (file &optional editable rev)
+(defun vc-svn-checkout (file &optional rev)
(message "Checking out %s..." file)
(with-current-buffer (or (get-file-buffer file) (current-buffer))
- (vc-svn-update file editable rev (vc-switches 'SVN 'checkout)))
+ (vc-svn-update file rev (vc-switches 'SVN 'checkout)))
(vc-mode-line file 'SVN)
(message "Checking out %s...done" file))
-(defun vc-svn-update (file _editable rev switches)
+(defun vc-svn-update (file rev switches)
(if (and (file-exists-p file) (not rev))
;; If no revision was specified, there's nothing to do.
nil
@@ -408,6 +374,29 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY."
(unless contents-done
(vc-svn-command nil 0 file "revert")))
+(defun vc-svn-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from SVN revision "
+ "(default news on current branch): ")
+ (list file)
+ 'SVN))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-svn-merge-news file)))
+ (t
+ (setq second-revision
+ (vc-read-revision
+ "Second SVN revision: "
+ (list file) 'SVN nil
+ first-revision))
+ (setq status (vc-svn-merge file first-revision second-revision))))
+ status))
+
(defun vc-svn-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
@@ -540,7 +529,6 @@ If LIMIT is non-nil, show no more than this many entries."
'vc-svn-command
buffer
'async
- ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0)
(list file)
"log"
(append
@@ -560,7 +548,7 @@ If LIMIT is non-nil, show no more than this many entries."
(if start-revision (format "-r%s" start-revision) "-rHEAD:0"))
(when limit (list "--limit" (format "%s" limit)))))))))
-(defun vc-svn-diff (files &optional oldvers newvers buffer)
+(defun vc-svn-diff (files &optional oldvers newvers buffer async)
"Get a difference report using SVN between two revisions of fileset FILES."
(and oldvers
(not newvers)
@@ -575,14 +563,12 @@ If LIMIT is non-nil, show no more than this many entries."
;; has a different revision, we fetch the lot, which is
;; obviously sub-optimal.
(setq oldvers nil))
+ (setq async (and async (or oldvers newvers))) ; Svn diffs those locally.
(let* ((switches
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list (concat "--diff-cmd=" diff-command) "-x"
- (mapconcat 'identity (vc-switches nil 'diff) " "))))
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'SVN)
- (or oldvers newvers)))) ; Svn diffs those locally.
+ (mapconcat 'identity (vc-switches nil 'diff) " ")))))
(apply 'vc-svn-command buffer
(if async 'async 0)
files "diff"
@@ -624,7 +610,7 @@ NAME is assumed to be a URL."
;; Subversion makes backups for us, so don't bother.
;; (defun vc-svn-make-version-backups-p (file)
;; "Return non-nil if version backups should be made for FILE."
-;; (vc-stay-local-p file 'SVN))
+;; nil)
(defun vc-svn-check-headers ()
"Check if the current file has any headers in it."
@@ -647,17 +633,6 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches flags))))
-(defun vc-svn-repository-hostname (dirname)
- (with-temp-buffer
- (let (process-file-side-effects)
- (vc-svn-command t t dirname "info" "--xml"))
- (goto-char (point-min))
- (when (re-search-forward "<url>\\(.*\\)</url>" nil t)
- ;; This is not a hostname but a URL. This may actually be considered
- ;; as a feature since it allows vc-svn-stay-local to specify different
- ;; behavior for different modules on the same server.
- (match-string 1))))
-
(defun vc-svn-resolve-when-done ()
"Call \"svn resolved\" if the conflict markers have been removed."
(save-excursion
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 0f4d7893b5f..6283dc8d782 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1,4 +1,4 @@
-;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1992-1998, 2000-2014 Free Software Foundation, Inc.
@@ -46,15 +46,15 @@
;; If you maintain a client of the mode or customize it in your .emacs,
;; note that some backend functions which formerly took single file arguments
;; now take a list of files. These include: register, checkin, print-log,
-;; rollback, and diff.
+;; and diff.
;;; Commentary:
;; This mode is fully documented in the Emacs user's manual.
;;
-;; Supported version-control systems presently include CVS, RCS, GNU
-;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
-;; (or its free replacement, CSSC).
+;; Supported version-control systems presently include CVS, RCS, SRC,
+;; GNU Subversion, Bzr, Git, Mercurial, Monotone and SCCS (or its free
+;; replacement, CSSC).
;;
;; If your site uses the ChangeLog convention supported by Emacs, the
;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
@@ -72,7 +72,10 @@
;; When using Subversion or a later system, anything you do outside VC
;; *through the VCS tools* should safely interlock with VC
;; operations. Under these VC does little state caching, because local
-;; operations are assumed to be fast. The dividing line is
+;; operations are assumed to be fast.
+;;
+;; The 'assumed to be fast' category includes SRC, even though it's
+;; a wrapper around RCS.
;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
@@ -125,42 +128,33 @@
;; Return the current version control state of FILE. For a list of
;; possible values, see `vc-state'. This function should do a full and
;; reliable state computation; it is usually called immediately after
-;; C-x v v. If you want to use a faster heuristic when visiting a
-;; file, put that into `state-heuristic' below. Note that under most
-;; VCSes this won't be called at all, dir-status is used instead.
+;; C-x v v.
;;
-;; - state-heuristic (file)
+;; - dir-status-files (dir files update-function)
;;
-;; If provided, this function is used to estimate the version control
-;; state of FILE at visiting time. It should be considerably faster
-;; than the implementation of `state'. For a list of possible values,
-;; see the doc string of `vc-state'.
+;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
+;; for FILES in DIR. If FILES is nil, report on all files in DIR.
+;; (It is OK, though possibly inefficient, to ignore the FILES argument
+;; and always report on all files in DIR.)
;;
-;; - dir-status (dir update-function)
+;; If FILES is non-nil, this function should report on all requested
+;; files, including up-to-date or ignored files.
;;
-;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
-;; for the files in DIR.
;; EXTRA can be used for backend specific information about FILE.
;; If a command needs to be run to compute this list, it should be
;; run asynchronously using (current-buffer) as the buffer for the
-;; command. When RESULT is computed, it should be passed back by
-;; doing: (funcall UPDATE-FUNCTION RESULT nil).
-;; If the backend uses a process filter, hence it produces partial results,
-;; they can be passed back by doing:
-;; (funcall UPDATE-FUNCTION RESULT t)
-;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
-;; when all the results have been computed.
-;; To provide more backend specific functionality for `vc-dir'
-;; the following functions might be needed: `dir-extra-headers',
-;; `dir-printer', `extra-dir-menu' and `dir-status-files'.
+;; command.
;;
-;; - dir-status-files (dir files default-state update-function)
+;; When RESULT is computed, it should be passed back by doing:
+;; (funcall UPDATE-FUNCTION RESULT nil). If the backend uses a
+;; process filter, hence it produces partial results, they can be
+;; passed back by doing: (funcall UPDATE-FUNCTION RESULT t) and then
+;; do a (funcall UPDATE-FUNCTION RESULT nil) when all the results
+;; have been computed.
;;
-;; This function is identical to dir-status except that it should
-;; only report status for the specified FILES. Also it needs to
-;; report on all requested files, including up-to-date or ignored
-;; files. If not provided, the default is to consider that the files
-;; are in DEFAULT-STATE.
+;; To provide more backend specific functionality for `vc-dir'
+;; the following functions might be needed: `dir-extra-headers',
+;; `dir-printer', and `extra-dir-menu'.
;;
;; - dir-extra-headers (dir)
;;
@@ -185,29 +179,11 @@
;; head or tip revision. Should return "0" for a file added but not yet
;; committed.
;;
-;; - latest-on-branch-p (file)
-;;
-;; Return non-nil if the working revision of FILE is the latest revision
-;; on its branch (many VCSes call this the 'tip' or 'head' revision).
-;; The default implementation always returns t, which means that
-;; working with non-current revisions is not supported by default.
-;;
;; * checkout-model (files)
;;
;; Indicate whether FILES need to be "checked out" before they can be
;; edited. See `vc-checkout-model' for a list of possible values.
;;
-;; - workfile-unchanged-p (file)
-;;
-;; Return non-nil if FILE is unchanged from the working revision.
-;; This function should do a brief comparison of FILE's contents
-;; with those of the repository copy of the working revision. If
-;; the backend does not have such a brief-comparison feature, the
-;; default implementation of this function can be used, which
-;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff
-;; must not run asynchronously in this case, see variable
-;; `vc-disable-async-diff'.)
-;;
;; - mode-line-string (file)
;;
;; If provided, this function should return the VC-specific mode
@@ -225,21 +201,16 @@
;; it so VC mode can add files to it. For file-oriented systems, this
;; need do no more than create a subdirectory with the right name.
;;
-;; * register (files &optional rev comment)
+;; * register (files &optional comment)
;;
-;; Register FILES in this backend. Optionally, an initial revision REV
-;; and an initial description of the file, COMMENT, may be specified,
-;; but it is not guaranteed that the backend will do anything with this.
-;; The implementation should pass the value of vc-register-switches
-;; to the backend command. (Note: in older versions of VC, this
-;; command took a single file argument and not a list.)
-;; The REV argument is a historical leftover and is never used.
-;;
-;; - init-revision (file)
-;;
-;; The initial revision to use when registering FILE if one is not
-;; specified by the user. If not provided, the variable
-;; vc-default-init-revision is used instead.
+;; Register FILES in this backend. Optionally, an initial
+;; description of the file, COMMENT, may be specified, but it is not
+;; guaranteed that the backend will do anything with this. The
+;; implementation should pass the value of vc-register-switches to
+;; the backend command. (Note: in older versions of VC, this
+;; command had an optional revision first argument that was
+;; not used; in still older ones it took a single file argument and
+;; not a list.)
;;
;; - responsible-p (file)
;;
@@ -249,11 +220,6 @@
;; like change log generation. The default implementation always
;; returns nil.
;;
-;; - could-register (file)
-;;
-;; Return non-nil if FILE could be registered under this backend. The
-;; default implementation always returns t.
-;;
;; - receive-file (file rev)
;;
;; Let this backend "receive" a file that is already registered under
@@ -267,12 +233,12 @@
;; Unregister FILE from this backend. This is only needed if this
;; backend may be used as a "more local" backend for temporary editing.
;;
-;; * checkin (files rev comment)
+;; * checkin (files comment)
;;
-;; Commit changes in FILES to this backend. REV is a historical artifact
-;; and should be ignored. COMMENT is used as a check-in comment.
-;; The implementation should pass the value of vc-checkin-switches to
-;; the backend command.
+;; Commit changes in FILES to this backend. COMMENT is used as a
+;; check-in comment. The implementation should pass the value of
+;; vc-checkin-switches to the backend command. The revision argument
+;; of some older VC versions is no longer supported.
;;
;; * find-revision (file rev buffer)
;;
@@ -281,16 +247,17 @@
;; The implementation should pass the value of vc-checkout-switches
;; to the backend command.
;;
-;; * checkout (file &optional editable rev)
+;; * checkout (file &optional rev)
;;
-;; Check out revision REV of FILE into the working area. If EDITABLE
-;; is non-nil, FILE should be writable by the user and if locking is
-;; used for FILE, a lock should also be set. If REV is non-nil, that
-;; is the revision to check out (default is the working revision).
-;; If REV is t, that means to check out the head of the current branch;
-;; if it is the empty string, check out the head of the trunk.
-;; The implementation should pass the value of vc-checkout-switches
-;; to the backend command.
+;; Check out revision REV of FILE into the working area. FILE
+;; should be writable by the user and if locking is used for FILE, a
+;; lock should also be set. If REV is non-nil, that is the revision
+;; to check out (default is the working revision). If REV is t,
+;; that means to check out the head of the current branch; if it is
+;; the empty string, check out the head of the trunk. The
+;; implementation should pass the value of vc-checkout-switches to
+;; the backend command. The 'editable' argument of older VC versions
+;; is gone; all files are checked out editable.
;;
;; * revert (file &optional contents-done)
;;
@@ -301,19 +268,11 @@
;; If FILE is in the `added' state it should be returned to the
;; `unregistered' state.
;;
-;; - rollback (files)
+;; - merge-file (file rev1 rev2)
;;
-;; Remove the tip revision of each of FILES from the repository. If
-;; this function is not provided, trying to cancel a revision is
-;; caught as an error. (Most backends don't provide it.) (Also
-;; note that older versions of this backend command were called
-;; 'cancel-version' and took a single file arg, not a list of
-;; files.)
-;;
-;; - merge (file rev1 rev2)
-;;
-;; Merge the changes between REV1 and REV2 into the current working file
-;; (for non-distributed VCS).
+;; Merge the changes between REV1 and REV2 into the current working
+;; file (for non-distributed VCS). It is expected that with an
+;; empty first revision this will behave like the merge-news method.
;;
;; - merge-branch ()
;;
@@ -402,13 +361,14 @@
;; default implementation runs rcs2log, which handles RCS- and
;; CVS-style logs.
;;
-;; * diff (files &optional rev1 rev2 buffer)
+;; * diff (files &optional rev1 rev2 buffer async)
;;
;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if
-;; BUFFER is nil. If REV1 and REV2 are non-nil, report differences
-;; from REV1 to REV2. If REV1 is nil, use the working revision (as
-;; found in the repository) as the older revision; if REV2 is nil,
-;; use the current working-copy contents as the newer revision. This
+;; BUFFER is nil. If ASYNC is non-nil, run asynchronously. If REV1
+;; and REV2 are non-nil, report differences from REV1 to REV2. If
+;; REV1 is nil, use the working revision (as found in the
+;; repository) as the older revision; if REV2 is nil, use the
+;; current working-copy contents as the newer revision. This
;; function should pass the value of (vc-switches BACKEND 'diff) to
;; the backend command. It should return a status of either 0 (no
;; differences found), or 1 (either non-empty diff or the diff is
@@ -458,6 +418,15 @@
;; If the backend supports annotating through copies and renames,
;; and displays a file name and a revision, then return a cons
;; (REVISION . FILENAME).
+;;
+;; - region-history (FILE BUFFER LFROM LTO)
+;;
+;; Insert into BUFFER the history (log comments and diffs) of the content of
+;; FILE between lines LFROM and LTO. This is typically done asynchronously.
+;;
+;; - region-history-mode ()
+;;
+;; Major mode to use for the output of `region-history'.
;; TAG SYSTEM
;;
@@ -493,14 +462,6 @@
;;
;; Return the root of the VC controlled hierarchy for file.
;;
-;; - repository-hostname (dirname)
-;;
-;; Return the hostname that the backend will have to contact
-;; in order to operate on a file in DIRNAME. If the return value
-;; is nil, it means that the repository is local.
-;; This function is used in `vc-stay-local-p' which backends can use
-;; for their convenience.
-;;
;; - ignore (file &optional directory)
;;
;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
@@ -536,15 +497,6 @@
;;
;; Return non-nil if the current buffer contains any version headers.
;;
-;; - clear-headers ()
-;;
-;; In the current buffer, reset all version headers to their unexpanded
-;; form. This function should be provided if the state-querying code
-;; for this backend uses the version headers to determine the state of
-;; a file. This function will then be called whenever VC changes the
-;; version control state in such a way that the headers would give
-;; wrong information.
-;;
;; - delete-file (file)
;;
;; Delete FILE and mark it as deleted in the repository. If this
@@ -586,19 +538,82 @@
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
-;;; Todo:
+;;; Changes from the pre-25.1 API:
+;;
+;; - INCOMPATIBLE CHANGE: The 'editable' optional argument of
+;; vc-checkout is gone. The upper level assumes that all files are
+;; checked out editable. This moves closer to emulating modern
+;; non-locking behavior even on very old VCSes.
+;;
+;; - INCOMPATIBLE CHANGE: The vc-register function and its backend
+;; implementations no longer take a first optional revision
+;; argument, since on no system since RCS has setting the initial
+;; revision been even possible, let alone sane.
+;;
+;; INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did
+;; not take an async-mode flag as a fourth optional argument. (This
+;; change eliminated a particularly ugly global.)
+;;
+;; - INCOMPATIBLE CHANGE: The backend operation for non-distributed
+;; VCSes formerly called "merge" is now "merge-file" (to contrast
+;; with merge-branch), and does its own prompting for revisions.
+;; (This fixes a layer violation that produced bad behavior under
+;; SVN.)
+;;
+;; - INCOMPATIBLE CHANGE: The old fourth 'default-state' argument of
+;; vc-dir-status-files is gone; none of the back ends actually used it.
+;;
+;; - vc-dir-status is no longer a public method; it has been replaced
+;; by vc-dir-status-files.
+;;
+;; - vc-state-heuristic is no longer a public method (the CVS backend
+;; retains it as a private one).
+;;
+;; - the vc-mistrust-permissions configuration variable is gone; the
+;; code no longer relies on permissions except in one corner case where
+;; CVS leaves no alternative (which was not gated by this variable). The
+;; only affected back ends were SCCS and RCS.
+;;
+;; - vc-stay-local-p and repository-hostname are no longer part
+;; of the public API. The vc-stay-local configuration variable
+;; remains but only affects the CVS back end.
+;;
+;; - The init-revision function and the default-initial-revision
+;; variable are gone. These have't made sense on anything shipped
+;; since RCS, and using them was a dumb stunt even on RCS.
+;;
+;; - workfile-unchanged-p is no longer a public back-end method. It
+;; was redundant with vc-state and usually implemented with a trivial
+;; call to it. A few older back ends retain versions for internal use in
+;; their vc-state functions.
+;;
+;; - could-register is no longer a public method. Only vc-cvs ever used it
+;;
+;; The vc-keep-workfiles configuration variable is gone. Used only by
+;; the RCS and SCCS backends, it was an invitation to shoot self in foot
+;; when set to the (non-default) value nil. The original justification
+;; for it (saving disk space) is long obsolete.
+;;
+;; - The rollback method (implemented by RCS and SCCS only) is gone. See
+;; the to-do note on uncommit.
+;;
+;; - latest-on-branch-p is no longer a public method. It was to be used
+;; for implementing rollback. RCS keeps its implementation (the only one)
+;; for internal use.
-;; - Get rid of the "master file" terminology.
-;; - Add key-binding for vc-delete-file.
+;;; Todo:
;;;; New Primitives:
;;
-;; - deal with push/pull operations.
+;; - uncommit: undo last checkin, leave changes in place in the workfile,
+;; stash the commit comment for re-use.
+;;
+;; - deal with push operations.
;;
;;;; Primitives that need changing:
;;
-;; - vc-update/vc-merge should deal with VC systems that don't
+;; - vc-update/vc-merge should deal with VC systems that don't do
;; update/merge on a file basis, but on a whole repository basis.
;; vc-update and vc-merge assume the arguments are always files,
;; they don't deal with directories. Make sure the *vc-dir* buffer
@@ -607,27 +622,44 @@
;;
;;;; Improved branch and tag handling:
;;
+;; - Make sure the *vc-dir* buffer is updated after merge-branch operations.
+;;
;; - add a generic mechanism for remembering the current branch names,
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;;;; Internal cleanups:
+;; - Add a primitives for switching to a branch (creating it if required.
+;;
+;; - Add the ability to list tags and branches.
+;;
+;;;; Unify two different versions of the amend capability
;;
-;; - backends that care about vc-stay-local should try to take it into
-;; account for vc-dir. Is this likely to be useful??? YES!
+;; - Some back ends (SCCS/RCS/SVN/SRC), have an amend capability that can
+;; be invoked from log-view.
;;
-;; - vc-expand-dirs should take a backend parameter and only look for
-;; files managed by that backend.
+;; - The git backend supports amending, but in a different
+;; way (press `C-c C-e' in log-edit buffer, when making a new commit).
;;
-;; - Another important thing: merge all the status-like backend operations.
-;; We should remove dir-status, state, and dir-status-files, and
-;; replace them with just `status' which takes a fileset and a continuation
-;; (like dir-status) and returns a buffer in which the process(es) are run
-;; (or nil if it worked synchronously). Hopefully we can define the old
-;; 4 operations in term of this one.
+;; - Second, `log-view-modify-change-comment' doesn't seem to support
+;; modern backends at all because `log-view-extract-comment'
+;; unconditionally calls `log-view-current-file'. This should be easy to
+;; fix.
+;;
+;; - Third, doing message editing in log-view might be a natural way to go
+;; about it, but editing any but the last commit (and even it, if it's
+;; been pushed) is a dangerous operation in Git, which we shouldn't make
+;; too easy for users to perform.
+;;
+;; There should be a check that the given comment is not reachable
+;; from any of the "remote" refs?
;;
;;;; Other
;;
+;; - asynchronous checkin and commit, so you can keep working in other
+;; buffers while the repo operation happens.
+;;
+;; - Direct support for stash/shelve.
+;;
;; - when a file is in `conflict' state, turn on smerge-mode.
;;
;; - figure out what to do with conflicts that are not caused by the
@@ -673,6 +705,7 @@
(require 'vc-hooks)
(require 'vc-dispatcher)
+(require 'cl-lib)
(declare-function diff-setup-whitespace "diff-mode" ())
@@ -701,14 +734,6 @@
(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
-(defcustom vc-default-init-revision "1.1"
- "A string used as the default revision 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-checkin-switches nil
"A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
@@ -826,13 +851,6 @@ is sensitive to blank lines."
:group 'vc)
-;; Variables users don't need to see
-
-(defvar vc-disable-async-diff nil
- "VC sets this to t locally to disable some async diff operations.
-Backends that offer asynchronous diffs should respect this variable
-in their implementation of vc-BACKEND-diff.")
-
;; File property caching
(defun vc-clear-context ()
@@ -928,14 +946,14 @@ responsible for FILE is returned."
(throw 'found backend))))
(error "No VC backend is responsible for %s" file)))
-(defun vc-expand-dirs (file-or-dir-list)
+(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
Within directories, only files already under version control are noticed."
(let ((flattened '()))
(dolist (node file-or-dir-list)
(when (file-directory-p node)
(vc-file-tree-walk
- node (lambda (f) (when (vc-backend f) (push f flattened)))))
+ node (lambda (f) (when (eq (vc-backend f) backend) (push f flattened)))))
(unless (file-directory-p node) (push node flattened)))
(nreverse flattened)))
@@ -973,8 +991,8 @@ Otherwise, throw an error.
STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
part may be skipped.
-BEWARE: this function may change the
-current buffer."
+
+BEWARE: this function may change the current buffer."
;; FIXME: OBSERVER is unused. The name is not intuitive and is not
;; documented. It's set to t when called from diff and print-log.
(let (backend)
@@ -985,6 +1003,9 @@ current buffer."
(if observer
(vc-dired-deduce-fileset)
(error "State changing VC operations not supported in `dired-mode'")))
+ ((and (derived-mode-p 'log-view-mode)
+ (setq backend (vc-responsible-backend default-directory)))
+ (list backend default-directory))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1079,8 +1100,7 @@ For old-style locking-based version control systems, like RCS:
If every file is registered and unlocked, check out (lock)
the file(s) for editing.
If every file is locked by you and has changes, pop up a
- *vc-log* buffer to check in the changes. If the variable
- `vc-keep-workfiles' is non-nil (the default), leave a
+ *vc-log* buffer to check in the changes. Leave a
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
If every file is locked by someone else, offer to steal the lock."
@@ -1111,7 +1131,7 @@ For old-style locking-based version control systems, like RCS:
((eq state 'ignored)
(error "Fileset files are ignored by the version-control system"))
((or (null state) (eq state 'unregistered))
- (vc-register nil vc-fileset))
+ (vc-register vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
(cond
@@ -1128,10 +1148,10 @@ For old-style locking-based version control systems, like RCS:
(let ((vsym (intern-soft revision-downcase)))
(dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
- (vc-checkout file (eq model 'implicit) revision)))))
+ (vc-checkout file revision)))))
((not (eq model 'implicit))
;; check the files out
- (dolist (file files) (vc-checkout file t)))
+ (dolist (file files) (vc-checkout file)))
(t
;; do nothing
(message "Fileset is up-to-date"))))
@@ -1148,7 +1168,7 @@ For old-style locking-based version control systems, like RCS:
;; state of each individual file in the fileset, it seems
;; simplest to just check if the file exists. Bug#9781.
(when (and (file-exists-p file) (not (file-writable-p file)))
- ;; Make the file+buffer read-write.
+ ;; Make the file-buffer read-write.
(unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
(error "Aborted"))
;; Maybe we somehow lost permissions on the directory.
@@ -1166,7 +1186,7 @@ For old-style locking-based version control systems, like RCS:
;; For files with locking, if the file does not contain
;; any changes, just let go of the lock, i.e. revert.
(when (and (not (eq model 'implicit))
- (vc-workfile-unchanged-p file)
+ (eq state 'up-to-date)
;; If buffer is modified, that means the user just
;; said no to saving it; in that case, don't revert,
;; because the user might intend to save after
@@ -1217,10 +1237,10 @@ For old-style locking-based version control systems, like RCS:
(if (yes-or-no-p (format
"%s is not up-to-date. Get latest revision? "
(file-name-nondirectory file)))
- (vc-checkout file (eq model 'implicit) t)
+ (vc-checkout file t)
(when (and (not (eq model 'implicit))
(yes-or-no-p "Lock this revision? "))
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; needs-merge
((eq state 'needs-merge)
(dolist (file files)
@@ -1248,16 +1268,13 @@ For old-style locking-based version control systems, like RCS:
"Claim lock retaining changes? ")))
(progn (vc-call-backend backend 'steal-lock file)
(clear-visited-file-modtime)
- ;; Must clear any headers here because they wouldn't
- ;; show that the file is locked now.
- (vc-clear-headers file)
(write-file buffer-file-name)
(vc-mode-line file backend))
(if (not (yes-or-no-p
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
(vc-revert-buffer-internal t t)
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; Unknown fileset state
(t
(error "Fileset is in an unknown state %s" state)))))
@@ -1277,12 +1294,11 @@ For old-style locking-based version control systems, like RCS:
(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;;;###autoload
-(defun vc-register (&optional set-revision vc-fileset comment)
+(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
If VC-FILESET is given, register the files in that fileset.
Otherwise register the current file.
-With prefix argument SET-REVISION, allow user to specify initial revision
-level. If COMMENT is present, use that as an initial comment.
+If COMMENT is present, use that as an initial comment.
The version control system to use is found by cycling through the list
`vc-handled-backends'. The first backend in that list which declares
@@ -1314,11 +1330,7 @@ first backend that could register the file is used."
(vc-buffer-sync)))))
(message "Registering %s... " files)
(mapc 'vc-file-clearprops files)
- (vc-call-backend backend 'register files
- (if set-revision
- (read-string (format "Initial revision level for %s: " files))
- (vc-call-backend backend 'init-revision))
- comment)
+ (vc-call-backend backend 'register files comment)
(mapc
(lambda (file)
(vc-file-setprop file 'vc-backend backend)
@@ -1329,7 +1341,7 @@ first backend that could register the file is used."
;; (make-local-variable 'backup-inhibited)
;; (setq backup-inhibited t))
- (vc-resynch-buffer file vc-keep-workfiles t))
+ (vc-resynch-buffer file t t))
files)
(when (derived-mode-p 'vc-dir-mode)
(vc-dir-move-to-goal-column))
@@ -1416,32 +1428,28 @@ Argument BACKEND is the backend you are using."
(replace-match ""))
(write-region (point-min) (point-max) file)))
-(defun vc-checkout (file &optional writable rev)
+(defun vc-checkout (file &optional rev)
"Retrieve a copy of the revision REV of FILE.
-If WRITABLE is non-nil, make sure the retrieved file is writable.
REV defaults to the latest revision.
After check-out, runs the normal hook `vc-checkout-hook'."
- (and writable
- (not rev)
+ (and (not rev)
(vc-call make-version-backups-p file)
(vc-up-to-date-p file)
(vc-make-version-backup file))
(let ((backend (vc-backend file)))
(with-vc-properties (list file)
(condition-case err
- (vc-call-backend backend 'checkout file writable rev)
+ (vc-call-backend backend 'checkout file rev)
(file-error
;; Maybe the backend is not installed ;-(
- (when writable
+ (when t
(let ((buf (get-file-buffer file)))
(when buf (with-current-buffer buf (read-only-mode -1)))))
(signal (car err) (cdr err))))
`((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
- (not writable))
- (if (vc-call-backend backend 'latest-on-branch-p file)
- 'up-to-date
- 'needs-update)
+ nil)
+ 'up-to-date
'edited))
(vc-checkout-time . ,(nth 5 (file-attributes file))))))
(vc-resynch-buffer file t t)
@@ -1488,16 +1496,11 @@ Type \\[vc-next-action] to check in changes.")
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-checkin (files backend &optional rev comment initial-contents)
- "Check in FILES.
-The optional argument REV may be a string specifying the new revision
-level (strongly deprecated). COMMENT is a comment
-string; if omitted, a buffer is popped up to accept a comment. If
-INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
-of the log entry buffer.
-
-If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
-that the version control system supports this mode of operation.
+(defun vc-checkin (files backend &optional comment initial-contents)
+ "Check in FILES. COMMENT is a comment string; if omitted, a
+buffer is popped up to accept a comment. If INITIAL-CONTENTS is
+non-nil, then COMMENT is used as the initial contents of the log
+entry buffer.
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
@@ -1520,7 +1523,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
;; vc-checkin-switches, but 'the' local buffer is
;; not a well-defined concept for filesets.
(progn
- (vc-call-backend backend 'checkin files rev comment)
+ (vc-call-backend backend 'checkin files comment)
(mapc 'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
(vc-checkout-time . ,(nth 5 (file-attributes file)))
@@ -1684,11 +1687,10 @@ Return t if the buffer had changes, nil otherwise."
;; We regard this as "changed".
;; Diff it against /dev/null.
(apply 'vc-do-command buffer
- 1 "diff" file
+ (if async 'async 1) "diff" file
(append (vc-switches nil 'diff) '("/dev/null"))))))
(setq files (nreverse filtered))))
- (let ((vc-disable-async-diff (not async)))
- (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
+ (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
(diff-mode)
(set (make-local-variable 'diff-vc-backend) (car vc-fileset))
@@ -1879,6 +1881,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~'.
@@ -1959,25 +1974,6 @@ the variable `vc-BACKEND-header'."
(when (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))
- (visited (find-buffer-visiting filename))
- (backend (vc-backend filename)))
- (when (vc-find-backend-function backend 'clear-headers)
- (if visited
- (let ((context (vc-buffer-context)))
- ;; save-excursion may be able to relocate point and mark
- ;; properly. If it fails, vc-restore-buffer-context
- ;; will give it a second try.
- (save-excursion
- (vc-call-backend backend 'clear-headers))
- (vc-restore-buffer-context context))
- (set-buffer (find-file-noselect filename))
- (vc-call-backend backend 'clear-headers)
- (kill-buffer filename)))))
-
(defun vc-modify-change-comment (files rev oldcomment)
"Edit the comment associated with the given files and revision."
;; Less of a kluge than it looks like; log-view mode only passes
@@ -2020,42 +2016,17 @@ changes from the current branch."
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
- first-revision second-revision status)
+ status)
(cond
((stringp state) ;; Locking VCses only
(error "File %s is locked by %s" file state))
((not (vc-editable-p file))
(vc-checkout file t)))
- (setq first-revision
- (vc-read-revision
- (concat "Merge " file
- " from branch or revision "
- "(default news on current branch): ")
- (list file)
- backend))
- (cond
- ((string= first-revision "")
- (setq status (vc-call-backend backend 'merge-news file)))
- (t
- (if (not (vc-branch-p first-revision))
- (setq second-revision
- (vc-read-revision
- "Second revision: "
- (list file) backend nil
- ;; FIXME: This is CVS/RCS/SCCS specific.
- (concat (vc-branch-part first-revision) ".")))
- ;; We want to merge an entire branch. Set revisions
- ;; accordingly, so that vc-BACKEND-merge understands us.
- (setq second-revision first-revision)
- ;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))
- (setq status (vc-call-backend backend 'merge file
- first-revision second-revision))))
+ (setq status (vc-call-backend backend 'merge-file file))
(vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
(t
(error "Sorry, merging is not implemented for %s" backend)))))
-
(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
@@ -2080,8 +2051,9 @@ changes from the current branch."
(let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name))
(vc-responsible-backend default-directory)
(error "No VC backend")))
+ (root (vc-root-dir))
(files (vc-call-backend backend
- 'conflicted-files default-directory)))
+ 'conflicted-files (or root default-directory))))
;; Don't try and visit the current file.
(if (equal (car files) buffer-file-name) (pop files))
(if (null files)
@@ -2218,19 +2190,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
;; buffer can be accessed by the command.
- (let ((dir-present nil)
- (vc-short-log nil)
+ (let* ((dir-present (cl-some #'file-directory-p files))
+ (shortlog (not (null (memq (if dir-present 'directory 'file)
+ vc-log-short-style))))
(buffer-name "*vc-change-log*")
- type)
- (dolist (file files)
- (when (file-directory-p file)
- (setq dir-present t)))
- (setq vc-short-log
- (not (null (if dir-present
- (memq 'directory vc-log-short-style)
- (memq 'file vc-log-short-style)))))
- (setq type (if vc-short-log 'short 'long))
- (let ((shortlog vc-short-log))
+ (type (if shortlog 'short 'long)))
(vc-log-internal-common
backend buffer-name files type
(lambda (bk buf _type-arg files-arg)
@@ -2243,7 +2207,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(vc-call-backend bk 'show-log-entry working-revision))
(lambda (_ignore-auto _noconfirm)
(vc-print-log-internal backend files working-revision
- is-start-revision limit))))))
+ is-start-revision limit)))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
@@ -2262,15 +2226,18 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(with-current-buffer (get-buffer-create buffer-name)
(set (make-local-variable 'vc-log-view-type) type))
(setq retval (funcall backend-func backend buffer-name type files))
+ (with-current-buffer (get-buffer buffer-name)
+ (let ((inhibit-read-only t))
+ ;; log-view-mode used to be called with inhibit-read-only bound
+ ;; to t, so let's keep doing it, just in case.
+ (vc-call-backend backend 'log-view-mode)
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) files)
+ (set (make-local-variable 'revert-buffer-function)
+ rev-buff-func)))
+ ;; Display after setting up major-mode, so display-buffer-alist can know
+ ;; the major-mode.
(pop-to-buffer buffer-name)
- (let ((inhibit-read-only t))
- ;; log-view-mode used to be called with inhibit-read-only bound
- ;; to t, so let's keep doing it, just in case.
- (vc-call-backend backend 'log-view-mode)
- (set (make-local-variable 'log-view-vc-backend) backend)
- (set (make-local-variable 'log-view-vc-fileset) files)
- (set (make-local-variable 'revert-buffer-function)
- rev-buff-func))
(vc-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
@@ -2378,6 +2345,29 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
'log-outgoing)))
;;;###autoload
+(defun vc-region-history (from to)
+ "Show the history of the region FROM..TO."
+ (interactive "r")
+ (let* ((lfrom (line-number-at-pos from))
+ (lto (line-number-at-pos to))
+ (file buffer-file-name)
+ (backend (vc-backend file))
+ (buf (get-buffer-create "*VC-history*")))
+ (with-current-buffer buf
+ (setq-local vc-log-view-type 'long))
+ (vc-call region-history file buf lfrom lto)
+ (with-current-buffer buf
+ (vc-call-backend backend 'region-history-mode)
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) file)
+ (set (make-local-variable 'revert-buffer-function)
+ (lambda (_ignore-auto _noconfirm)
+ (with-current-buffer buf
+ (let ((inhibit-read-only t)) (erase-buffer)))
+ (vc-call region-history file buf lfrom lto))))
+ (display-buffer buf)))
+
+;;;###autoload
(defun vc-revert ()
"Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
@@ -2425,58 +2415,6 @@ to the working revision (except for keyword expansion)."
(message "Reverting %s...done" (vc-delistify files)))))
;;;###autoload
-(defun vc-rollback ()
- "Roll back (remove) the most recent changeset committed to the repository.
-This may be either a file-level or a repository-level operation,
-depending on the underlying version-control system."
- (interactive)
- (let* ((vc-fileset (vc-deduce-fileset))
- (backend (car vc-fileset))
- (files (cadr vc-fileset))
- (granularity (vc-call-backend backend 'revision-granularity)))
- (unless (vc-find-backend-function backend 'rollback)
- (error "Rollback is not supported in %s" backend))
- (when (and (not (eq granularity 'repository)) (/= (length files) 1))
- (error "Rollback requires a singleton fileset or repository versioning"))
- ;; FIXME: latest-on-branch-p should take the fileset.
- (when (not (vc-call-backend backend 'latest-on-branch-p (car files)))
- (error "Rollback is only possible at the tip revision"))
- ;; If any of the files is visited by the current buffer, make
- ;; sure buffer is saved. If the user says `no', abort since
- ;; we cannot show the changes and ask for confirmation to
- ;; discard them.
- (when (or (not files) (memq (buffer-file-name) files))
- (vc-buffer-sync nil))
- (dolist (file files)
- (when (buffer-modified-p (get-file-buffer file))
- (error "Please kill or save all modified buffers before rollback"))
- (when (not (vc-up-to-date-p file))
- (error "Please revert all modified workfiles before rollback")))
- ;; Accumulate changes associated with the fileset
- (vc-setup-buffer "*vc-diff*")
- (not-modified)
- (message "Finding changes...")
- (let* ((tip (vc-working-revision (car files)))
- ;; FIXME: `previous-revision' should take the fileset.
- (previous (vc-call-backend backend 'previous-revision
- (car files) tip)))
- (vc-diff-internal nil vc-fileset previous tip))
- ;; Display changes
- (unless (yes-or-no-p "Discard these revisions? ")
- (error "Rollback canceled"))
- (quit-windows-on "*vc-diff*")
- ;; Do the actual reversions
- (message "Rolling back %s..." (vc-delistify files))
- (with-vc-properties
- files
- (vc-call-backend backend 'rollback files)
- `((vc-state . ,'up-to-date)
- (vc-checkout-time . , (nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (dolist (f files) (vc-resynch-buffer f t t))
- (message "Rolling back %s...done" (vc-delistify files))))
-
-;;;###autoload
(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
;;;###autoload
@@ -2509,14 +2447,14 @@ tip revision are merged into the working file."
(and file (member file files))))))
(dolist (file files)
(if (vc-up-to-date-p file)
- (vc-checkout file nil t)
+ (vc-checkout file t)
(vc-maybe-resolve-conflicts
file (vc-call-backend backend 'merge-news file)))))
;; For a locking VCS, check out each file.
((eq (vc-checkout-model backend files) 'locking)
(dolist (file files)
(if (vc-up-to-date-p file)
- (vc-checkout file nil t))))
+ (vc-checkout file t))))
(t
(error "VC update is unsupported for `%s'" backend)))))
@@ -2638,7 +2576,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(when modified-file
(vc-switch-backend file new-backend)
(unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
- (vc-checkout file t nil))
+ (vc-checkout file))
(rename-file modified-file file 'ok-if-already-exists)
(vc-file-setprop file 'vc-checkout-time nil)))))
(when move
@@ -2649,34 +2587,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file new-backend)
- (vc-checkin file new-backend nil comment (stringp comment)))))
-
-(defun vc-rename-master (oldmaster newfile templates)
- "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
- (let* ((dir (file-name-directory (expand-file-name oldmaster)))
- (newdir (or (file-name-directory newfile) ""))
- (newbase (file-name-nondirectory newfile))
- (masters
- ;; List of potential master files for `newfile'
- (mapcar
- (lambda (s) (vc-possible-master s newdir newbase))
- templates)))
- (when (or (file-symlink-p oldmaster)
- (file-symlink-p (file-name-directory oldmaster)))
- (error "This is unsafe in the presence of symbolic links"))
- (rename-file
- oldmaster
- (catch 'found
- ;; If possible, keep the master file in the same directory.
- (dolist (f masters)
- (when (and f (string= (file-name-directory (expand-file-name f)) dir))
- (throw 'found f)))
- ;; If not, just use the first possible place.
- (dolist (f masters)
- (and f (or (not (setq dir (file-name-directory f)))
- (file-directory-p dir))
- (throw 'found f)))
- (error "New file lacks a version control directory")))))
+ (vc-checkin file new-backend comment (stringp comment)))))
;;;###autoload
(defun vc-delete-file (file)
@@ -2811,19 +2722,6 @@ log entries should be gathered."
The default is to return nil always."
nil)
-(defun vc-default-could-register (_backend _file)
- "Return non-nil if BACKEND could be used to register FILE.
-The default implementation returns t for all files."
- t)
-
-(defun vc-default-latest-on-branch-p (_backend _file)
- "Return non-nil if FILE is the latest on its branch.
-This default implementation always returns non-nil, which means that
-editing non-current revisions is not supported by default."
- t)
-
-(defun vc-default-init-revision (_backend) vc-default-init-revision)
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
@@ -2918,9 +2816,9 @@ to provide the `find-revision' operation instead."
(defalias 'vc-default-revision-completion-table 'ignore)
(defalias 'vc-default-mark-resolved 'ignore)
-(defun vc-default-dir-status-files (_backend _dir files default-state update-function)
+(defun vc-default-dir-status-files (_backend _dir files update-function)
(funcall update-function
- (mapcar (lambda (file) (list file default-state)) files)))
+ (mapcar (lambda (file) (list file 'up-to-date)) files)))
(defun vc-check-headers ()
"Check if the current file has any headers in it."
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 12:51:12 +0000