summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el2
-rw-r--r--lisp/vc/diff-mode.el64
-rw-r--r--lisp/vc/diff.el2
-rw-r--r--lisp/vc/ediff-diff.el4
-rw-r--r--lisp/vc/ediff-init.el56
-rw-r--r--lisp/vc/ediff-mult.el17
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el70
-rw-r--r--lisp/vc/ediff-vers.el25
-rw-r--r--lisp/vc/ediff-wind.el21
-rw-r--r--lisp/vc/ediff.el101
-rw-r--r--lisp/vc/emerge.el5
-rw-r--r--lisp/vc/log-edit.el15
-rw-r--r--lisp/vc/log-view.el14
-rw-r--r--lisp/vc/pcvs-parse.el2
-rw-r--r--lisp/vc/smerge-mode.el53
-rw-r--r--lisp/vc/vc-annotate.el4
-rw-r--r--lisp/vc/vc-bzr.el11
-rw-r--r--lisp/vc/vc-cvs.el35
-rw-r--r--lisp/vc/vc-dir.el94
-rw-r--r--lisp/vc/vc-dispatcher.el10
-rw-r--r--lisp/vc/vc-git.el79
-rw-r--r--lisp/vc/vc-hg.el78
-rw-r--r--lisp/vc/vc-hooks.el16
-rw-r--r--lisp/vc/vc-mtn.el1
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-src.el67
-rw-r--r--lisp/vc/vc-svn.el13
-rw-r--r--lisp/vc/vc.el159
29 files changed, 616 insertions, 406 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index d302fb16eda..54bb3569788 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -667,7 +667,7 @@ With a numeric prefix ARG, go back ARG comments."
"Prompt for a change log name."
(let* ((default (change-log-name))
(name (expand-file-name
- (read-file-name (format "Log file (default %s): " default)
+ (read-file-name (format-prompt "Log file" default)
nil default))))
;; Handle something that is syntactically a directory name.
;; Look for ChangeLog or whatever in that directory.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8171a585158..5aeb8feb990 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -83,7 +83,10 @@ When editing a diff file, the line numbers in the hunk headers
need to be kept consistent with the actual diff. This can
either be done on the fly (but this sometimes interacts poorly with the
undo mechanism) or whenever the file is written (can be slow
-when editing big diffs)."
+when editing big diffs).
+
+If this variable is nil, the hunk header numbers are updated when
+the file is written instead."
:type 'boolean)
(defcustom diff-advance-after-apply-hunk t
@@ -205,6 +208,8 @@ and hunk-based syntax highlighting otherwise as a fallback."
;; `d' because it duplicates the context :-( --Stef
("\C-c\C-d" . diff-unified->context)
("\C-c\C-w" . diff-ignore-whitespace-hunk)
+ ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
+ ("\C-c\C-l" . diff-refresh-hunk)
("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-(
("\C-c\C-f" . next-error-follow-minor-mode))
"Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
@@ -241,6 +246,8 @@ and hunk-based syntax highlighting otherwise as a fallback."
:help "Split the current (unified diff) hunk at point into two hunks"]
["Ignore whitespace changes" diff-ignore-whitespace-hunk
:help "Re-diff the current hunk, ignoring whitespace differences"]
+ ["Recompute the hunk" diff-refresh-hunk
+ :help "Re-diff the current hunk, keeping the whitespace differences"]
["Highlight fine changes" diff-refine-hunk
:help "Highlight changes of hunk at point at a finer granularity"]
["Kill current hunk" diff-hunk-kill
@@ -392,6 +399,12 @@ well."
'((t :inherit diff-file-header))
"`diff-mode' face used to highlight nonexistent files in recursive diffs.")
+(defface diff-error
+ '((((class color))
+ :foreground "red" :background "black" :weight bold)
+ (t :weight bold))
+ "`diff-mode' face for error messages from diff.")
+
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
;; FIXME: the yank-handler is now called separately on each piece of text
@@ -472,6 +485,7 @@ and the face `diff-added' for added lines.")
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
+ ("^diff: .*" (0 'diff-error))
("^[^-=+*!<>#].*\n" (0 'diff-context))
(,#'diff--font-lock-syntax)
(,#'diff--font-lock-prettify)
@@ -484,7 +498,7 @@ and the face `diff-added' for added lines.")
;; Prefer second name as first is most likely to be a backup or
;; version-control name. The [\t\n] at the end of the unidiff pattern
;; catches Debian source diff files (which lack the trailing date).
- '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
+ '((nil "\\+\\+\\+ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
(nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
;;;;
@@ -923,8 +937,12 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(progn (diff-hunk-prev) (point))
(error (point-min)))))
(header-files
- ;; handle filenames with spaces;
+ ;; handle file names with spaces;
;; cf. diff-font-lock-keywords / diff-file-header
+ ;; FIXME if there are nonascii characters in the file names,
+ ;; GNU diff displays them as octal escapes.
+ ;; This function should undo that, so as to return file names
+ ;; that are usable in Emacs.
(if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)")
(list (if old (match-string 1) (match-string 2))
(if old (match-string 2) (match-string 1)))
@@ -1846,7 +1864,10 @@ SWITCHED is non-nil if the patch is already applied."
(buf (if revision
(let ((vc-find-revision-no-save t))
(vc-find-revision (expand-file-name file) revision diff-vc-backend))
- (find-file-noselect file))))
+ ;; NOPROMPT is only non-nil when called from
+ ;; `which-function-mode', so avoid "File x changed
+ ;; on disk. Reread from disk?" warnings.
+ (find-file-noselect file noprompt))))
;; Update the user preference if he so wished.
(when (> (prefix-numeric-value other-file) 8)
(setq diff-jump-to-old-file other))
@@ -1988,8 +2009,7 @@ revision of the file otherwise."
(diff-find-source-location other-file reverse)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
- (when buffer (next-error-found buffer (current-buffer)))
- (diff-hunk-status-msg line-offset (xor reverse switched) t))))
+ (when buffer (next-error-found buffer (current-buffer))))))
(defun diff-current-defun ()
@@ -2029,8 +2049,15 @@ For use in `add-log-current-defun-function'."
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
+ (diff-refresh-hunk t))
+
+(defun diff-refresh-hunk (&optional ignore-whitespace)
+ "Re-diff the current hunk."
+ (interactive)
(let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
- (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
+ (opt-type (pcase (char-after)
+ (?@ "-u")
+ (?* "-c")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
@@ -2041,7 +2068,12 @@ For use in `add-log-current-defun-function'."
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2"))
(coding-system-for-read buffer-file-coding-system)
- old new)
+ opts old new)
+ (when ignore-whitespace
+ (setq opts '("-b")))
+ (when opt-type
+ (setq opts (cons opt-type opts)))
+
(unwind-protect
(save-excursion
(setq old (diff-hunk-text hunk nil char-offset))
@@ -2050,8 +2082,9 @@ For use in `add-log-current-defun-function'."
(write-region (concat lead (car new)) nil file2 nil 'nomessage)
(with-temp-buffer
(let ((status
- (call-process diff-command nil t nil
- opts file1 file2)))
+ (apply 'call-process
+ `(,diff-command nil t nil
+ ,@opts ,file1 ,file2))))
(pcase status
(0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
@@ -2163,9 +2196,10 @@ Return new point, if it was moved."
(smerge-refine-regions beg-del beg-add beg-add end-add
nil #'diff-refine-preproc props-r props-a)))))
('context
- (let* ((middle (save-excursion (re-search-forward "^---" end)))
+ (let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (while (and middle
+ (re-search-forward "^\\(?:!.*\n\\)+" middle t))
(smerge-refine-regions (match-beginning 0) (match-end 0)
(save-excursion
(goto-char other)
@@ -2518,7 +2552,7 @@ fixed, visit it in a buffer."
'((?+ . (left-fringe diff-fringe-add diff-indicator-added))
(?- . (left-fringe diff-fringe-del diff-indicator-removed))
(?! . (left-fringe diff-fringe-rep diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul))))))
+ (?\s . (left-fringe diff-fringe-nul fringe))))))
(put-text-property (match-beginning 0) (match-end 0) 'display spec))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
@@ -2720,7 +2754,9 @@ hunk text is not found in the source file."
;; When initialization is requested, we should be in a brand new
;; temp buffer.
(cl-assert (null buffer-file-name))
- (let ((enable-local-variables :safe) ;; to find `mode:'
+ ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
+ ;; Local Variables list might be incomplete when context is truncated.
+ (let ((enable-local-variables (unless hunk-only :safe))
(buffer-file-name file))
;; Don't run hooks that might assume buffer-file-name
;; really associates buffer with a file (bug#39190).
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 469888078c4..b7f17bf3c73 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -258,6 +258,8 @@ This requires the external program `diff' to be in your `exec-path'."
(interactive "bBuffer: ")
(let ((buf (get-buffer (or buffer (current-buffer)))))
(with-current-buffer (or (buffer-base-buffer buf) buf)
+ (unless buffer-file-name
+ (error "Buffer is not visiting a file"))
(diff buffer-file-name (current-buffer) nil 'noasync))))
;;;###autoload
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ef466741b24..ccf5a7807f2 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -325,6 +325,10 @@ one optional arguments, diff-number to refine.")
(error-buf ediff-error-buffer))
(ediff-skip-unsuitable-frames)
(switch-to-buffer error-buf)
+ ;; We output data from the diff command using `raw-text' as
+ ;; the coding system, so decode before displaying.
+ (when (eq ediff-coding-system-for-read 'raw-text)
+ (decode-coding-region (point-min) (point-max) 'undecided))
(ediff-kill-buffer-carefully ctl-buf)
(user-error "Errors in diff output. Diff output is in %S" diff-buff))))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index fb1f25b6c6d..04926af16ef 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -452,6 +452,8 @@ For each buffer, the hooks are run with that buffer made current."
"Hook run after Ediff is loaded. Can be used to change defaults."
:type 'hook
:group 'ediff-hook)
+(make-obsolete-variable 'ediff-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ediff-mode-hook nil
"Hook run just after ediff-mode is set up in the control buffer.
@@ -1255,22 +1257,8 @@ Instead, C-h would jump to previous difference."
:type 'boolean
:group 'ediff)
-;; This is the same as temporary-file-directory from Emacs 20.3.
-;; Copied over here because XEmacs doesn't have this variable.
-(defcustom ediff-temp-file-prefix
- (file-name-as-directory
- (cond ((boundp 'temporary-file-directory) temporary-file-directory)
- ((fboundp 'temp-directory) (temp-directory))
- (t "/tmp/")))
-;;; (file-name-as-directory
-;;; (cond ((memq system-type '(ms-dos windows-nt))
-;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
-;;; (t
-;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
- "Prefix to put on Ediff temporary file names.
-Do not start with `~/' or `~USERNAME/'."
- :type 'string
- :group 'ediff)
+(define-obsolete-variable-alias 'ediff-temp-file-prefix
+ 'temporary-file-directory "28.1")
(defcustom ediff-temp-file-mode 384 ; u=rw only
"Mode for Ediff temporary files."
@@ -1282,11 +1270,11 @@ Do not start with `~/' or `~USERNAME/'."
(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
"Regexp that matches characters that must be quoted with `\\' in shell command line.
This default should work without changes."
- :type 'string
+ :type 'regexp
:group 'ediff)
-;; needed to simulate frame-char-width in XEmacs.
-(defvar ediff-H-glyph (if (featurep 'xemacs) (make-glyph "H")))
+(defvar ediff-H-glyph nil)
+(make-obsolete-variable 'ediff-H-glyph nil "28.1")
;; Temporary file used for refining difference regions in buffer A.
@@ -1522,34 +1510,9 @@ This default should work without changes."
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
-(defun ediff-truncate-string-left (str newlen)
- ;; leave space for ... on the left
- (let ((len (length str))
- substr)
- (if (<= len newlen)
- str
- (setq newlen (max 0 (- newlen 3)))
- (setq substr (substring str (max 0 (- len 1 newlen))))
- (concat "..." substr))))
-
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
-(unless (fboundp 'subst-char-in-string)
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
-
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
"Compare two directories")
@@ -1610,9 +1573,8 @@ Unless optional argument INPLACE is non-nil, return a new string."
(defun ediff-convert-standard-filename (fname)
- (if (fboundp 'convert-standard-filename)
- (convert-standard-filename fname)
- fname))
+ (declare (obsolete convert-standard-filename "28.1"))
+ (convert-standard-filename fname))
(define-obsolete-function-alias 'ediff-with-syntax-table
#'with-syntax-table "27.1")
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352e..c977291a524 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,7 +113,6 @@
(require 'ediff-wind)
(require 'ediff-util)
-
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
@@ -1172,7 +1171,7 @@ behavior."
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@@ -1266,7 +1265,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@@ -1281,7 +1280,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@@ -1295,7 +1294,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
@@ -1808,11 +1807,9 @@ all marked sessions must be active."
(ediff-show-meta-buffer session-buf)
(setq regexp
(read-string
- (if (stringp default-regexp)
- (format
- "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp t)))
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index cb0ae6ff6e1..f6af5a45550 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -119,7 +119,7 @@ patch. So, don't change these variables, unless the default doesn't work."
(defcustom ediff-context-diff-label-regexp
(let ((stuff "\\([^ \t\n]+\\)"))
(concat "\\(" ; context diff 2-liner
- "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff
+ "^\\*\\*\\* +" stuff "[^*]+\n--- +" stuff
"\\|" ; unified format diff 2-liner
"^--- +" stuff ".*\n\\+\\+\\+ +" stuff
"\\)"))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index a8af9ba37a2..e28d8574b1c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -131,7 +131,6 @@ to invocation.")
(define-key ediff-mode-map [delete] 'ediff-previous-difference)
(define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
'ediff-previous-difference nil))
- ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs
(define-key ediff-mode-map [backspace] 'ediff-previous-difference)
(define-key ediff-mode-map [?\S-\ ] 'ediff-previous-difference)
(define-key ediff-mode-map "n" 'ediff-next-difference)
@@ -241,18 +240,16 @@ to invocation.")
startup-hooks setup-parameters
&optional merge-buffer-file)
(run-hooks 'ediff-before-setup-hook)
- ;; ediff-convert-standard-filename puts file names in the form appropriate
+ ;; convert-standard-filename puts file names in the form appropriate
;; for the OS at hand.
- (setq file-A (ediff-convert-standard-filename (expand-file-name file-A)))
- (setq file-B (ediff-convert-standard-filename (expand-file-name file-B)))
+ (setq file-A (convert-standard-filename (expand-file-name file-A)))
+ (setq file-B (convert-standard-filename (expand-file-name file-B)))
(if (stringp file-C)
- (setq file-C
- (ediff-convert-standard-filename (expand-file-name file-C))))
+ (setq file-C (convert-standard-filename (expand-file-name file-C))))
(if (stringp merge-buffer-file)
(progn
(setq merge-buffer-file
- (ediff-convert-standard-filename
- (expand-file-name merge-buffer-file)))
+ (convert-standard-filename (expand-file-name merge-buffer-file)))
;; check the directory exists
(or (file-exists-p (file-name-directory merge-buffer-file))
(error "Directory %s given as place to save the merge doesn't exist"
@@ -1540,10 +1537,10 @@ the width of the A/B/C windows."
;; hscrolling.
(if (= last-command-event ?<)
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-left)))
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-right))))
;; calculate argument to scroll-left/right
;; if there is an explicit argument
@@ -2184,19 +2181,18 @@ a regular expression typed in by the user."
(setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
regexp-A
(read-string
- (format
- "Ignore A-regions matching this regexp (default %s): "
- ediff-regexp-hide-A))
+ (format-prompt
+ "Ignore A-regions matching this regexp" ediff-regexp-hide-A))
regexp-B
(read-string
- (format
- "Ignore B-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore B-regions matching this regexp"
ediff-regexp-hide-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Ignore C-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore C-regions matching this regexp"
ediff-regexp-hide-C))))
(if (eq ediff-hide-regexp-connective 'and)
(setq msg-connective "BOTH"
@@ -2223,20 +2219,18 @@ a regular expression typed in by the user."
ediff-focus-on-regexp-matches-function
regexp-A
(read-string
- (format
- "Focus on A-regions matching this regexp (default %s): "
- ediff-regexp-focus-A))
+ (format-prompt
+ "Focus on A-regions matching this regexp" ediff-regexp-focus-A))
regexp-B
(read-string
- (format
- "Focus on B-regions matching this regexp (default %s): "
- ediff-regexp-focus-B)))
+ (format-prompt
+ "Focus on B-regions matching this regexp" ediff-regexp-focus-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Focus on C-regions matching this regexp (default %s): "
- ediff-regexp-focus-C))))
+ (format-prompt
+ "Focus on C-regions matching this regexp"
+ ediff-regexp-focus-C))))
(if (eq ediff-focus-regexp-connective 'and)
(setq msg-connective "BOTH"
alt-msg-connective "ONE OF"
@@ -3070,10 +3064,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; for compatibility
-(defmacro ediff-minibuffer-with-setup-hook (fun &rest body)
- `(if (fboundp 'minibuffer-with-setup-hook)
- (minibuffer-with-setup-hook ,fun ,@body)
- ,@body))
+(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook
+ #'minibuffer-with-setup-hook "28.1")
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
@@ -3102,7 +3094,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(and default-file (list default-file))
default-dir)))
f)
- (setq f (ediff-minibuffer-with-setup-hook
+ (setq f (minibuffer-with-setup-hook
(lambda () (when defaults
(setq minibuffer-default defaults)))
(read-file-name
@@ -3135,7 +3127,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; Also, save buffer from START to END in the file.
;; START defaults to (point-min), END to (point-max)
(defun ediff-make-temp-file (buff &optional prefix given-file start end)
- (let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
+ (let* ((p (convert-standard-filename (or prefix "ediff")))
(short-p p)
(coding-system-for-write ediff-coding-system-for-write)
f short-f)
@@ -3144,8 +3136,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(> (length p) 2))
(setq short-p (substring p 0 2)))
- (setq f (concat ediff-temp-file-prefix p)
- short-f (concat ediff-temp-file-prefix short-p)
+ (setq f (concat temporary-file-directory p)
+ short-f (concat temporary-file-directory short-p)
f (cond (given-file)
((find-file-name-handler f 'insert-file-contents)
;; to thwart file name handlers in write-region,
@@ -3449,7 +3441,6 @@ Without an argument, it saves customized diff argument, if available
(declare-function ediff-regions-internal "ediff"
(buffer-a beg-a end-a buffer-b beg-b end-b
startup-hooks job-name word-mode setup-parameters))
-(defvar zmacs-regions) ;;XEmacs'ism.
(defun ediff-inferior-compare-regions ()
"Compare regions in an active Ediff session.
@@ -3461,7 +3452,6 @@ Ediff Control Panel to restore highlighting."
(interactive)
(let ((answer "")
(possibilities (list ?A ?B ?C))
- (zmacs-regions t)
use-current-diff-p
begA begB endA endB bufA bufB)
@@ -4139,10 +4129,10 @@ Mail anyway? (y or n) ")
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
- (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
+ (ediff-print-diff-vector 'ediff-difference-vector-A)
+ (ediff-print-diff-vector 'ediff-difference-vector-B)
+ (ediff-print-diff-vector 'ediff-difference-vector-C)
+ (ediff-print-diff-vector 'ediff-difference-vector-Ancestor)
))
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index a95606fad5e..4ee7ee5c1f5 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
-(defalias 'ediff-vc-revision-other-window
- (if (fboundp 'vc-revision-other-window)
- 'vc-revision-other-window
- 'vc-version-other-window))
-
-(defalias 'ediff-vc-working-revision
- (if (fboundp 'vc-working-revision)
- 'vc-working-revision
- 'vc-workfile-version))
+(define-obsolete-function-alias 'ediff-vc-revision-other-window
+ #'vc-revision-other-window "28.1")
+(define-obsolete-function-alias 'ediff-vc-working-revision
+ #'vc-working-revision "28.1")
;; VC.el support
@@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
- (setq ancestor-rev (ediff-vc-working-revision
+ (setq ancestor-rev (vc-working-revision
buffer-file-name)))
- (ediff-vc-revision-other-window ancestor-rev)
+ (vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 7b2e1109c87..a23d72070ab 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -156,12 +156,10 @@ In this case, Ediff will use those frames to display these buffers."
'(name . "Ediff")
;;'(unsplittable . t)
'(minibuffer . nil)
- '(user-position . t) ; Emacs only
- '(vertical-scroll-bars . nil) ; Emacs only
- '(scrollbar-width . 0) ; XEmacs only
- '(scrollbar-height . 0) ; XEmacs only
- '(menu-bar-lines . 0) ; Emacs only
- '(tool-bar-lines . 0) ; Emacs 21+ only
+ '(user-position . t)
+ '(vertical-scroll-bars . nil)
+ '(menu-bar-lines . 0)
+ '(tool-bar-lines . 0)
'(left-fringe . 0)
'(right-fringe . 0)
;; don't lower but auto-raise
@@ -260,10 +258,9 @@ the frame used for the wide display.")
This has effect only on a windowing system.
If t, hitting `?' to toggle control panel off iconifies it.
-This is only useful in Emacs and only for certain kinds of window managers,
-such as TWM and its derivatives, since the window manager must permit
-keyboard input to go into icons. XEmacs completely ignores keyboard input
-into icons, regardless of the window manager."
+This is only useful for certain kinds of window managers, such as
+TWM and its derivatives, since the window manager must permit
+keyboard input to go into icons."
:type 'boolean)
;;; Functions
@@ -952,8 +949,7 @@ create a new splittable frame if none is found."
;; just a precaution--we should be in ctl-buffer already
(with-current-buffer ctl-buffer
(make-local-variable 'frame-title-format)
- (make-local-variable 'frame-icon-title-format) ; XEmacs
- (make-local-variable 'icon-title-format)) ; Emacs
+ (make-local-variable 'icon-title-format))
(ediff-setup-control-buffer ctl-buffer)
(setq dont-iconify-ctl-frame
@@ -1098,6 +1094,7 @@ create a new splittable frame if none is found."
)))
(defun ediff-xemacs-select-frame-hook ()
+ (declare (obsolete nil "28.1"))
(if (and (equal (selected-frame) ediff-control-frame)
(not ediff-use-long-help-message))
(raise-frame ediff-control-frame)))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 133d2109f5b..ae2f8ad6c1c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -566,10 +566,8 @@ expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -594,10 +592,8 @@ names. Only the files that are under revision control are taken into account."
(list (read-directory-name
"Directory to compare with revision:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression" default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -632,10 +628,8 @@ regular expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -665,10 +659,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -707,10 +699,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -735,10 +725,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(list (read-directory-name
"Directory to merge with revisions:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -767,10 +755,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
"Directory to merge with revisions and ancestors:"
dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -1353,16 +1339,18 @@ the merge buffer."
(let (rev1 rev2)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer"))))
(ediff-load-version-control)
;; ancestor-revision=nil
(funcall
@@ -1388,22 +1376,26 @@ the merge buffer."
(let (rev1 rev2 ancestor-rev)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")))
ancestor-rev
- (read-string
- (format-message
- "Ancestor version (default %s's base revision): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (read-string (format-prompt
+ "Ancestor version"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s base revision"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-merge-internal" ediff-version-control-package))
@@ -1503,13 +1495,14 @@ arguments after setting up the Ediff buffers."
(save-buffer (current-buffer)))
(let (rev1 rev2)
(setq rev1
- (read-string
- (format "Revision 1 to compare (default %s's latest revision): "
- (file-name-nondirectory file)))
+ (read-string (format-prompt "Revision 1 to compare"
+ (concat (file-name-nondirectory file)
+ "'s latest revision")))
rev2
(read-string
- (format "Revision 2 to compare (default %s's current state): "
- (file-name-nondirectory file))))
+ (format-prompt "Revision 2 to compare"
+ (concat (file-name-nondirectory file)
+ "'s current state"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-internal" ediff-version-control-package))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index fc8c318e3af..d2d419ac786 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -2757,15 +2757,14 @@ Otherwise, signal an error."
alternative-default-dir
(not (string-equal alternative-default-dir
(file-name-directory A-file))))
- (read-file-name (format "%s (default %s): "
- prompt (file-name-nondirectory A-file))
+ (read-file-name (format-prompt prompt (file-name-nondirectory A-file))
alternative-default-dir
(concat alternative-default-dir
(file-name-nondirectory A-file))
(and must-match 'confirm)))
;; If there is a default file, use it.
(default-file
- (read-file-name (format "%s (default %s): " prompt default-file)
+ (read-file-name (format-prompt prompt default-file)
;; If emerge-default-last-directories is set, use the
;; directory from the same argument of the last call of
;; Emerge as the default for this argument.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 906f9a94205..1c69bdf4135 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -51,6 +51,9 @@
;; The main keymap
+(define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1")
+(define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1")
+
(easy-mmode-defmap log-edit-mode-map
'(("\C-c\C-c" . log-edit-done)
("\C-c\C-a" . log-edit-insert-changelog)
@@ -67,10 +70,6 @@
"Keymap for the `log-edit-mode' (to edit version control log messages)."
:group 'log-edit)
-;; Compatibility with old names. Should we bother ?
-(defvar vc-log-mode-map log-edit-mode-map)
-(defvar vc-log-entry-mode vc-log-mode-map)
-
(easy-menu-define log-edit-menu log-edit-mode-map
"Menu used for `log-edit-mode'."
'("Log-Edit"
@@ -245,7 +244,9 @@ If the optional argument STRIDE is present, that is a step-width to use
when going through the comment ring."
;; Why substring rather than regexp ? -sm
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(unless stride (setq stride 1))
(if (string= str "")
(setq str log-edit-last-comment-match)
@@ -262,7 +263,9 @@ when going through the comment ring."
(defun log-edit-comment-search-forward (str)
"Search forwards through comment history for a substring match of STR."
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(log-edit-comment-search-backward str -1))
(defun log-edit-comment-to-change-log (&optional whoami file-name)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index e1c2b976a49..56ecc64671c 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -208,6 +208,18 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
"Face for the message header line in `log-view-mode'."
:group 'log-view)
+(defface log-view-commit-body
+ '((((class color) (min-colors 88) (background light))
+ :background "gray95" :foreground "black" :extend t)
+ (((class color) (min-colors 88) (background dark))
+ :background "gray5" :foreground "white" :extend t)
+ (((class color) (min-colors 8) (background light))
+ :foreground "black")
+ (((class color) (min-colors 8) (background dark))
+ :foreground "white"))
+ "Face for the commit body in `log-view-mode'."
+ :version "28.1")
+
(defvar log-view-file-re
(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
;; Subversion has no such thing??
@@ -415,7 +427,7 @@ This calls `log-view-expanded-log-entry-function' to do the work."
(insert long-entry "\n")
(add-text-properties
beg (point)
- '(font-lock-face font-lock-comment-face log-view-comment t))
+ '(font-lock-face log-view-commit-body log-view-comment t))
(goto-char opoint))))))))
(defun log-view-beginning-of-defun (&optional arg)
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 466c621311f..dd56aec94a0 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -472,7 +472,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; Let's not get all worked up if the format changes a bit
(cvs-match " *Working revision:.*$"))
(cvs-or
- (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1))
+ (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\).*$" (head-rev 1))
(cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$"
(head-rev 1))
(cvs-match " *Repository revision:.*"))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 85868b91ecc..fe7724d9027 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1352,24 +1352,26 @@ buffer names."
;; Do a few further adjustments and take precautions for exit.
(set (make-local-variable 'smerge-ediff-windows) config)
(set (make-local-variable 'smerge-ediff-buf) buf)
- (set (make-local-variable 'ediff-quit-hook)
- (lambda ()
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (buffer-C ediff-buffer-C)
- (buffer-Ancestor ediff-ancestor-buffer)
- (buf smerge-ediff-buf)
- (windows smerge-ediff-windows))
- (ediff-cleanup-mess)
- (with-current-buffer buf
- (erase-buffer)
- (insert-buffer-substring buffer-C)
- (kill-buffer buffer-A)
- (kill-buffer buffer-B)
- (kill-buffer buffer-C)
- (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
- (set-window-configuration windows)
- (message "Conflict resolution finished; you may save the buffer")))))
+ (add-hook 'ediff-quit-hook
+ (lambda ()
+ (let ((buffer-A ediff-buffer-A)
+ (buffer-B ediff-buffer-B)
+ (buffer-C ediff-buffer-C)
+ (buffer-Ancestor ediff-ancestor-buffer)
+ (buf smerge-ediff-buf)
+ (windows smerge-ediff-windows))
+ (ediff-cleanup-mess)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert-buffer-substring buffer-C)
+ (kill-buffer buffer-A)
+ (kill-buffer buffer-B)
+ (kill-buffer buffer-C)
+ (when (bufferp buffer-Ancestor)
+ (kill-buffer buffer-Ancestor))
+ (set-window-configuration windows)
+ (message "Conflict resolution finished; you may save the buffer"))))
+ nil t)
(message "Please resolve conflicts now; exit ediff when done")))
(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4)
@@ -1429,15 +1431,16 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(smerge-remove-props (point-min) (point-max))))
;;;###autoload
-(defun smerge-start-session ()
+(defun smerge-start-session (&optional interactively)
"Turn on `smerge-mode' and move point to first conflict marker.
If no conflict maker is found, turn off `smerge-mode'."
- (interactive)
- (smerge-mode 1)
- (condition-case nil
- (unless (looking-at smerge-begin-re)
- (smerge-next))
- (error (smerge-auto-leave))))
+ (interactive "p")
+ (when (or (null smerge-mode) interactively)
+ (smerge-mode 1)
+ (condition-case nil
+ (unless (looking-at smerge-begin-re)
+ (smerge-next))
+ (error (smerge-auto-leave)))))
(defcustom smerge-change-buffer-confirm t
"If non-nil, request confirmation before moving to another buffer."
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index d82cadc70dd..5198bccf846 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -403,12 +403,12 @@ should be applied to the background or to the foreground."
(let ((def (vc-working-revision buffer-file-name)))
(if (null current-prefix-arg) def
(vc-read-revision
- (format "Annotate from revision (default %s): " def)
+ (format-prompt "Annotate from revision" def)
(list buffer-file-name) nil def)))
(if (null current-prefix-arg)
vc-annotate-display-mode
(float (string-to-number
- (read-string "Annotate span days (default 20): "
+ (read-string (format-prompt "Annotate span days" 20)
nil nil "20")))))))
(vc-ensure-vc-buffer)
(setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ede..e2d0ca69a20 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -26,7 +26,7 @@
;;; Commentary:
-;; See <URL:http://bazaar.canonical.com/> concerning bzr.
+;; See <URL:https://bazaar.canonical.com/> concerning bzr.
;; This library provides bzr support in VC.
@@ -1316,6 +1316,15 @@ stream. Standard error output is discarded."
vc-bzr-revision-keywords))
string pred)))))
+(defun vc-bzr-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-bzr-root file-or-dir)))
+ (with-temp-buffer
+ (vc-bzr-command "info" (current-buffer) 0 nil)
+ (goto-char (point-min))
+ (if (re-search-forward "parent branch: \\(.*\\)$" nil t)
+ (match-string 1)
+ (error "Cannot determine Bzr repository URL")))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index e8231ecb289..fdbf44e0f13 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -337,32 +337,35 @@ its parents."
(directory-file-name dir))))
(eq dir t)))
+(declare-function log-edit-extract-headers "log-edit" (headers string))
+
(defun vc-cvs-checkin (files comment &optional rev)
"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))
+ (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))
+ ;; 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)
- (vc-switches 'CVS 'checkin))))
+ (let ((status (apply
+ 'vc-cvs-command nil 1 files
+ "ci" (if rev (concat "-r" rev))
+ (concat "-m" (car (log-edit-extract-headers nil comment)))
+ (vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
(when (not (zerop status))
;; Check checkin problem.
(cond
((re-search-forward "Up-to-date check failed" nil t)
- (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
+ (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
files)
(error "%s" (substitute-command-keys
- (concat "Up-to-date check failed: "
- "type \\[vc-next-action] to merge in changes"))))
+ (concat "Up-to-date check failed: "
+ "type \\[vc-next-action] to merge in changes"))))
(t
(pop-to-buffer (current-buffer))
(goto-char (point-min))
@@ -372,7 +375,7 @@ its parents."
;; Otherwise we can't necessarily tell what goes with what; clear
;; its properties so they have to be refetched.
(if (= (length files) 1)
- (vc-file-setprop
+ (vc-file-setprop
(car files) 'vc-working-revision
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
(mapc 'vc-file-clearprops files))
@@ -385,7 +388,7 @@ its parents."
;; 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"))))
+ (vc-cvs-command nil 0 files "update" "-A"))))
(defun vc-cvs-find-revision (file rev buffer)
(apply 'vc-cvs-command
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e854..cdf8ab984e8 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -147,6 +147,12 @@ See `run-hooks'."
'(menu-item "Unmark Previous " vc-dir-unmark-file-up
:help "Move to the previous line and unmark the file"))
+ (define-key map [mark-unregistered]
+ '(menu-item "Mark Unregistered" vc-dir-mark-unregistered-files
+ :help "Mark all files in the unregistered state"))
+ (define-key map [mark-registered]
+ '(menu-item "Mark Registered" vc-dir-mark-registered-files
+ :help "Mark all files in the state edited, added or removed"))
(define-key map [mark-all]
'(menu-item "Mark All" vc-dir-mark-all-files
:help "Mark all files that are in the same state as the current file\
@@ -310,6 +316,10 @@ See `run-hooks'."
(define-key branch-map "l" 'vc-print-branch-log)
(define-key branch-map "s" 'vc-retrieve-tag))
+ (let ((mark-map (make-sparse-keymap)))
+ (define-key map "*" mark-map)
+ (define-key mark-map "r" 'vc-dir-mark-registered-files))
+
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
`(menu-item
@@ -696,6 +706,38 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-files (mark-files)
+ "Mark files specified by file names in the argument MARK-FILES.
+MARK-FILES should be a list of absolute filenames."
+ (ewoc-map
+ (lambda (filearg)
+ (when (member (expand-file-name (vc-dir-fileinfo->name filearg))
+ mark-files)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-state-files (states)
+ "Mark files that are in the state specified by the list in STATES."
+ (unless (listp states)
+ (setq states (list states)))
+ (ewoc-map
+ (lambda (filearg)
+ (when (memq (vc-dir-fileinfo->state filearg) states)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-registered-files ()
+ "Mark files that are in one of registered state: edited, added or removed."
+ (interactive)
+ (vc-dir-mark-state-files '(edited added removed)))
+
+(defun vc-dir-mark-unregistered-files ()
+ "Mark files that are in unregistered state."
+ (interactive)
+ (vc-dir-mark-state-files 'unregistered))
+
(defun vc-dir-unmark-file ()
;; Unmark the current file and move to the next line.
(let* ((crt (ewoc-locate vc-ewoc))
@@ -1064,6 +1106,7 @@ the *vc-dir* buffer.
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'desktop-save-buffer)
'vc-dir-desktop-buffer-misc-data)
+ (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
@@ -1193,7 +1236,8 @@ Throw an error if another update process is in progress."
(if remaining
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining))
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)
+ (run-hooks 'vc-dir-refresh-hook))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
@@ -1287,6 +1331,16 @@ state of item at point, if any."
(list vc-dir-backend files only-files-list state model)))
;;;###autoload
+(defun vc-dir-root ()
+ "Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory."
+ (interactive)
+ (let ((root-dir (vc-root-dir)))
+ (if root-dir (vc-dir root-dir)
+ (call-interactively 'vc-dir))))
+
+;;;###autoload
(defun vc-dir (dir &optional backend)
"Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -1309,7 +1363,7 @@ These are the commands available for use in the file status buffer:
;; When you hit C-x v d in a visited VC file,
;; the *vc-dir* buffer visits the directory under its truename;
;; therefore it makes sense to always do that.
- ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
+ ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
;; you may get a new *vc-dir* buffer, different from the original
(file-truename (read-directory-name "VC status for directory: "
(vc-root-dir) nil t
@@ -1413,6 +1467,42 @@ These are the commands available for use in the file status buffer:
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
+;;; Support for bookmark.el (adapted from what info.el does).
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun vc-dir-bookmark-make-record ()
+ "Make record used to bookmark a `vc-dir' buffer.
+This implements the `bookmark-make-record-function' type for
+`vc-dir' buffers."
+ (let* ((bookmark-name
+ (concat "(" (symbol-name vc-dir-backend) ") "
+ (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (defaults (list bookmark-name default-directory)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,default-directory)
+ (handler . vc-dir-bookmark-jump)
+ (defaults . ,defaults))))
+
+;;;###autoload
+(defun vc-dir-bookmark-jump (bmk)
+ "Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'."
+ (let* ((file (bookmark-prop-get bmk 'filename))
+ (buf (progn ;; Don't use save-window-excursion (bug#39722)
+ (vc-dir file)
+ (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+
(provide 'vc-dir)
;;; vc-dir.el ends here
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 5ae300bf09b..932b9158f2b 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -138,7 +138,9 @@ preserve the setting."
;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
+(defvar vc-log-after-operation-hook nil
+ "Name of the hook run at the end of `vc-finish-logentry'.
+BEWARE: Despite its name, this variable is not itself a hook!")
(defvar vc-log-fileset)
;; In a log entry buffer, this is a local variable
@@ -691,7 +693,6 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(message "%s Type C-c C-c when done" msg)
(vc-finish-logentry (eq comment t)))))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;; vc-finish-logentry is typically called from a log-edit buffer (see
;; vc-start-logentry).
(defun vc-finish-logentry (&optional nocomment)
@@ -740,13 +741,12 @@ the buffer contents as a comment."
(mapc
(lambda (file) (vc-resynch-buffer file t t))
log-fileset))
- (when (vc-dispatcher-browsing)
- (vc-dir-move-to-goal-column))
(run-hooks after-hook 'vc-finish-logentry-hook)))
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
- (derived-mode-p 'vc-dir-mode))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))
;; These are unused.
;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 61e6c642d1f..91554bb6d83 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,6 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
+;; - mark-resolved (file) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -100,6 +101,7 @@
;; - rename-file (old new) OK
;; - find-file-hook () OK
;; - conflicted-files OK
+;; - repository-url (file-or-dir) OK
;;; Code:
@@ -166,7 +168,7 @@ format string (which is passed to \"git log\" via the argument
\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:version "24.1")
(defcustom vc-git-commits-coding-system 'utf-8
@@ -208,6 +210,16 @@ toggle display of the entire list."
widget))))
:version "27.1")
+(defcustom vc-git-revision-complete-only-branches nil
+ "Control whether tags are returned by revision completion for Git.
+
+When non-nil, only branches and remotes will be returned by
+`vc-git-revision-completion-table'. This is used by various VC
+commands when completing branch names. When nil, tags are also
+included in the completions."
+ :type 'boolean
+ :version "28.1")
+
;; History of Git commands.
(defvar vc-git-history nil)
@@ -241,7 +253,7 @@ toggle display of the entire list."
;; path specs.
;; See also: http://marc.info/?l=git&m=125787684318129&w=2
(name (file-relative-name file dir))
- (str (ignore-errors
+ (str (with-demoted-errors "Error: %S"
(cd dir)
(vc-git--out-ok "ls-files" "-c" "-z" "--" name)
;; If result is empty, use ls-tree to check for deleted
@@ -733,6 +745,7 @@ or an empty string if none."
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list))
+ (default-directory dir)
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@@ -745,14 +758,8 @@ or an empty string if none."
(concat "branch." branch ".remote")))))
(when (string-match "\\([^\n]+\\)" remote)
(setq remote (match-string 1 remote)))
- (when remote
- (setq remote-url
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "remote." remote ".url"))))))
- (when (string-match "\\([^\n]+\\)" remote-url)
- (setq remote-url (match-string 1 remote-url))))
+ (when (> (length remote) 0)
+ (setq remote-url (vc-git-repository-url dir remote))))
(setq branch "not (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
@@ -807,7 +814,7 @@ or an empty string if none."
(propertize "Branch : " 'face 'font-lock-type-face)
(propertize branch
'face 'font-lock-variable-name-face)
- (when remote
+ (when remote-url
(concat
"\n"
(propertize "Remote : " 'face 'font-lock-type-face)
@@ -819,10 +826,10 @@ or an empty string if none."
(when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
(propertize "\nRebase : in progress" 'face 'font-lock-warning-face))
(if stash-list
- (concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
- stash-button
- stash-string)
+ (concat
+ (propertize "\nStash : " 'face 'font-lock-type-face)
+ stash-button
+ stash-string)
(concat
(propertize "\nStash : " 'face 'font-lock-type-face)
(propertize "Nothing stashed"
@@ -1081,6 +1088,13 @@ This prompts for a branch to merge from."
"DU" "AA" "UU"))
(push (expand-file-name file directory) files)))))))
+(defun vc-git-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-git-root file-or-dir)))
+ (with-temp-buffer
+ (vc-git-command (current-buffer) 0 nil "remote" "get-url"
+ (or remote-name "origin"))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
;; Everywhere but here, follows vc-git-command, which uses vc-do-command
;; from vc-dispatcher.
(autoload 'vc-resynch-buffer "vc-dispatcher")
@@ -1233,7 +1247,7 @@ log entries."
(set (make-local-variable 'log-view-message-re)
(if (not (memq vc-log-view-type '(long log-search with-diff)))
(cadr vc-git-root-log-format)
- "^commit *\\([0-9a-z]+\\)"))
+ "^commit +\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
(when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
@@ -1262,7 +1276,7 @@ log entries."
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgment)
(2 'change-log-acknowledgment))
- ("^Date: \\(.+\\)" (1 'change-log-date))
+ ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -1411,9 +1425,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(with-temp-buffer
(vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
(goto-char (point-min))
- (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
- nil t)
- (push (match-string 2) table)))
+ (let ((regexp (if vc-git-revision-complete-only-branches
+ "^refs/\\(heads\\|remotes\\)/\\(.*\\)$"
+ "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$")))
+ (while (re-search-forward regexp nil t)
+ (push (match-string 2) table))))
table))
(defun vc-git-revision-completion-table (files)
@@ -1530,6 +1546,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+(defun vc-git-mark-resolved (files)
+ (vc-git-command nil 0 files "add"))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
@@ -1554,8 +1573,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
(defun vc-git-root (file)
- (or (vc-file-getprop file 'git-root)
- (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
+ (vc-find-root file ".git"))
;; grep-compute-defaults autoloads grep.
(declare-function grep-read-regexp "grep" ())
@@ -1688,12 +1706,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-list ()
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
- "\n")))
+ (when-let ((out (vc-git--run-command-string nil "stash" "list")))
+ (delete
+ ""
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"))))
(defun vc-git-stash-get-at-point (point)
(save-excursion
@@ -1775,9 +1794,9 @@ The difference to vc-do-command is that this function always invokes
(defun vc-git--call (buffer command &rest args)
;; We don't need to care the arguments. If there is a file name, it
;; is always a relative one. This works also for remote
- ;; directories. We enable `inhibit-nul-byte-detection', otherwise
+ ;; directories. We enable `inhibit-null-byte-detection', otherwise
;; Tramp's eol conversion might be confused.
- (let ((inhibit-nul-byte-detection t)
+ (let ((inhibit-null-byte-detection t)
(coding-system-for-read
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index d00b69c0d08..67e129044c0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -182,10 +182,20 @@ is the \"--template\" argument string to pass to Mercurial,
REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:group 'vc-hg
:version "24.5")
+(defcustom vc-hg-create-bookmark t
+ "This controls whether `vc-create-tag' will create a bookmark or branch.
+If nil, named branch will be created.
+If t, bookmark will be created.
+If `ask', you will be prompted for a branch type."
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Ask" ask))
+ :version "28.1")
+
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -212,8 +222,11 @@ highlighting the Log View buffer."
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
(when (vc-hg-root file) ; short cut
- (let ((state (vc-hg-state file))) ; expensive
- (and state (not (memq state '(ignored unregistered)))))))
+ (let ((state (vc-state file 'Hg))) ; expensive
+ (if (memq state '(ignored unregistered nil))
+ ;; Clear the cache for proper fallback to another backend.
+ (ignore (vc-file-setprop file 'vc-state nil))
+ t))))
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
@@ -625,10 +638,18 @@ Optional arg REVISION is a revision to annotate from."
;;; Tag system
(defun vc-hg-create-tag (dir name branchp)
- "Attach the tag NAME to the state of the working copy."
+ "Create tag NAME in repo in DIR. Create branch if BRANCHP.
+Variable `vc-hg-create-bookmark' controls what kind of branch will be created."
(let ((default-directory dir))
- (and (vc-hg-command nil 0 nil "status")
- (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name))))
+ (vc-hg-command nil 0 nil
+ (if branchp
+ (if (if (eq vc-hg-create-bookmark 'ask)
+ (yes-or-no-p "Create bookmark instead of branch? ")
+ vc-hg-create-bookmark)
+ "bookmark"
+ "branch")
+ "tag")
+ name)))
(defun vc-hg-retrieve-tag (dir name _update)
"Retrieve the version tagged by NAME of all registered files at or below DIR."
@@ -1366,25 +1387,28 @@ REV is the revision to check out into WORKFILE."
(vc-run-delayed
(vc-hg-after-dir-status update-function)))
-(defun vc-hg-dir-extra-header (name &rest commands)
- (concat (propertize name 'face 'font-lock-type-face)
- (propertize
- (with-temp-buffer
- (apply 'vc-hg-command (current-buffer) 0 nil commands)
- (buffer-substring-no-properties (point-min) (1- (point-max))))
- 'face 'font-lock-variable-name-face)))
-
(defun vc-hg-dir-extra-headers (dir)
- "Generate extra status headers for a Mercurial tree."
+ "Generate extra status headers for a repository in DIR.
+This runs the command \"hg summary\"."
(let ((default-directory dir))
- (concat
- (vc-hg-dir-extra-header "Root : " "root") "\n"
- (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n"
- (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n"
- ;; these change after each commit
- ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n"
- ;; (vc-hg-dir-extra-header "Global id : " "id" "-i")
- )))
+ (with-temp-buffer
+ (vc-hg-command t 0 nil "summary")
+ (goto-char (point-min))
+ (mapconcat
+ #'identity
+ (let (result)
+ (while (not (eobp))
+ (push
+ (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)")
+ (cons (capitalize (match-string 1)) (match-string 2))
+ (cons "" (buffer-substring (point) (line-end-position))))))
+ (concat
+ (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face)
+ (propertize (cdr entry) 'face 'font-lock-variable-name-face)))
+ result)
+ (forward-line))
+ (nreverse result))
+ "\n"))))
(defun vc-hg-log-incoming (buffer remote-location)
(vc-setup-buffer buffer)
@@ -1525,6 +1549,14 @@ This function differs from vc-do-command in that it invokes
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
+(defun vc-hg-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-hg-root file-or-dir)))
+ (with-temp-buffer
+ (vc-hg-command (current-buffer) 0 nil
+ "config"
+ (concat "paths." (or remote-name "default")))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
(provide 'vc-hg)
;;; vc-hg.el ends here
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1d..f09ceddcb37 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -498,21 +498,13 @@ status of this file. Otherwise, the value returned is one of:
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (progn
+ (let ((default-directory (file-name-directory file)))
(setq backend (or backend (vc-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend
backend 'working-revision file))))))
-;; Backward compatibility.
-(define-obsolete-function-alias
- 'vc-workfile-version 'vc-working-revision "23.1")
-(defun vc-default-working-revision (backend file)
- (message
- "`working-revision' not found: using the old `workfile-version' instead")
- (vc-call-backend backend 'workfile-version file))
-
(defun vc-default-registered (backend file)
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
(let ((sym (vc-make-backend-sym backend 'master-templates)))
@@ -972,9 +964,9 @@ In the latter case, VC mode is deactivated for this buffer."
(bindings--define-key map [vc-ignore]
'(menu-item "Ignore File..." vc-ignore
:help "Ignore a file under current version control system"))
- (bindings--define-key map [vc-dir]
- '(menu-item "VC Dir" vc-dir
- :help "Show the VC status of files in a directory"))
+ (bindings--define-key map [vc-dir-root]
+ '(menu-item "VC Dir" vc-dir-root
+ :help "Show the VC status of the repository"))
map))
(defalias 'vc-menu-map vc-menu-map)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 092d8b53968..3c26ffc0e58 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -60,7 +60,6 @@ switches."
:version "25.1"
:group 'vc-mtn)
-(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
:type 'string
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 273f37c10d6..23f088b0cff 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -312,7 +312,7 @@ whether to remove it."
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
;; check whether RCS dir is empty, i.e. it does not
;; contain any files except "." and ".."
- (not (directory-files dir nil (rx (or (not ".") "..."))))
+ (not (directory-files dir nil directory-files-no-dot-files-regexp))
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir)))))
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee726d..4eb638978a9 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'."
(progn
(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src--parse-state (out)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about L code?
+ ((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)))))
+
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
(let*
@@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'."
"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)))))))
+ (vc-src--parse-state out))))
(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) 'SRC)))
- (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)))
+ (let* ((result nil)
+ (status nil)
+ (default-directory (or dir default-directory))
+ (out
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (setq status
+ (ignore-errors
+ (apply
+ #'process-file vc-src-program nil t nil
+ "status" "-a"
+ (mapcar #'file-relative-name files)))))))
+ dlist)
+ (when (eq 0 status)
+ (dolist (line (split-string out "[\n\r]" t))
+ (let* ((pair (split-string line "[\t]" t))
+ (state (vc-src--parse-state (car pair)))
+ (frel (cadr pair)))
+ (if (file-directory-p frel)
+ (push frel dlist)
+ (when (not (eq state 'up-to-date))
+ (push (list frel state) result)))))
+ (dolist (drel dlist)
+ (let ((dresult (vc-src-dir-status-files
+ (expand-file-name drel) nil #'identity)))
+ (dolist (dres dresult)
+ (push (list (concat (file-name-as-directory drel) (car dres))
+ (cadr dres))
+ 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.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a3..06dd09490d2 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -51,8 +51,8 @@
:group 'vc-svn)
;; Might be nice if svn defaulted to non-interactive if stdin not tty.
-;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml
-;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml
+;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml
+;; https://svn.haxx.se/dev/archive-2009-04/0094.shtml
;; Maybe newer ones do?
(defcustom vc-svn-global-switches (unless (eq system-type 'darwin) ; bug#13513
'("--non-interactive"))
@@ -816,7 +816,14 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(push (match-string 1 loglines) vc-svn-revisions)
(setq start (+ start (match-end 0)))
(setq loglines (buffer-substring-no-properties start (point-max)))))
- vc-svn-revisions)))
+ vc-svn-revisions)))
+
+(defun vc-svn-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-svn-root file-or-dir)))
+ (with-temp-buffer
+ (vc-svn-command (current-buffer) 0 nil
+ "info" "--show-item" "repos-root-url")
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
(provide 'vc-svn)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index fe666413168..83f2596865f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -553,6 +553,13 @@
;; Return the list of files where conflict resolution is needed in
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
+;;
+;; - repository-url (file-or-dir &optional remote-name)
+;;
+;; Returns the URL of the repository of the current checkout
+;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
+;; remote (in Git parlance) whose URL is to be returned. It has
+;; only a meaning for distributed VCS and is ignored otherwise.
;;; Changes from the pre-25.1 API:
;;
@@ -957,7 +964,7 @@ use."
(throw 'found bk))))
;;;###autoload
-(defun vc-responsible-backend (file)
+(defun vc-responsible-backend (file &optional no-error)
"Return the name of a backend system that is responsible for FILE.
If FILE is already registered, return the
@@ -967,15 +974,29 @@ responsible for FILE is returned.
Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
-be reported."
+be reported.
+
+If NO-ERROR is nil, signal an error that no VC backend is
+responsible for the given file."
(or (and (not (file-directory-p file)) (vc-backend file))
- (catch 'found
- ;; First try: find a responsible backend. If this is for registration,
- ;; it must be a backend under which FILE is not yet registered.
- (dolist (backend vc-handled-backends)
- (and (vc-call-backend backend 'responsible-p file)
- (throw 'found backend))))
- (error "No VC backend is responsible for %s" file)))
+ ;; First try: find a responsible backend. If this is for registration,
+ ;; it must be a backend under which FILE is not yet registered.
+ (let ((dirs (delq nil
+ (mapcar
+ (lambda (backend)
+ (when-let ((dir (vc-call-backend
+ backend 'responsible-p file)))
+ (cons backend dir)))
+ vc-handled-backends))))
+ ;; Just a single response (or none); use it.
+ (if (< (length dirs) 2)
+ (caar dirs)
+ ;; Several roots; we seem to have one vc inside another's
+ ;; directory. Choose the most specific.
+ (caar (sort dirs (lambda (d1 d2)
+ (< (length (cdr d2)) (length (cdr d1))))))))
+ (unless no-error
+ (error "No VC backend is responsible for %s" file))))
(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
@@ -1006,35 +1027,57 @@ Within directories, only files already under version control are noticed."
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing))
-(defun vc-deduce-fileset (&optional observer allow-unregistered
+(defun vc-deduce-fileset (&optional not-state-changing
+ allow-unregistered
state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+Return a list of the form:
+
+ (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL)
+
+where the last 3 members are optional, and must be present only if
+STATE-MODEL-ONLY-FILES is non-nil.
+
+NOT-STATE-CHANGING, if non-nil, means that the operation
+requesting the fileset doesn't intend to change the VC state,
+such as when printing the log or showing the diffs.
-If we're in VC-dir mode, FILESET is the list of marked files,
-or the directory if no files are marked.
-Otherwise, if in a buffer visiting a version-controlled file,
-FILESET is a single-file fileset containing that file.
+If the current buffer is in `vc-dir' or Dired mode, FILESET is the
+list of marked files, or the file under point if no files are
+marked.
+Otherwise, if the current buffer is visiting a version-controlled
+file or is an indirect buffer whose base buffer visits a
+version-controlled file, FILESET is a single-file list containing
+that file's name.
Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
-is unregistered, FILESET is a single-file fileset containing it.
+is unregistered, FILESET is a single-file list containing the
+name of the visited file.
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.
+STATE-MODEL-ONLY-FILES, if non-nil, means that the caller needs
+the FILESET-ONLY-FILES, STATE, and CHECKOUT-MODEL info, where
+FILESET-ONLY-FILES means only files in similar VC states,
+possible values of STATE are explained in `vc-state', and MODEL in
+`vc-checkout-model'. Otherwise, these 3 members may be omitted from
+the returned list.
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.
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
+ (vc-deduce-fileset-1 not-state-changing
+ allow-unregistered
+ state-model-only-files)))
+
+(defun vc-deduce-fileset-1 (not-state-changing
+ allow-unregistered
+ state-model-only-files)
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
- (if observer
- (vc-dired-deduce-fileset)
- (error "State changing VC operations not supported in `dired-mode'")))
+ (dired-vc-deduce-fileset state-model-only-files not-state-changing))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1046,15 +1089,14 @@ BEWARE: this function may change the current buffer."
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (derived-mode-p 'vc-dir-mode))))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
- ((and (derived-mode-p 'log-view-mode)
+ (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files)))
+ ((and (not buffer-file-name)
(setq backend (vc-responsible-backend default-directory)))
(list backend nil))
- ((not buffer-file-name)
- (error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
(list (vc-backend-for-registration (buffer-file-name))
@@ -1066,10 +1108,6 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name))))
(t (error "File is not under version control")))))
-(defun vc-dired-deduce-fileset ()
- (list (vc-responsible-backend default-directory)
- (dired-map-over-marks (dired-get-filename nil t) nil)))
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
@@ -1328,8 +1366,6 @@ For old-style locking-based version control systems, like RCS:
nil t)))))
(vc-call-backend backend 'create-repo))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
-
;;;###autoload
(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
@@ -1355,7 +1391,7 @@ first backend that could register the file is used."
(unless fname
(setq fname buffer-file-name))
(when (vc-call-backend backend 'registered fname)
- (error "This file is already registered"))
+ (error "This file is already registered: %s" fname))
;; Watch out for new buffers of size 0: the corresponding file
;; does not exist yet, even though buffer-modified-p is nil.
(when bname
@@ -1380,8 +1416,6 @@ first backend that could register the file is used."
(vc-resynch-buffer file t t))
files)
- (when (derived-mode-p 'vc-dir-mode)
- (vc-dir-move-to-goal-column))
(message "Registering %s... done" files)))
(defun vc-register-with (backend)
@@ -1869,6 +1903,10 @@ state of each file in the fileset."
t (list backend (list rootdir)) rev1 rev2
(called-interactively-p 'interactive)))))
+(defun vc-maybe-buffer-sync (not-urgent)
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
+ (when buffer-file-name (vc-buffer-sync not-urgent))))
+
;;;###autoload
(defun vc-diff (&optional historic not-urgent)
"Display diffs between file revisions.
@@ -1881,9 +1919,17 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset t) nil nil
- (called-interactively-p 'interactive))))
+ (vc-maybe-buffer-sync not-urgent)
+ (let ((fileset (vc-deduce-fileset t)))
+ (vc-buffer-sync-fileset fileset not-urgent)
+ (vc-diff-internal t fileset nil nil
+ (called-interactively-p 'interactive)))))
+
+(defun vc-buffer-sync-fileset (fileset not-urgent)
+ (dolist (filename (cadr fileset))
+ (when-let ((buffer (find-buffer-visiting filename)))
+ (with-current-buffer buffer
+ (vc-buffer-sync not-urgent)))))
;;;###autoload
(defun vc-diff-mergebase (_files rev1 rev2)
@@ -1960,7 +2006,7 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-ediff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-maybe-buffer-sync not-urgent)
(vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil)))
;;;###autoload
@@ -1977,7 +2023,7 @@ saving the buffer."
(if historic
;; We want the diff for the VC root dir.
(call-interactively 'vc-root-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-maybe-buffer-sync not-urgent)
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
rootdir working-revision)
@@ -2017,16 +2063,17 @@ Return nil if the root directory cannot be identified."
If the current file is named `F', the revision is named `F.~REV~'.
If `F.~REV~' already exists, use it instead of checking it out again."
(interactive
- (save-current-buffer
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
(vc-ensure-vc-buffer)
(list
(vc-read-revision "Revision to visit (default is working revision): "
(list buffer-file-name)))))
+ (set-buffer (or (buffer-base-buffer) (current-buffer)))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(revision (if (string-equal rev "")
- (vc-working-revision file)
- rev)))
+ (vc-working-revision file)
+ rev)))
(switch-to-buffer-other-window (vc-find-revision file revision))))
(defun vc-find-revision (file revision &optional backend)
@@ -2502,11 +2549,8 @@ with its diffs (if the underlying VCS supports that)."
(cond
((eq current-prefix-arg 1)
(let* ((default (thing-at-point 'word t))
- (revision (read-string
- (if default
- (format "Revision to show (default %s): " default)
- "Revision to show: ")
- nil nil default)))
+ (revision (read-string (format-prompt "Revision to show" default)
+ nil nil default)))
(list 1 revision)))
((numberp current-prefix-arg)
(list current-prefix-arg))
@@ -2537,15 +2581,17 @@ with its diffs (if the underlying VCS supports that)."
;;;###autoload
(defun vc-print-branch-log (branch)
- "Show the change log for BRANCH in a window."
+ "Show the change log for BRANCH root in a window."
(interactive
(list
(vc-read-revision "Branch to log: ")))
(when (equal branch "")
(error "No branch specified"))
- (vc-print-log-internal (vc-responsible-backend default-directory)
- (list default-directory) branch t
- (when (> vc-log-show-limit 0) vc-log-show-limit)))
+ (let* ((backend (vc-responsible-backend default-directory))
+ (rootdir (vc-call-backend backend 'root default-directory)))
+ (vc-print-log-internal backend
+ (list rootdir) branch t
+ (when (> vc-log-show-limit 0) vc-log-show-limit))))
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
@@ -2690,9 +2736,6 @@ to the working revision (except for keyword expansion)."
(message "Reverting %s...done" (vc-delistify files)))))
;;;###autoload
-(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
-
-;;;###autoload
(defun vc-pull (&optional arg)
"Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-27 02:40:56 +0000